12 Feb '08
Author: dverna
Date: Tue Feb 12 09:13:32 2008
New Revision: 2482
Modified:
trunk/projects/lisp-ecoop/website/templates/home.xml
trunk/projects/lisp-ecoop/website/templates/programme.xml
trunk/projects/lisp-ecoop/website/templates/submissions.xml
Log:
Updated the deadlines
Modified: trunk/projects/lisp-ecoop/website/templates/home.xml
==============================================================================
--- trunk/projects/lisp-ecoop/website/templates/home.xml (original)
+++ trunk/projects/lisp-ecoop/website/templates/home.xml Tue Feb 12 09:13:32 2008
@@ -27,9 +27,9 @@
<h2>Important Dates</h2>
<ul>
-<li>Submission deadline: <b>May 18, 2008</b></li>
-<li>Notification of acceptance: <b>June 08, 2008</b></li>
-<li>ECOOP early registration deadline: <b>June 15, 2008</b></li>
+<li>Submission deadline: <b>May 04, 2008</b></li>
+<li>Notification of acceptance: <b>May 19, 2008</b></li>
+<li>ECOOP early registration deadline: <b>June 01, 2008</b></li>
</ul>
<h2>Overview</h2>
Modified: trunk/projects/lisp-ecoop/website/templates/programme.xml
==============================================================================
--- trunk/projects/lisp-ecoop/website/templates/programme.xml (original)
+++ trunk/projects/lisp-ecoop/website/templates/programme.xml Tue Feb 12 09:13:32 2008
@@ -5,7 +5,7 @@
<h1>Workshop Programme</h1>
-The programme will be available by the end of June.
+The programme will be available in June.
<!--
<h3>9:00 - 10:30</h3>
Modified: trunk/projects/lisp-ecoop/website/templates/submissions.xml
==============================================================================
--- trunk/projects/lisp-ecoop/website/templates/submissions.xml (original)
+++ trunk/projects/lisp-ecoop/website/templates/submissions.xml Tue Feb 12 09:13:32 2008
@@ -7,7 +7,7 @@
<!-- <p>We have accepted the following submissions.</p> -->
-The list of accepted submissions will be available by the end of June.
+The list of accepted submissions will be available in June.
<h2>Papers</h2>
<lisp-ecoop:submission-list type="paper"/>
1
0
12 Feb '08
Author: ksprotte
Date: Tue Feb 12 07:19:24 2008
New Revision: 2481
Modified:
branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp
branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp
branches/trunk-reorg/projects/bos/web/map-handlers.lisp
branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp
branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp
branches/trunk-reorg/projects/bos/web/startup.lisp
branches/trunk-reorg/projects/bos/web/webserver.lisp
Log:
bos trunk-reorg compiles for the first time
Modified: branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp Tue Feb 12 07:19:24 2008
@@ -123,7 +123,7 @@
do (incf dest-x copy-width))
do (incf dest-y copy-height))
(cl-gd:draw-polygon vertices :color (elt colors 1))
- (emit-image-to-browser req cl-gd:*default-image* :png)))))
+ (emit-image-to-browser cl-gd:*default-image* :png)))))
(defclass create-allocation-area-handler (admin-only-handler form-handler)
())
Modified: branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp Tue Feb 12 07:19:24 2008
@@ -7,7 +7,7 @@
()
(:default-initargs :class 'contract))
-(defmethod handle-object ((handler contract-image-handler) contract req)
+(defmethod handle-object ((handler contract-image-handler) contract)
"Create and return a GD image of the contract. The returned
rectangular image will have the size of the contracts' bounding box.
All square meters will have yellow color, the background will be transparent."
@@ -27,4 +27,4 @@
(cl-gd:do-rows (y)
(cl-gd:do-pixels-in-row (x)
(setf (cl-gd:raw-pixel) (aref work-array x y)))))
- (emit-image-to-browser req cl-gd:*default-image* :png :cache-sticky t))))
\ No newline at end of file
+ (emit-image-to-browser cl-gd:*default-image* :png :cache-sticky t))))
\ No newline at end of file
Modified: branches/trunk-reorg/projects/bos/web/map-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/map-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/map-handlers.lisp Tue Feb 12 07:19:24 2008
@@ -82,7 +82,7 @@
;; (if (or (not ims)
;; (> changed-time (date-to-universal-time ims)))
;; (let ((image (image-tile-image tile (apply #'parse-operations operation-strings))))
-;; (emit-image-to-browser req image :png
+;; (emit-image-to-browser image :png
;; :date changed-time
;; :max-age 60)
;; (cl-gd:destroy-image image))
@@ -98,7 +98,7 @@
(let (active-layers
(all-layer-names (mapcar #'symbol-name (image-tile-layers tile))))
(dolist (layer-name all-layer-names)
- (when (query-param req layer-name)
+ (when (query-param layer-name)
(push layer-name active-layers)))
(or (reverse active-layers) all-layer-names)))
Modified: branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp Tue Feb 12 07:19:24 2008
@@ -19,7 +19,7 @@
(declare (ignore second minute hour date month day-of-week is-dst tz))
year))
-(defmethod handle ((handler reports-xml-handler) req)
+(defmethod handle ((handler reports-xml-handler))
(with-xml-response ()
(destructuring-bind (name &optional *year* &rest arguments) (decoded-handler-path handler)
(setf *year* (and *year* (parse-integer *year*)))
Modified: branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp Tue Feb 12 07:19:24 2008
@@ -178,14 +178,14 @@
(let (changed)
(with-bos-cms-page (:title "Saving sponsor data")
(dolist (field-name '(full-name email password country language info-text))
- (let ((field-value (query-param req (string-downcase (symbol-name field-name)))))
+ (let ((field-value (query-param (string-downcase (symbol-name field-name)))))
(when (and field-value
(not (equal field-value (slot-value sponsor field-name))))
(change-slot-values sponsor field-name field-value)
(setf changed t)
(html (:p "Changed " (:princ-safe (string-downcase (symbol-name field-name))))))))
(dolist (contract (sponsor-contracts sponsor))
- (when (and (query-param req (contract-checkbox-name contract))
+ (when (and (query-param (contract-checkbox-name contract))
(not (contract-paidp contract)))
(change-slot-values contract 'paidp t)
(setf changed t)
@@ -249,8 +249,8 @@
(defclass m2-javascript-handler (prefix-handler)
())
-(defmethod handle ((handler m2-javascript-handler) req)
- (multiple-value-bind (sponsor-id-or-x y) (parse-url req)
+(defmethod handle ((handler m2-javascript-handler))
+ (multiple-value-bind (sponsor-id-or-x y) (parse-url)
(let ((sponsor (cond
(y
(let ((m2 (get-m2 (parse-integer sponsor-id-or-x) (parse-integer y))))
Modified: branches/trunk-reorg/projects/bos/web/startup.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/startup.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/startup.lisp Tue Feb 12 07:19:24 2008
@@ -42,10 +42,6 @@
:website-url *website-url*
:worldpay-test-mode *worldpay-test-mode*)
(format t "~&; Starting aserve~@[ in debug mode~].~%" debug)
- (force-output)
- (setq *webserver*
- (if debug
- (progn (net.aserve::debug-on :notrap)
- (net.aserve:start :port *port* :listeners 0))
- (progn (net.aserve::debug-off :all)
- (net.aserve:start :port *port* :listeners *listeners*)))))
+ (force-output)
+ (setq hunchentoot:*catch-errors-p* (not debug))
+ (hunchentoot:start-server :port *port*))
Modified: branches/trunk-reorg/projects/bos/web/webserver.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/webserver.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/webserver.lisp Tue Feb 12 07:19:24 2008
@@ -22,13 +22,13 @@
;; If the requested URL is /handle-sale, we do the sales processing
;; and change the template name according to the outcome.
-(defmethod find-template-pathname ((handler worldpay-template-handler) template-name &key request)
+(defmethod find-template-pathname ((Handler worldpay-template-handler) template-name)
(cond
((scan #?r"(^|.*/)handle-sale" template-name)
- (with-query-params (request cartId name address country transStatus lang MC_gift)
+ (with-query-params (cartId name address country transStatus lang MC_gift)
(unless (website-supports-language lang)
(setf lang *default-language*))
- (bos.m2::remember-worldpay-params cartId (all-request-params request))
+ (bos.m2::remember-worldpay-params cartId (all-request-params))
(let ((contract (get-contract (parse-integer cartId))))
(sponsor-set-language (contract-sponsor contract) lang)
(cond
@@ -128,7 +128,7 @@
())
(defmethod handle ((handler statistics-handler))
- (let ((stats-name (parse-url req)))
+ (let ((stats-name (parse-url)))
(cond
(stats-name
(redirect (format nil "~A.svg" stats-name)))
@@ -168,19 +168,20 @@
(call-next-method)))
(call-next-method))))
-(defmethod authorize :after ((authorizer bos-authorizer)
- (req http-request)
- (ent net.aserve::entity))
- (let ((new-language (or (language-from-url (uri-path (hunchentoot:request-uri)))
- (query-param req "language")))
- (current-language (gethash :language (bknr-session-variables *session*))))
- (when (or (not current-language)
- (and new-language
- (not (equal new-language current-language))))
- (setf (gethash :language (bknr-session-variables *session*))
- (or new-language
- (find-browser-prefered-language req)
- *default-language*)))))
+;; trunk-reorg adaption
+;; (defmethod authorize :after ((authorizer bos-authorizer)
+;; (req http-request)
+;; (ent net.aserve::entity))
+;; (let ((new-language (or (language-from-url (uri-path (hunchentoot:request-uri)))
+;; (query-param "language")))
+;; (current-language (gethash :language (bknr-session-variables *session*))))
+;; (when (or (not current-language)
+;; (and new-language
+;; (not (equal new-language current-language))))
+;; (setf (gethash :language (bknr-session-variables *session*))
+;; (or new-language
+;; (find-browser-prefered-language req)
+;; *default-language*)))))
(defun publish-website (&key website-directory website-url (worldpay-test-mode t) (vhosts :wild))
(setf *website-directory* website-directory)
1
0
Author: ksprotte
Date: Tue Feb 12 07:18:11 2008
New Revision: 2480
Modified:
branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp
Log:
it seems that a rune is a character nowadays
Modified: branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp
==============================================================================
--- branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp (original)
+++ branches/trunk-reorg/xhtmlgen/xhtmlgen.lisp Tue Feb 12 07:18:11 2008
@@ -131,7 +131,7 @@
;; das ist fuer WPDISPLAY
(let ((s (cxml::chained-handler *html-sink*)))
(cxml::maybe-close-tag s)
- (map nil (lambda (c) (cxml::write-rune (char-code c) s)) str)))
+ (map nil (lambda (c) (cxml::write-rune c s)) str)))
(defun princ-http (val)
#+(or)
1
0
[bknr-cvs] r2479 - in branches/trunk-reorg/projects/bos: m2 web
by ksprotte＠common-lisp.net 11 Feb '08
by ksprotte＠common-lisp.net 11 Feb '08
11 Feb '08
Author: ksprotte
Date: Mon Feb 11 12:24:41 2008
New Revision: 2479
Modified:
branches/trunk-reorg/projects/bos/m2/m2.lisp
branches/trunk-reorg/projects/bos/m2/mail-generator.lisp
branches/trunk-reorg/projects/bos/m2/packages.lisp
branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp
branches/trunk-reorg/projects/bos/web/allocation-cache-handlers.lisp
branches/trunk-reorg/projects/bos/web/boi-handlers.lisp
branches/trunk-reorg/projects/bos/web/bos.web.asd
branches/trunk-reorg/projects/bos/web/contract-handlers.lisp
branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp
branches/trunk-reorg/projects/bos/web/kml-handlers.lisp
branches/trunk-reorg/projects/bos/web/languages-handler.lisp
branches/trunk-reorg/projects/bos/web/map-browser-handler.lisp
branches/trunk-reorg/projects/bos/web/map-handlers.lisp
branches/trunk-reorg/projects/bos/web/news-handlers.lisp
branches/trunk-reorg/projects/bos/web/packages.lisp
branches/trunk-reorg/projects/bos/web/poi-handlers.lisp
branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp
branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp
branches/trunk-reorg/projects/bos/web/web-macros.lisp
branches/trunk-reorg/projects/bos/web/web-utils.lisp
branches/trunk-reorg/projects/bos/web/webserver.lisp
Log:
bos changes for trunk-reorg; unfinished, committed for backup
Modified: branches/trunk-reorg/projects/bos/m2/m2.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/m2/m2.lisp (original)
+++ branches/trunk-reorg/projects/bos/m2/m2.lisp Mon Feb 11 12:24:41 2008
@@ -189,8 +189,8 @@
(defclass editor-only-handler ()
())
-(defmethod bknr.web:authorized-p ((handler editor-only-handler) req)
- (editor-p (bknr-request-user req)))
+(defmethod bknr.web:authorized-p ((handler editor-only-handler))
+ (editor-p bknr.web:*user*))
;;;; CONTRACT
@@ -446,11 +446,12 @@
(incf retval (length (contract-m2s contract))))
retval))
-(defun string-safe (string)
- (if string
- (escape-nl (with-output-to-string (s)
- (net.html.generator::emit-safe s string)))
- ""))
+;; trunk-reorg adaption
+;; (defun string-safe (string)
+;; (if string
+;; (escape-nl (with-output-to-string (s)
+;; (net.html.generator::emit-safe s string)))
+;; ""))
(defun make-m2-javascript (sponsor)
"Erzeugt das Quadratmeter-Javascript für die angegebenen Contracts"
Modified: branches/trunk-reorg/projects/bos/m2/mail-generator.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/m2/mail-generator.lisp (original)
+++ branches/trunk-reorg/projects/bos/m2/mail-generator.lisp Mon Feb 11 12:24:41 2008
@@ -251,8 +251,8 @@
(ignore-errors
(delete-file (contract-pdf-pathname contract :print t))))
-(defun mail-backoffice-sponsor-data (contract req)
- (with-query-params (req numsqm country email name address date language)
+(defun mail-backoffice-sponsor-data (contract)
+ (with-query-params (numsqm country email name address date language)
(let ((parts (list (make-html-part (format nil "
<html>
<body>
@@ -294,7 +294,7 @@
(mail-contract-data contract "Manually entered sponsor" parts))))
(defun mail-manual-sponsor-data (req)
- (with-query-params (req contract-id vorname name strasse plz ort email telefon want-print donationcert-yearly)
+ (with-query-params (contract-id vorname name strasse plz ort email telefon want-print donationcert-yearly)
(let* ((contract (store-object-with-id (parse-integer contract-id)))
(sponsor-id (store-object-id (contract-sponsor contract)))
(parts (list (make-html-part (format nil "
@@ -363,7 +363,7 @@
(error "cannot find WorldPay callback params for contract ~A~%" contract-id)))
(defun mail-worldpay-sponsor-data (req)
- (with-query-params (req contract-id)
+ (with-query-params (contract-id)
(let* ((contract (store-object-with-id (parse-integer contract-id)))
(params (get-worldpay-params contract-id))
(parts (list (make-html-part (format nil "
Modified: branches/trunk-reorg/projects/bos/m2/packages.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/m2/packages.lisp (original)
+++ branches/trunk-reorg/projects/bos/m2/packages.lisp Mon Feb 11 12:24:41 2008
@@ -54,7 +54,7 @@
:bknr.statistics
:bknr.rss
:bos.m2.config
- :net.post-office
+ :cl-smtp
:kmrcl
:cxml
:cl-mime
Modified: branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/allocation-area-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -6,8 +6,8 @@
(defclass allocation-area-handler (admin-only-handler edit-object-handler)
())
-(defmethod handle-object-form ((handler allocation-area-handler) action (allocation-area (eql nil)) req)
- (with-bos-cms-page (req :title "Allocation Areas")
+(defmethod handle-object-form ((handler allocation-area-handler) action (allocation-area (eql nil)))
+ (with-bos-cms-page (:title "Allocation Areas")
(html
(:h2 "Defined allocation areas")
((:table :border "1")
@@ -27,8 +27,8 @@
(:td (:princ-safe (round (allocation-area-percent-used allocation-area))) "%")))))
(:p (cmslink "create-allocation-area" "Create new allocation area")))))
-(defmethod handle-object-form ((handler allocation-area-handler) action allocation-area req)
- (with-bos-cms-page (req :title "Allocation Area")
+(defmethod handle-object-form ((handler allocation-area-handler) action allocation-area)
+ (with-bos-cms-page (:title "Allocation Area")
(with-slots (active-p left top width height) allocation-area
(html
((:table :border "1")
@@ -75,15 +75,15 @@
do (html (:td ((:a :href #?"/enlarge-overview/$(tile-x)/$(tile-y)")
((:img :width "90" :height "90" :border "0" :src #?"/overview/$(tile-x)/$(tile-y)"))))))))))))))
-(defmethod handle-object-form ((handler allocation-area-handler) (action (eql :delete)) allocation-area req)
+(defmethod handle-object-form ((handler allocation-area-handler) (action (eql :delete)) allocation-area)
(delete-object allocation-area)
- (with-bos-cms-page (req :title "Allocation area has been deleted")
+ (with-bos-cms-page (:title "Allocation area has been deleted")
(:h2 "The allocation area has been deleted")))
(defclass allocation-area-gfx-handler (editor-only-handler object-handler)
())
-(defmethod handle-object ((handler allocation-area-gfx-handler) allocation-area req)
+(defmethod handle-object ((handler allocation-area-gfx-handler) allocation-area)
(cl-gd:with-image* ((allocation-area-width allocation-area)
(allocation-area-height allocation-area) t)
(with-slots (left top width height) allocation-area
@@ -128,29 +128,27 @@
(defclass create-allocation-area-handler (admin-only-handler form-handler)
())
-(defmethod handle-form ((handler create-allocation-area-handler) action req)
- (with-query-params (req x y left top)
+(defmethod handle-form ((handler create-allocation-area-handler) action)
+ (with-query-params (x y left top)
(cond
((and x y left top)
(destructuring-bind (x y left top) (mapcar #'parse-integer (list x y left top))
(if (or (some (complement #'plusp) (list x y left top))
(<= x left)
(<= y top))
- (with-bos-cms-page (req :title "Invalid area selected")
+ (with-bos-cms-page (:title "Invalid area selected")
(:h2 "Choose upper left corner first, then lower-right corner"))
(redirect (format nil "/allocation-area/~D" (store-object-id
- (make-allocation-rectangle left top (- x left) (- y top))))
- req))))
+ (make-allocation-rectangle left top (- x left) (- y top))))))))
((and x y)
(redirect (format nil "/map-browser/~A/~A?heading=~A&chosen-url=~A&"
x y
(uriencode-string "Choose lower right point of allocation area")
(uriencode-string (format nil "~A?left=~A&top=~A&"
- (uri-path (request-uri req))
- x y)))
- req))
+ (uri-path (hunchentoot:request-uri))
+ x y)))))
(t
- (with-bos-cms-page (req :title "Create allocation area")
+ (with-bos-cms-page (:title "Create allocation area")
((:form :method "POST" :enctype "multipart/form-data"))
((:table :border "0")
(:tr ((:td :colspan "2")
@@ -163,23 +161,22 @@
(:tr (:td "Start-Y") (:td (text-field "start-y" :value 0 :size 5)))
(:tr (:td (submit-button "rectangle" "rectangle")))))))))
-(defmethod handle-form ((handler create-allocation-area-handler) (action (eql :rectangle)) req)
- (with-query-params (req start-x start-y)
+(defmethod handle-form ((handler create-allocation-area-handler) (action (eql :rectangle)))
+ (with-query-params (start-x start-y)
(redirect (format nil "/map-browser/~A/~A?heading=~A&chosen-url=~A&"
start-x start-y
(uriencode-string "Choose upper left point of allocation area")
- (uriencode-string (format nil "~A?" (uri-path (request-uri req)))))
- req)))
+ (uriencode-string (format nil "~A?" (uri-path (hunchentoot:request-uri))))))))
-(defmethod handle-form ((handler create-allocation-area-handler) (action (eql :upload)) req)
- (let ((uploaded-text-file (cdr (find "text-file" (request-uploaded-files req) :test #'equal :key #'car))))
+(defmethod handle-form ((handler create-allocation-area-handler) (action (eql :upload)))
+ (let ((uploaded-text-file (cdr (find "text-file" (request-uploaded-files) :test #'equal :key #'car))))
(cond
((not uploaded-text-file)
- (with-bos-cms-page (req :title "No Text file uploaded")
+ (with-bos-cms-page (:title "No Text file uploaded")
(:h2 "File not uploaded")
(:p "Please upload your text file containing the allocation polygon UTM coordinates")))
(t
- (with-bos-cms-page (req :title #?"Importing allocation polygons from text file $(uploaded-text-file)")
+ (with-bos-cms-page (:title #?"Importing allocation polygons from text file $(uploaded-text-file)")
(handler-case
(let* ((vertices (polygon-from-text-file uploaded-text-file))
(existing-area (find (coerce vertices 'list)
Modified: branches/trunk-reorg/projects/bos/web/allocation-cache-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/allocation-cache-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/allocation-cache-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -5,8 +5,8 @@
(defclass allocation-cache-handler (admin-only-handler page-handler)
())
-(defmethod handle ((handler allocation-cache-handler) req)
- (with-bos-cms-page (req :title "Allocation Cache")
+(defmethod handle ((handler allocation-cache-handler))
+ (with-bos-cms-page (:title "Allocation Cache")
(html
(:pre (:princ
(with-output-to-string (*standard-output*)
Modified: branches/trunk-reorg/projects/bos/web/boi-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/boi-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/boi-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -6,8 +6,8 @@
(defclass boi-handler (page-handler)
())
-(defmethod authorized-p ((handler boi-handler) req)
- (bos.m2:editor-p (bknr-request-user req)))
+(defmethod authorized-p ((handler boi-handler))
+ (bos.m2:editor-p bknr.web:*user*))
(defclass create-contract-handler (boi-handler)
())
@@ -20,9 +20,9 @@
(error "Invalid sponsor ID (wrong type)"))
sponsor))
-(defmethod handle ((handler create-contract-handler) req)
- (with-xml-error-handler (req)
- (with-query-params (req num-sqm country sponsor-id name paid expires)
+(defmethod handle ((handler create-contract-handler))
+ (with-xml-error-handler ()
+ (with-query-params (num-sqm country sponsor-id name paid expires)
(setf num-sqm (ignore-errors (parse-integer num-sqm :junk-allowed t)))
(unless num-sqm
(error "missing or invalid num-sqm parameter"))
@@ -53,9 +53,9 @@
(defclass pay-contract-handler (boi-handler)
())
-(defmethod handle ((handler pay-contract-handler) req)
- (with-xml-error-handler (req)
- (with-query-params (req contract-id name)
+(defmethod handle ((handler pay-contract-handler))
+ (with-xml-error-handler ()
+ (with-query-params (contract-id name)
(unless contract-id
(error "missing contract-id parameter"))
(let ((contract (get-contract (or (ignore-errors (parse-integer contract-id))
@@ -65,7 +65,7 @@
(with-transaction (:contract-paid)
(contract-set-paidp contract (format nil "~A: manually set paid by ~A"
(format-date-time)
- (user-login (bknr-request-user req))))
+ (user-login bknr.web:*user*)))
(when name
(setf (user-full-name (contract-sponsor contract)) name))))
(with-xml-response ()
@@ -77,9 +77,9 @@
(defclass cancel-contract-handler (boi-handler)
())
-(defmethod handle ((handler cancel-contract-handler) req)
- (with-xml-error-handler (req)
- (with-query-params (req contract-id)
+(defmethod handle ((handler cancel-contract-handler))
+ (with-xml-error-handler ()
+ (with-query-params (contract-id)
(unless contract-id
(error "missing contract-id parameter"))
(let ((contract (get-contract (or (ignore-errors (parse-integer contract-id))
Modified: branches/trunk-reorg/projects/bos/web/bos.web.asd
==============================================================================
--- branches/trunk-reorg/projects/bos/web/bos.web.asd (original)
+++ branches/trunk-reorg/projects/bos/web/bos.web.asd Mon Feb 11 12:24:41 2008
@@ -16,7 +16,7 @@
:description "worldpay test web server"
:long-description ""
- :depends-on (:bknr-web :bknr-modules :bos.m2 :cxml)
+ :depends-on (:bknr-web :bknr-modules :bos.m2 :cxml :acl-compat)
:components ((:file "packages")
(:file "utf-8" :depends-on ("packages"))
Modified: branches/trunk-reorg/projects/bos/web/contract-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/contract-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/contract-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -9,8 +9,8 @@
(defparameter *show-m2s* 5)
-(defmethod handle-object ((handler contract-handler) contract req)
- (with-bos-cms-page (req :title "Displaying contract details")
+(defmethod handle-object ((handler contract-handler) contract)
+ (with-bos-cms-page (:title "Displaying contract details")
((:table :border "0")
(:tr (:td "sponsor")
(:td (html-edit-link (contract-sponsor contract))))
Modified: branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/contract-image-handler.lisp Mon Feb 11 12:24:41 2008
@@ -17,7 +17,7 @@
;; We manipulate pixels in a temporary array which is copied to the GD image as
;; a whole for performance reasons. The FFI is way too slow to manipulate individual pixels.
(let ((work-array (make-array (list width height) :element-type 'fixnum :initial-element 0))
- (color (parse-color (or (second (decoded-handler-path handler req)) "ffff00"))))
+ (color (parse-color (or (second (decoded-handler-path handler)) "ffff00"))))
(flet ((set-pixel (x y)
(decf x left)
(decf y top)
Modified: branches/trunk-reorg/projects/bos/web/kml-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/kml-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/kml-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -40,7 +40,7 @@
(defclass contract-kml-handler (object-handler)
())
-(defmethod handle-object ((handler contract-kml-handler) (contract contract) req)
+(defmethod handle-object ((handler contract-kml-handler) (contract contract))
(with-xml-response (:content-type "application/vnd.google-earth.kml+xml" :root-element "kml")
;; when name is xmlns, the attribute does not show up - why (?)
;; (attribute "xmlns" "http://earth.google.com/kml/2.2")
@@ -77,5 +77,5 @@
(with-element "coordinates"
(text (kml-format-points (list (contract-center-lon-lat c)))))))))))))
-(defmethod handle-object ((handle-object contract-kml-handler) (object null) req)
+(defmethod handle-object ((handle-object contract-kml-handler) (object null))
(error "Contract not found."))
Modified: branches/trunk-reorg/projects/bos/web/languages-handler.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/languages-handler.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/languages-handler.lisp Mon Feb 11 12:24:41 2008
@@ -5,11 +5,11 @@
(defclass languages-handler (admin-only-handler form-handler)
())
-(defmethod handle-form ((handler languages-handler) action req)
- (with-bos-cms-page (req :title "Languages")
+(defmethod handle-form ((handler languages-handler) action)
+ (with-bos-cms-page (:title "Languages")
(case action
(:add (handler-case
- (with-query-params (req code name)
+ (with-query-params (code name)
(when (and code name)
(make-object 'website-language :code code :name name)
(html (:h2 "Language " (:princ-safe code) " (" (:princ-safe name) ") created"))))
@@ -17,7 +17,7 @@
(html (:h2 "Error creating language")
(:pre (:princ-safe e))))))
(:delete (handler-case
- (with-query-params (req delete-code)
+ (with-query-params (delete-code)
(when delete-code
(delete-object (language-with-code delete-code))
(html (:h2 "Language " (:princ-safe delete-code) " deleted"))))
Modified: branches/trunk-reorg/projects/bos/web/map-browser-handler.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/map-browser-handler.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/map-browser-handler.lisp Mon Feb 11 12:24:41 2008
@@ -18,7 +18,7 @@
(defclass map-browser-handler (prefix-handler)
())
-(defun decode-coords-in-handler-path (handler req)
+(defun decode-coords-in-handler-path (handler)
(labels ((ensure-valid-coordinates (x y)
(setq x (parse-integer x))
(setq y (parse-integer y))
@@ -30,30 +30,29 @@
(<= 0 y 10800))
(error "invalid coordinates ~A/~A" x y))
(list x y)))
- (with-query-params (req xcoord ycoord)
+ (with-query-params (xcoord ycoord)
(when (and xcoord ycoord)
(return-from decode-coords-in-handler-path (ensure-valid-coordinates xcoord ycoord))))
- (let ((handler-arguments (decoded-handler-path handler req)))
+ (let ((handler-arguments (decoded-handler-path handler)))
(when (and handler-arguments
(< 1 (length handler-arguments)))
(apply #'ensure-valid-coordinates handler-arguments)))))
-(defmethod handle ((handler map-browser-handler) req)
- (with-query-params (req chosen-url)
+(defmethod handle ((handler map-browser-handler))
+ (with-query-params (chosen-url)
(when chosen-url
(setf (session-variable :chosen-url) chosen-url)))
- (with-query-params (req view-x view-y)
- (destructuring-bind (&optional click-x click-y) (decode-ismap-query-string req)
- (destructuring-bind (&optional point-x point-y) (decode-coords-in-handler-path handler req)
- (with-query-params (req action)
+ (with-query-params (view-x view-y)
+ (destructuring-bind (&optional click-x click-y) (decode-ismap-query-string)
+ (destructuring-bind (&optional point-x point-y) (decode-coords-in-handler-path handler)
+ (with-query-params (action)
(when (equal action "save")
(if (session-variable :chosen-url)
(redirect (format nil "~Ax=~D&y=~D"
(session-variable :chosen-url)
point-x
- point-y)
- req)
- (with-bos-cms-page (req :title "Map Point Chooser")
+ point-y))
+ (with-bos-cms-page (:title "Map Point Chooser")
(html (:princ-safe "You chose " point-x " / " point-y))))
(return-from handle t)))
(cond
@@ -71,14 +70,14 @@
(click-coord-y (+ (tile-nw-y start-tile) click-y)))
(setq point-x click-coord-x
point-y click-coord-y)
- (redirect (format nil "/map-browser/~D/~D" click-coord-x click-coord-y) req)
+ (redirect (format nil "/map-browser/~D/~D" click-coord-x click-coord-y))
(return-from handle t)))
(cond
((and click-y (not point-y))
- (redirect (format nil "/map-browser/~D/~D" (* 30 click-x) (* 30 click-y)) req))
+ (redirect (format nil "/map-browser/~D/~D" (* 30 click-x) (* 30 click-y))))
(point-y
- (with-bos-cms-page (req :title "Map Point Chooser")
- (with-query-params (req heading)
+ (with-bos-cms-page (:title "Map Point Chooser")
+ (with-query-params (heading)
(when heading
(html (:h2 (:princ-safe heading)))))
(html
@@ -133,7 +132,7 @@
((:img :src "/images/map-cursor.png")))))))
(map-navigator req point-x point-y "/map-browser/" :formcheck "return updateCoords();")))
(t
- (with-bos-cms-page (req :title "Map Point Chooser")
+ (with-bos-cms-page (:title "Map Point Chooser")
(html
((:a :href "/map-browser/")
((:img :ismap "ismap" :src "/image/sl_all"))))))))))))
\ No newline at end of file
Modified: branches/trunk-reorg/projects/bos/web/map-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/map-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/map-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -34,7 +34,7 @@
(:tr (:td "Y:") (:td (text-field "ycoord" :size "5" :value y)))
(:tr )))
(:td
- (with-query-params (req background areas contracts)
+ (with-query-params (background areas contracts)
;; xxx should use tile-layers
(unless (or background areas contracts)
(setq background t
@@ -52,15 +52,15 @@
(defclass image-tile-handler (object-handler)
())
-(defmethod object-handler-get-object ((handler image-tile-handler) req)
- (destructuring-bind (x y &rest operations) (decoded-handler-path handler req)
+(defmethod object-handler-get-object ((handler image-tile-handler))
+ (destructuring-bind (x y &rest operations) (decoded-handler-path handler)
(declare (ignore operations))
(setf x (parse-integer x))
(setf y (parse-integer y))
(ensure-map-tile x y)))
-(defmethod handle-object ((handler image-tile-handler) (tile (eql nil)) req)
- (error-404 req))
+(defmethod handle-object ((handler image-tile-handler) (tile (eql nil)))
+ (error-404))
(defun parse-operations (&rest operation-strings)
(mapcar #'(lambda (operation-string)
@@ -68,32 +68,33 @@
(apply #'list (make-keyword-from-string operation) arguments)))
operation-strings))
-(defmethod handle-object ((handler image-tile-handler) tile req)
- ;; xxx parse url another time - the parse result of
- ;; object-handler-get-object should really be kept in the request
- (destructuring-bind (x y &rest operation-strings) (decoded-handler-path handler req)
- (declare (ignore x y))
- (let ((changed-time (image-tile-changed-time tile))
- (ims (header-slot-value req :if-modified-since)))
- (setf (net.aserve::last-modified *ent*) changed-time)
- #+(or)
- (format t "; image-tile-handler handle-object: changed-time: ~A if-modified-since: ~A~%" (format-date-time changed-time) ims)
- (if (or (not ims)
- (> changed-time (date-to-universal-time ims)))
- (let ((image (image-tile-image tile (apply #'parse-operations operation-strings))))
- (emit-image-to-browser req image :png
- :date changed-time
- :max-age 60)
- (cl-gd:destroy-image image))
- (with-http-response (req *ent*)
- (with-http-body (req *ent*)
- ; do nothing
- ))))))
+;; trunk-reorg adaption
+;; (defmethod handle-object ((handler image-tile-handler) tile)
+;; ;; xxx parse url another time - the parse result of
+;; ;; object-handler-get-object should really be kept in the request
+;; (destructuring-bind (x y &rest operation-strings) (decoded-handler-path handler)
+;; (declare (ignore x y))
+;; (let ((changed-time (image-tile-changed-time tile))
+;; (ims (header-slot-value req :if-modified-since)))
+;; (format t "Warning: not setting last-modified of *ent* to changed-time")
+;; #+(or)
+;; (format t "; image-tile-handler handle-object: changed-time: ~A if-modified-since: ~A~%" (format-date-time changed-time) ims)
+;; (if (or (not ims)
+;; (> changed-time (date-to-universal-time ims)))
+;; (let ((image (image-tile-image tile (apply #'parse-operations operation-strings))))
+;; (emit-image-to-browser req image :png
+;; :date changed-time
+;; :max-age 60)
+;; (cl-gd:destroy-image image))
+;; (with-http-response (*ent*)
+;; (with-http-body ()
+;; ; do nothing
+;; ))))))
(defclass enlarge-tile-handler (image-tile-handler)
())
-(defun tile-active-layers-from-request-params (tile req)
+(defun tile-active-layers-from-request-params (tile)
(let (active-layers
(all-layer-names (mapcar #'symbol-name (image-tile-layers tile))))
(dolist (layer-name all-layer-names)
@@ -101,25 +102,27 @@
(push layer-name active-layers)))
(or (reverse active-layers) all-layer-names)))
-(defun tile-url (tile x y req)
+(defun tile-url (tile x y)
(format nil "/overview/~D/~D~(~{/~A~}~)"
x y
- (tile-active-layers-from-request-params tile req)))
+ (tile-active-layers-from-request-params tile)))
+
+;; trunk-reorg adaption
+;; (defmethod handle-object ((handler enlarge-tile-handler) tile)
+;; (let ((ismap-coords (decode-ismap-query-string req))
+;; (tile-x (tile-nw-x tile))
+;; (tile-y (tile-nw-y tile)))
+;; (if ismap-coords
+;; (let* ((x (+ (floor (first ismap-coords) 4) tile-x))
+;; (y (+ (floor (second ismap-coords) 4) tile-y))
+;; (m2 (get-m2 x y))
+;; (contract-id (and m2 (m2-contract m2) (store-object-id (m2-contract m2)))))
+;; (if contract-id
+;; (redirect #?"/contract/$(contract-id)")
+;; (with-bos-cms-page (:title "Not sold")
+;; (html (:h2 "this square meter has not been sold yet")))))
+;; (with-bos-cms-page (:title "Browsing tile")
+;; (:a ((:a :href (uri-path (hunchentoot:request-uri)))
+;; ((:img :width "360" :ismap "ismap" :height "360" :border "0" :src (tile-url tile tile-x tile-y req)))))
+;; (map-navigator req tile-x tile-y "/enlarge-overview/")))))
-(defmethod handle-object ((handler enlarge-tile-handler) tile req)
- (let ((ismap-coords (decode-ismap-query-string req))
- (tile-x (tile-nw-x tile))
- (tile-y (tile-nw-y tile)))
- (if ismap-coords
- (let* ((x (+ (floor (first ismap-coords) 4) tile-x))
- (y (+ (floor (second ismap-coords) 4) tile-y))
- (m2 (get-m2 x y))
- (contract-id (and m2 (m2-contract m2) (store-object-id (m2-contract m2)))))
- (if contract-id
- (redirect #?"/contract/$(contract-id)" req)
- (with-bos-cms-page (req :title "Not sold")
- (html (:h2 "this square meter has not been sold yet")))))
- (with-bos-cms-page (req :title "Browsing tile")
- (:a ((:a :href (uri-path (request-uri req)))
- ((:img :width "360" :ismap "ismap" :height "360" :border "0" :src (tile-url tile tile-x tile-y req)))))
- (map-navigator req tile-x tile-y "/enlarge-overview/")))))
\ No newline at end of file
Modified: branches/trunk-reorg/projects/bos/web/news-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/news-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/news-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -9,10 +9,10 @@
(defclass edit-news-handler (editor-only-handler edit-object-handler)
())
-(defmethod handle-object-form ((handler edit-news-handler) action (news-item (eql nil)) req)
+(defmethod handle-object-form ((handler edit-news-handler) action (news-item (eql nil)))
(let ((language (session-variable :language)))
- (with-bos-cms-page (req :title "Edit news items")
- (content-language-chooser req)
+ (with-bos-cms-page (:title "Edit news items")
+ (content-language-chooser)
(:h2 "Create new item")
((:form :method "post")
(submit-button "new" "new"))
@@ -29,13 +29,13 @@
(html
(:h2 "No news items created yet"))))))
-(defmethod handle-object-form ((handler edit-news-handler) (action (eql :new)) (news-item (eql nil)) req)
- (redirect (format nil "/edit-news/~D" (store-object-id (make-news-item))) req))
+(defmethod handle-object-form ((handler edit-news-handler) (action (eql :new)) (news-item (eql nil)))
+ (redirect (format nil "/edit-news/~D" (store-object-id (make-news-item)))))
-(defmethod handle-object-form ((handler edit-news-handler) action news-item req)
+(defmethod handle-object-form ((handler edit-news-handler) action news-item)
(let ((language (session-variable :language)))
- (with-bos-cms-page (req :title "Edit news item")
- (content-language-chooser req)
+ (with-bos-cms-page (:title "Edit news item")
+ (content-language-chooser)
((:script :type "text/javascript")
"tinyMCE.init({ mode : 'textareas', theme : 'advanced' });")
((:form :method "post")
@@ -48,15 +48,15 @@
:value (news-item-text news-item language))))
(:tr (:td (submit-button "save" "save") (submit-button "delete" "delete" :confirm "Really delete the news item?"))))))))
-(defmethod handle-object-form ((handler edit-news-handler) (action (eql :save)) news-item req)
+(defmethod handle-object-form ((handler edit-news-handler) (action (eql :save)) news-item)
(let ((language (session-variable :language)))
- (with-query-params (req title text)
+ (with-query-params (title text)
(update-news-item news-item language :title title :text text)
- (with-bos-cms-page (req :title "News item updated")
+ (with-bos-cms-page (:title "News item updated")
(:h2 "Your changes have been saved")
"You may " (cmslink (edit-object-url news-item) "continue editing the news item")))))
-(defmethod handle-object-form ((handler edit-news-handler) (action (eql :delete)) news-item req)
+(defmethod handle-object-form ((handler edit-news-handler) (action (eql :delete)) news-item)
(delete-object news-item)
- (with-bos-cms-page (req :title "News item has been deleted")
+ (with-bos-cms-page (:title "News item has been deleted")
(:h2 "The news item has been deleted")))
\ No newline at end of file
Modified: branches/trunk-reorg/projects/bos/web/packages.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/packages.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/packages.lisp Mon Feb 11 12:24:41 2008
@@ -8,8 +8,6 @@
:cl-user
:cl-interpol
:cl-ppcre
- :net.aserve
- :net.aserve.client
:xhtml-generator
:cxml
:puri
@@ -27,6 +25,5 @@
:bos.m2.config)
(:nicknames :web :worldpay-test)
(:shadowing-import-from :cl-interpol #:quote-meta-chars)
- (:shadowing-import-from :acl-compat.mp #:process-kill #:process-wait)
- (:import-from :net.html.generator #:*html-stream*)
+ (:shadowing-import-from :acl-compat.mp #:process-kill #:process-wait)
(:export))
Modified: branches/trunk-reorg/projects/bos/web/poi-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/poi-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/poi-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -6,26 +6,26 @@
(defclass make-poi-handler (page-handler)
())
-(defmethod handle ((handler make-poi-handler) req)
- (with-query-params (req name)
+(defmethod handle ((handler make-poi-handler))
+ (with-query-params (name)
(cond
((find-store-object name :class 'poi)
- (with-bos-cms-page (req :title "Duplicate POI name")
+ (with-bos-cms-page (:title "Duplicate POI name")
(html (:h2 "Duplicate POI name")
"A POI with that name exists already, please choose a unique name")))
((not (scan #?r"(?i)^[a-z][-a-z0-9_]+$" name))
- (with-bos-cms-page (req :title "Bad technical name")
+ (with-bos-cms-page (:title "Bad technical name")
(html (:h2 "Bad technical name")
"Please use only alphanumerical characters, - and _ for technical POI names")))
(t
- (redirect (edit-object-url (make-poi (session-variable :language) name)) req)))))
+ (redirect (edit-object-url (make-poi (session-variable :language) name)))))))
(defclass edit-poi-handler (editor-only-handler edit-object-handler)
()
(:default-initargs :object-class 'poi :query-function #'find-poi))
-(defmethod handle-object-form ((handler edit-poi-handler) action (object (eql nil)) req)
- (with-bos-cms-page (req :title "Choose POI")
+(defmethod handle-object-form ((handler edit-poi-handler) action (object (eql nil)))
+ (with-bos-cms-page (:title "Choose POI")
(if (store-objects-with-class 'poi)
(html
(:h2 "Choose a POI to edit")
@@ -50,8 +50,8 @@
(html ((:img :src #?"/images/$(icon).gif")))))
(defmethod handle-object-form ((handler edit-poi-handler)
- action (poi poi) req)
- (with-query-params (req language shift shift-by)
+ action (poi poi))
+ (with-query-params (language shift shift-by)
(unless language (setq language (session-variable :language)))
(when shift
;; change image order
@@ -66,8 +66,8 @@
(setf (nth (+ shift-by old-position) new-images) tmp)
(change-slot-values poi 'bos.m2::images new-images)))
(setf (session-variable :language) language)
- (with-bos-cms-page (req :title "Edit POI")
- (content-language-chooser req)
+ (with-bos-cms-page (:title "Edit POI")
+ (content-language-chooser)
(unless (poi-complete poi language)
(html (:h2 "This POI is not complete in the current language - Please check that "
"the location and all text fields are set and that at least one image "
@@ -95,11 +95,11 @@
(html (:princ-safe (format nil "~D/~D " (first (poi-area poi)) (second (poi-area poi)))))
(cmslink (format nil "map-browser/~A/~A?chosen-url=~A"
(first (poi-area poi)) (second (poi-area poi))
- (uriencode-string (format nil "~A?action=save&" (uri-path (request-uri req)))))
+ (uriencode-string (format nil "~A?action=save&" (uri-path (hunchentoot:request-uri)))))
"[relocate]"))
(t
(cmslink (format nil "map-browser/?chosen-url=~A"
- (uriencode-string (format nil "~A?action=save&" (uri-path (request-uri req)))))
+ (uriencode-string (format nil "~A?action=save&" (uri-path (hunchentoot:request-uri)))))
"[choose]")))))
(:tr (:td "icon")
(:td (icon-chooser "icon" (poi-icon poi))))
@@ -167,8 +167,8 @@
(submit-button "delete" "delete" :confirm "Really delete the POI?"))))))))
(defmethod handle-object-form ((handler edit-poi-handler)
- (action (eql :save)) (poi poi) req)
- (with-query-params (req published title subtitle description language x y icon movie)
+ (action (eql :save)) (poi poi))
+ (with-query-params (published title subtitle description language x y icon movie)
(unless language (setq language (session-variable :language)))
(let ((args (list :title title
:published published
@@ -180,21 +180,20 @@
(when movie
(setq args (append args (list :movies (list movie)))))
(apply #'update-poi poi language args))
- (with-bos-cms-page (req :title "POI has been updated")
+ (with-bos-cms-page (:title "POI has been updated")
(html (:h2 "Your changes have been saved")
"You may " (cmslink (edit-object-url poi) "continue editing the POI") "."))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :upload-airal))
- (poi poi)
- req)
- (let ((uploaded-file (cdr (find "image-file" (request-uploaded-files req) :test #'equal :key #'car))))
+ (poi poi))
+ (let ((uploaded-file (cdr (find "image-file" (request-uploaded-files) :test #'equal :key #'car))))
(unless uploaded-file
(error "no file uploaded in upload handler"))
(cl-gd:with-image-from-file* (uploaded-file)
(unless (and (eql (cl-gd:image-width) *poi-image-width*)
(eql (cl-gd:image-height) *poi-image-height*))
- (with-bos-cms-page (req :title "Invalid image size")
+ (with-bos-cms-page (:title "Invalid image size")
(:h2 "Invalid image size")
(:p "The image needs to be "
(:princ-safe *poi-image-width*) " pixels wide and "
@@ -207,30 +206,27 @@
(change-slot-values poi 'airals (list (import-image uploaded-file
:class-name 'store-image))))
(redirect (format nil "/edit-poi/~D"
- (store-object-id poi)) req))
+ (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :delete-airal))
- (poi poi)
- req)
+ (poi poi))
(let ((airals (poi-airals poi)))
(change-slot-values poi 'airals nil)
(mapc #'delete-object airals))
(redirect (format nil "/edit-poi/~D"
- (store-object-id poi)) req))
+ (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :delete-movie))
- (poi poi)
- req)
+ (poi poi))
(change-slot-values poi 'movies nil)
- (redirect (format nil "/edit-poi/~D" (store-object-id poi)) req))
+ (redirect (format nil "/edit-poi/~D" (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :upload-panorama))
- (poi poi)
- req)
- (let ((uploaded-file (cdr (find "image-file" (request-uploaded-files req) :test #'equal :key #'car))))
+ (poi poi))
+ (let ((uploaded-file (cdr (find "image-file" (request-uploaded-files) :test #'equal :key #'car))))
(unless uploaded-file
(error "no file uploaded in upload handler"))
(cl-gd:with-image-from-file* (uploaded-file)
@@ -240,23 +236,22 @@
:class-name 'store-image)
(poi-panoramas poi))))
(redirect (format nil "/edit-poi/~D"
- (store-object-id poi)) req))
+ (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
(action (eql :delete-panorama))
- (poi poi)
- req)
- (with-query-params (req panorama-id)
+ (poi poi))
+ (with-query-params (panorama-id)
(let ((panorama (find-store-object (parse-integer panorama-id))))
(change-slot-values poi 'panoramas (remove panorama (poi-panoramas poi)))
(mapc #'delete-object panorama)))
(redirect (format nil "/edit-poi/~D"
- (store-object-id poi)) req))
+ (store-object-id poi))))
(defmethod handle-object-form ((handler edit-poi-handler)
- (action (eql :delete)) (poi poi) req)
+ (action (eql :delete)) (poi poi))
(delete-object poi)
- (with-bos-cms-page (req :title "POI has been deleted")
+ (with-bos-cms-page (:title "POI has been deleted")
(html (:h2 "POI has been deleted")
"The POI has been deleted")))
@@ -266,9 +261,9 @@
()
(:default-initargs :object-class 'poi-image))
-(defmethod handle-object-form ((handler edit-poi-image-handler) action (object (eql nil)) req)
- (with-query-params (req poi)
- (with-bos-cms-page (req :title "Upload new POI image")
+(defmethod handle-object-form ((handler edit-poi-image-handler) action (object (eql nil)))
+ (with-query-params (poi)
+ (with-bos-cms-page (:title "Upload new POI image")
(html
(:h2 "Upload new image")
((:form :method "POST" :enctype "multipart/form-data"))
@@ -276,16 +271,16 @@
(:p "Choose a file: " ((:input :type "file" :name "image-file")))
(:p (submit-button "upload" "upload"))))))
-(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :upload)) poi-image req)
- (with-query-params (req poi)
+(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :upload)) poi-image)
+ (with-query-params (poi)
(setq poi (find-store-object (parse-integer poi) :class 'poi))
- (let ((uploaded-file (cdr (find "image-file" (request-uploaded-files req) :test #'equal :key #'car))))
+ (let ((uploaded-file (cdr (find "image-file" (request-uploaded-files) :test #'equal :key #'car))))
(unless uploaded-file
(error "no file uploaded in upload handler"))
(cl-gd:with-image-from-file* (uploaded-file)
(unless (and (eql (cl-gd:image-width) *poi-image-width*)
(eql (cl-gd:image-height) *poi-image-height*))
- (with-bos-cms-page (req :title "Invalid image size")
+ (with-bos-cms-page (:title "Invalid image size")
(:h2 "Invalid image size")
(:p "The image needs to be "
(:princ-safe *poi-image-width*) " pixels wide and "
@@ -302,15 +297,15 @@
:initargs `(:poi ,poi))))
(redirect (format nil "/edit-poi-image/~D?poi=~D"
(store-object-id poi-image)
- (store-object-id poi)) req))))
+ (store-object-id poi))))))
-(defmethod handle-object-form ((handler edit-poi-image-handler) action poi-image req)
- (with-query-params (req language poi)
+(defmethod handle-object-form ((handler edit-poi-image-handler) action poi-image)
+ (with-query-params (language poi)
(unless language (setq language (session-variable :language)))
- (with-bos-cms-page (req :title "Edit POI Image")
+ (with-bos-cms-page (:title "Edit POI Image")
(html
(cmslink (edit-object-url (poi-image-poi poi-image)) "Back to POI")
- (content-language-chooser req)
+ (content-language-chooser)
((:form :method "post" :enctype "multipart/form-data")
((:input :type "hidden" :name "poi" :value poi))
(:table (:tr (:td "thumbnail")
@@ -334,21 +329,21 @@
:cols 40)))
(:tr (:td (submit-button "save" "save") (submit-button "delete" "delete" :confirm "Really delete the image?")))))))))
-(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :save)) poi-image req)
- (with-query-params (req title subtitle description language)
+(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :save)) poi-image)
+ (with-query-params (title subtitle description language)
(unless language (setq language (session-variable :language)))
(update-poi-image poi-image language
:title title
:subtitle subtitle
:description description)
- (with-bos-cms-page (req :title "POI image has been updated")
+ (with-bos-cms-page (:title "POI image has been updated")
(:h2 "The POI image information has been updated")
"You may " (cmslink (edit-object-url poi-image) "continue editing the POI image"))))
-(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :delete)) poi-image req)
+(defmethod handle-object-form ((handler edit-poi-image-handler) (action (eql :delete)) poi-image)
(let ((poi (poi-image-poi poi-image)))
(delete-object poi-image)
- (with-bos-cms-page (req :title "POI image has been deleted")
+ (with-bos-cms-page (:title "POI image has been deleted")
(:h2 "The POI image has been deleted")
"You may " (cmslink (edit-object-url poi) "continue editing the POI"))))
@@ -363,12 +358,12 @@
(sponsor-country (contract-sponsor contract))
(length (contract-m2s contract))))
-(defmethod handle ((handler poi-javascript-handler) req)
- (with-bknr-http-response (req :content-type "text/html; charset=UTF-8")
- (setf (reply-header-slot-value req :cache-control) "no-cache")
- (setf (reply-header-slot-value req :pragma) "no-cache")
- (setf (reply-header-slot-value req :expires) "-1")
- (with-http-body (req *ent*)
+(defmethod handle ((handler poi-javascript-handler))
+ (with-http-response (:content-type "text/html; charset=UTF-8")
+ (setf (hunchentoot:header-out :cache-control) "no-cache")
+ (setf (hunchentoot:header-out :pragma) "no-cache")
+ (setf (hunchentoot:header-out :expires) "-1")
+ (with-http-body ()
(let ((*standard-output* *html-stream*))
(princ "<script language=\"JavaScript\">") (terpri)
(princ (make-poi-javascript (or (session-variable :language) *default-language*))) (terpri)
@@ -380,18 +375,17 @@
()
(:default-initargs :object-class 'poi :query-function #'find-poi))
-(defmethod handle-object ((handler poi-image-handler) (poi (eql nil)) req)
+(defmethod handle-object ((handler poi-image-handler) (poi (eql nil)))
(error "poi not found"))
-(defmethod handle-object ((handler poi-image-handler) poi req)
- (destructuring-bind (poi-name image-index-string &rest imageproc-arguments) (multiple-value-list (parse-handler-url handler req))
+(defmethod handle-object ((handler poi-image-handler) poi)
+ (destructuring-bind (poi-name image-index-string &rest imageproc-arguments) (multiple-value-list (parse-handler-url handler))
(declare (ignore poi-name))
(let ((image-index (1- (parse-integer image-index-string))))
(if (and (not (minusp image-index))
(< image-index (length (poi-images poi))))
(redirect (format nil "/image/~D~@[~{/~a~}~]"
(store-object-id (nth image-index (poi-images poi)))
- imageproc-arguments)
- req)
+ imageproc-arguments))
(error "image index ~a out of bounds for poi ~a" image-index poi)))))
Modified: branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/reports-xml-handler.lisp Mon Feb 11 12:24:41 2008
@@ -21,7 +21,7 @@
(defmethod handle ((handler reports-xml-handler) req)
(with-xml-response ()
- (destructuring-bind (name &optional *year* &rest arguments) (decoded-handler-path handler req)
+ (destructuring-bind (name &optional *year* &rest arguments) (decoded-handler-path handler)
(setf *year* (and *year* (parse-integer *year*)))
(let ((*contracts-to-process* (sort (remove-if (lambda (contract)
(or (not (contract-paidp contract))
Modified: branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/sponsor-handlers.lisp Mon Feb 11 12:24:41 2008
@@ -6,14 +6,14 @@
(defclass search-sponsors-handler (editor-only-handler form-handler)
())
-(defmethod handle-form ((handler search-sponsors-handler) action req)
- (with-bos-cms-page (req :title "Search for sponsor")))
+(defmethod handle-form ((handler search-sponsors-handler) action)
+ (with-bos-cms-page (:title "Search for sponsor")))
(defclass edit-sponsor-handler (editor-only-handler edit-object-handler)
())
-(defmethod object-handler-get-object ((handler edit-sponsor-handler) req)
- (let ((object (ignore-errors (find-store-object (parse-integer (first (decoded-handler-path handler req)))))))
+(defmethod object-handler-get-object ((handler edit-sponsor-handler))
+ (let ((object (ignore-errors (find-store-object (parse-integer (first (decoded-handler-path handler)))))))
(typecase object
(sponsor object)
(contract (contract-sponsor object))
@@ -36,17 +36,17 @@
(defmethod language-selector ((contract contract))
(language-selector (contract-sponsor contract)))
-(defmethod handle-object-form ((handler edit-sponsor-handler) action (sponsor (eql nil)) req)
- (with-query-params (req id key count)
+(defmethod handle-object-form ((handler edit-sponsor-handler) action (sponsor (eql nil)))
+ (with-query-params (id key count)
(when id
- (redirect #?"/edit-sponsor/$(id)" req)
+ (redirect #?"/edit-sponsor/$(id)")
(return-from handle-object-form))
(when (or key count)
(let ((regex (format nil "(?i)~A" key))
(found 0))
(when count
(setf count (parse-integer count)))
- (with-bos-cms-page (req :title "Sponsor search results")
+ (with-bos-cms-page (:title "Sponsor search results")
((:table :border "1")
(:tr (:th "ID") (:th "Date") (:th "Email") (:th "Name") (:th "SQM") (:th "Country") (:th "Cert-Type") (:th "Paid by"))
(dolist (sponsor (sort (remove-if-not #'sponsor-contracts (class-instances 'sponsor))
@@ -67,7 +67,7 @@
(return))))
(:tr ((:th :colspan "7") (:princ-safe (format nil "~A sponsor~:p ~A" found (if count "shown" "found"))))))))
(return-from handle-object-form)))
- (with-bos-cms-page (req :title "Find or Create Sponsor")
+ (with-bos-cms-page (:title "Find or Create Sponsor")
(html
((:form :name "form")
((:table)
@@ -106,23 +106,23 @@
(defun date-to-universal (date-string)
(apply #'encode-universal-time 0 0 0 (mapcar #'parse-integer (split #?r"\." date-string))))
-(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :create)) (sponsor (eql nil)) req)
- (with-query-params (req numsqm country email name address date language)
+(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :create)) (sponsor (eql nil)))
+ (with-query-params (numsqm country email name address date language)
(let* ((sponsor (make-sponsor :email email :country country :language language))
(contract (make-contract sponsor (parse-integer numsqm)
:paidp (format nil "~A: manually created by ~A"
(format-date-time (get-universal-time))
- (user-login (bknr-request-user req)))
+ (user-login bknr.web:*user*))
:date (date-to-universal date))))
(contract-issue-cert contract name :address address :language language)
- (mail-backoffice-sponsor-data contract req)
- (redirect (format nil "/edit-sponsor/~D" (store-object-id sponsor)) req))))
+ (mail-backoffice-sponsor-data contract)
+ (redirect (format nil "/edit-sponsor/~D" (store-object-id sponsor))))))
(defun contract-checkbox-name (contract)
(format nil "contract-~D-paid" (store-object-id contract)))
-(defmethod handle-object-form ((handler edit-sponsor-handler) action sponsor req)
- (with-bos-cms-page (req :title "Edit Sponsor")
+(defmethod handle-object-form ((handler edit-sponsor-handler) action sponsor)
+ (with-bos-cms-page (:title "Edit Sponsor")
(html
((:form :method "post")
(:h2 "Sponsor Data")
@@ -174,9 +174,9 @@
(:p (submit-button "save" "save")
(submit-button "delete" "delete" :confirm "Really delete this sponsor?"))))))
-(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :save)) sponsor req)
+(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :save)) sponsor)
(let (changed)
- (with-bos-cms-page (req :title "Saving sponsor data")
+ (with-bos-cms-page (:title "Saving sponsor data")
(dolist (field-name '(full-name email password country language info-text))
(let ((field-value (query-param req (string-downcase (symbol-name field-name)))))
(when (and field-value
@@ -192,11 +192,11 @@
(html (:p "Changed contract status to \"paid\""))))
(unless changed
(html (:p "No changes have been made")))
- (html (cmslink (uri-path (request-uri req))
+ (html (cmslink (uri-path (hunchentoot:request-uri))
"Return to sponsor profile")))))
-(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :delete)) sponsor req)
- (with-bos-cms-page (req :title "Sponsor deleted")
+(defmethod handle-object-form ((handler edit-sponsor-handler) (action (eql :delete)) sponsor)
+ (with-bos-cms-page (:title "Sponsor deleted")
(delete-object sponsor)
(html (:p "The sponsor has been deleted"))))
@@ -204,17 +204,16 @@
()
(:default-initargs :object-class 'contract))
-(defmethod handle-object-form ((handler complete-transfer-handler) action (contract (eql nil)) req)
- (with-bos-cms-page (req :title "Invalid contract ID")
+(defmethod handle-object-form ((handler complete-transfer-handler) action (contract (eql nil)))
+ (with-bos-cms-page (:title "Invalid contract ID")
(html "Invalid contract ID, maybe the sponsor or the contract has been deleted")))
-(defmethod handle-object-form ((handler complete-transfer-handler) action contract req)
+(defmethod handle-object-form ((handler complete-transfer-handler) action contract)
(if (contract-paidp contract)
- (redirect (format nil "/edit-sponsor/~D" (store-object-id (contract-sponsor contract)))
- req)
+ (redirect (format nil "/edit-sponsor/~D" (store-object-id (contract-sponsor contract))))
(let ((numsqm (length (contract-m2s contract))))
- (with-query-params (req email)
- (with-bos-cms-page (req :title "Complete square meter sale with wire transfer payment")
+ (with-query-params (email)
+ (with-bos-cms-page (:title "Complete square meter sale with wire transfer payment")
(html
((:form :name "form")
((:input :type "hidden" :name "numsqm" :value #?"$(numsqm)"))
@@ -231,16 +230,16 @@
(:td (text-field "email" :size 20 :value email)))
(:tr (:td (submit-button "process" "process" :formcheck "javascript:return check_complete_sale()")))))))))))
-(defmethod handle-object-form ((handler complete-transfer-handler) (action (eql :process)) contract req)
- (with-query-params (req email country)
- (with-bos-cms-page (req :title "Square meter sale completion")
+(defmethod handle-object-form ((handler complete-transfer-handler) (action (eql :process)) contract)
+ (with-query-params (email country)
+ (with-bos-cms-page (:title "Square meter sale completion")
(if (contract-paidp contract)
(html (:h2 "This sale has already been completed"))
(progn
(html (:h2 "Completing square meter sale"))
(sponsor-set-country (contract-sponsor contract) country)
(contract-set-paidp contract (format nil "~A: wire transfer processed by ~A"
- (format-date-time) (user-login (bknr-request-user req))))
+ (format-date-time) (user-login bknr.web:*user*)))
(when email
(html (:p "Sending instruction email to " (:princ-safe email)))
(mail-instructions-to-sponsor contract email))))
@@ -260,10 +259,10 @@
(sponsor-id-or-x
(find-store-object (parse-integer sponsor-id-or-x) :class 'sponsor))
(t
- (when (eq (find-class 'sponsor) (class-of (bknr-request-user req)))
- (bknr-request-user req))))))
- (with-bknr-http-response (req :content-type "text/html; charset=UTF-8")
- (with-http-body (req *ent*)
+ (when (eq (find-class 'sponsor) (class-of bknr.web:*user*))
+ bknr.web:*user*)))))
+ (with-http-response (:content-type "text/html; charset=UTF-8")
+ (with-http-body ()
(let ((*standard-output* *html-stream*))
(princ "<script language=\"JavaScript\">") (terpri)
(princ "var profil;") (terpri)
@@ -275,16 +274,16 @@
(defclass sponsor-login-handler (page-handler)
())
-(defmethod handle ((handler sponsor-login-handler) req)
- (with-query-params (req __sponsorid)
- (with-bknr-http-response (req :content-type "text/html")
- (setf (reply-header-slot-value req :cache-control) "no-cache")
- (setf (reply-header-slot-value req :pragma) "no-cache")
- (setf (reply-header-slot-value req :expires) "-1")
- (with-http-body (req *ent*)
+(defmethod handle ((handler sponsor-login-handler))
+ (with-query-params (__sponsorid)
+ (with-http-response (:content-type "text/html")
+ (setf (hunchentoot:header-out :cache-control) "no-cache")
+ (setf (hunchentoot:header-out :pragma) "no-cache")
+ (setf (hunchentoot:header-out :expires) "-1")
+ (with-http-body ()
(format *html-stream* "<script>~%parent.set_loginstatus('~A');~%</script>~%"
(cond
- ((eq (find-class 'sponsor) (class-of (bknr-request-user req)))
+ ((eq (find-class 'sponsor) (class-of bknr.web:*user*))
"logged-in")
(__sponsorid
"login-failed")
@@ -295,8 +294,8 @@
()
(:default-initargs :class 'contract))
-(defmethod object-handler-get-object ((handler cert-regen-handler) req)
- (let* ((object-id-string (first (decoded-handler-path handler req)))
+(defmethod object-handler-get-object ((handler cert-regen-handler))
+ (let* ((object-id-string (first (decoded-handler-path handler)))
(object (store-object-with-id (parse-integer object-id-string))))
(cond
((contract-p object)
@@ -305,8 +304,8 @@
(first (sponsor-contracts object)))
(t (error "invalid sponsor or contract id ~A" object-id-string)))))
-(defmethod handle-object-form ((handler cert-regen-handler) action (contract contract) req)
- (with-bos-cms-page (req :title (format nil "Re-generate Certificate~@[~*s~]"
+(defmethod handle-object-form ((handler cert-regen-handler) action (contract contract))
+ (with-bos-cms-page (:title (format nil "Re-generate Certificate~@[~*s~]"
(not (contract-download-only-p contract))))
(html
((:form :name "form")
@@ -322,10 +321,10 @@
(html
(:tr (:td (submit-button "regenerate" "regenerate")))))))))
-(defmethod handle-object-form ((handler cert-regen-handler) (action (eql :regenerate)) (contract contract) req)
- (with-query-params (req name address language)
+(defmethod handle-object-form ((handler cert-regen-handler) (action (eql :regenerate)) (contract contract))
+ (with-query-params (name address language)
(contract-issue-cert contract name :address address :language language))
- (with-bos-cms-page (req :title "Certificate has been recreated")
+ (with-bos-cms-page (:title "Certificate has been recreated")
(html "The certificates for the sponsor have been re-generated." :br)
(unless (contract-download-only-p contract)
(mail-print-pdf contract)
Modified: branches/trunk-reorg/projects/bos/web/web-macros.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/web-macros.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/web-macros.lisp Mon Feb 11 12:24:41 2008
@@ -2,26 +2,25 @@
(enable-interpol-syntax)
-(defmacro with-bos-cms-page ((req &key title response) &rest body)
- `(with-bknr-page (,req :title ,title :response ,response)
+(defmacro with-bos-cms-page ((&key title response) &rest body)
+ `(with-bknr-page (:title ,title :response ,response)
,@body))
(defvar *xml-sink*)
(defmacro with-xml-response ((&key (content-type "text/xml") (root-element "response")) &body body)
- `(with-http-response (*req* *ent* :content-type ,content-type)
- (with-query-params (*req* download)
+ `(with-http-response (:content-type ,content-type)
+ (with-query-params (download)
(when download
- (setf (reply-header-slot-value *req* :content-disposition)
- (format nil "attachment; filename=~A" download))))
- (with-http-body (*req* *ent*)
- (let ((*xml-sink* (make-character-stream-sink net.html.generator:*html-stream* :canonical nil)))
+ (setf (hunchentoot:header-out :content-disposition)
+ (format nil "attachment; filename=~A" download))))
+ (with-http-body ()
+ (let ((*xml-sink* (make-character-stream-sink xhtml-generator:*html-sink* :canonical nil)))
(with-xml-output *xml-sink*
(with-element ,root-element
,@body))))))
-(defmacro with-xml-error-handler (req &body body)
- (declare (ignore req))
+(defmacro with-xml-error-handler (() &body body)
`(handler-case
(progn ,@body)
(error (e)
@@ -29,3 +28,5 @@
(with-element "status"
(attribute "failure" 1)
(text (princ-to-string e)))))))
+
+
Modified: branches/trunk-reorg/projects/bos/web/web-utils.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/web-utils.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/web-utils.lisp Mon Feb 11 12:24:41 2008
@@ -46,20 +46,20 @@
(setf (session-variable :language) *default-language*))
(session-variable :language))
-(defun content-language-chooser (req)
+(defun content-language-chooser ()
(html
((:p :class "languages")
"Content languages: "
(loop for (language-symbol language-name) in (website-languages)
do (labels ((show-language-link ()
- (html (cmslink (format nil "~A?language=~A" (uri-path (request-uri req)) language-symbol)
+ (html (cmslink (format nil "~A?language=~A" (uri-path (hunchentoot:request-uri)) language-symbol)
(:princ-safe language-name)))))
(if (equal (session-variable :language) language-symbol)
(html "[" (show-language-link) "]")
(html (show-language-link)))
(html " "))))))
-(defun decode-ismap-query-string (req)
+(defun decode-ismap-query-string ()
(let ((coord-string (caar (request-query req))))
(when (and coord-string (scan #?r"^\d*,\d*$" coord-string))
(mapcar #'parse-integer (split "," coord-string)))))
Modified: branches/trunk-reorg/projects/bos/web/webserver.lisp
==============================================================================
--- branches/trunk-reorg/projects/bos/web/webserver.lisp (original)
+++ branches/trunk-reorg/projects/bos/web/webserver.lisp Mon Feb 11 12:24:41 2008
@@ -53,7 +53,7 @@
"index" template-name)))))
(call-next-method handler template-name))
-(defmethod initial-template-environment ((expander worldpay-template-handler) req)
+(defmethod initial-template-environment ((expander worldpay-template-handler))
(append (list (cons :website-url *website-url*))
(call-next-method)))
@@ -74,7 +74,7 @@
(when (website-supports-language language)
language)))
-(defun find-browser-prefered-language (req)
+(defun find-browser-prefered-language ()
"Determine the language prefered by the user, as determined by the Accept-Language header
present in the HTTP request. Header decoding is done according to RFC2616, considering individual
language preference weights."
@@ -99,42 +99,41 @@
(defclass index-handler (page-handler)
())
-(defmethod handle ((handler index-handler) req)
- (redirect (format nil "/~A/index" (or (find-browser-prefered-language req)
+(defmethod handle ((handler index-handler))
+ (redirect (format nil "/~A/index" (or (find-browser-prefered-language)
*default-language*))
- req
- *response-moved-permanently*))
+ :permanently *response-moved-permanently*))
(defclass infosystem-handler (page-handler)
())
-(defmethod handle ((handler infosystem-handler) req)
+(defmethod handle ((handler infosystem-handler))
;; XXX hier logout-parameter implementieren
- (with-query-params (req logout)
+ (with-query-params (logout)
(when logout
- (bknr.web::drop-session (bknr-request-session req))))
+ (bknr.web::drop-session *session*)))
(let ((language (session-variable :language)))
- (redirect #?"/infosystem/$(language)/satellitenkarte.htm" req)))
+ (redirect #?"/infosystem/$(language)/satellitenkarte.htm")))
(defclass certificate-handler (object-handler)
()
(:default-initargs :class 'contract))
-(defmethod handle-object ((handler certificate-handler) contract req)
+(defmethod handle-object ((handler certificate-handler) contract)
(unless contract
- (setf contract (find-if #'contract-pdf-pathname (sponsor-contracts (bknr-request-user req)))))
- (redirect (format nil "/certificates/~D.pdf" (store-object-id contract)) req))
+ (setf contract (find-if #'contract-pdf-pathname (sponsor-contracts bknr.web:*user*))))
+ (redirect (format nil "/certificates/~D.pdf" (store-object-id contract))))
(defclass statistics-handler (editor-only-handler prefix-handler)
())
-(defmethod handle ((handler statistics-handler) req)
+(defmethod handle ((handler statistics-handler))
(let ((stats-name (parse-url req)))
(cond
(stats-name
- (redirect (format nil "~A.svg" stats-name) req))
+ (redirect (format nil "~A.svg" stats-name)))
(t
- (with-bos-cms-page (req :title "Statistics browser")
+ (with-bos-cms-page (:title "Statistics browser")
(:p
((:select :id "selector" :onchange "return statistic_selected()")
(dolist (file (directory (merge-pathnames #p"images/statistics/*.svg" *website-directory*)))
@@ -146,15 +145,15 @@
(defclass admin-handler (editor-only-handler page-handler)
())
-(defmethod handle ((handler admin-handler) req)
- (with-bos-cms-page (req :title "CMS and Administration")
+(defmethod handle ((handler admin-handler))
+ (with-bos-cms-page (:title "CMS and Administration")
"Please choose an administration activity from the menu above"))
(defclass bos-authorizer (bknr-authorizer)
())
-(defmethod find-user-from-request-parameters ((authorizer bos-authorizer) req)
- (with-query-params (req __sponsorid __password)
+(defmethod find-user-from-request-parameters ((authorizer bos-authorizer))
+ (with-query-params (__sponsorid __password)
(if (and __sponsorid __password)
(handler-case
(let ((sponsor (find-store-object (parse-integer __sponsorid) :class 'sponsor)))
@@ -172,13 +171,13 @@
(defmethod authorize :after ((authorizer bos-authorizer)
(req http-request)
(ent net.aserve::entity))
- (let ((new-language (or (language-from-url (uri-path (request-uri req)))
+ (let ((new-language (or (language-from-url (uri-path (hunchentoot:request-uri)))
(query-param req "language")))
- (current-language (gethash :language (bknr-session-variables (bknr-request-session req)))))
+ (current-language (gethash :language (bknr-session-variables *session*))))
(when (or (not current-language)
(and new-language
(not (equal new-language current-language))))
- (setf (gethash :language (bknr-session-variables (bknr-request-session req)))
+ (setf (gethash :language (bknr-session-variables *session*))
(or new-language
(find-browser-prefered-language req)
*default-language*)))))
1
0
11 Feb '08
Author: ksprotte
Date: Mon Feb 11 12:22:52 2008
New Revision: 2478
Modified:
branches/trunk-reorg/thirdparty/arnesi/arnesi.asd
Log:
removed slime dependency
Modified: branches/trunk-reorg/thirdparty/arnesi/arnesi.asd
==============================================================================
--- branches/trunk-reorg/thirdparty/arnesi/arnesi.asd (original)
+++ branches/trunk-reorg/thirdparty/arnesi/arnesi.asd Mon Feb 11 12:22:52 2008
@@ -35,7 +35,7 @@
(:file "lisp1" :depends-on ("packages" "lambda-list" "one-liners" "walk" "unwalk"))
(:file "lexenv" :depends-on ("packages" "one-liners"))
(:file "list" :depends-on ("packages" "one-liners" "accumulation" "flow-control"))
- (:file "log" :depends-on ("packages" "numbers" "hash" "io"))
+ ;; (:file "log" :depends-on ("packages" "numbers" "hash" "io"))
(:file "matcher" :depends-on ("packages" "hash" "list" "flow-control" "one-liners"))
(:file "mop" :depends-on ("packages" "mopp"))
(:file "mopp" :depends-on ("packages" "list" "flow-control"))
@@ -63,7 +63,7 @@
:components ((:file "accumulation" :depends-on ("suite"))
(:file "call-cc" :depends-on ("suite"))
(:file "http" :depends-on ("suite"))
- (:file "log" :depends-on ("suite"))
+ ;; (:file "log" :depends-on ("suite"))
(:file "matcher" :depends-on ("suite"))
(:file "numbers" :depends-on ("suite"))
(:file "queue" :depends-on ("suite"))
1
0
[bknr-cvs] r2477 - branches/trunk-reorg/thirdparty/kmrcl-1.97
by ksprotte＠common-lisp.net 11 Feb '08
by ksprotte＠common-lisp.net 11 Feb '08
11 Feb '08
Author: ksprotte
Date: Mon Feb 11 12:22:22 2008
New Revision: 2477
Modified:
branches/trunk-reorg/thirdparty/kmrcl-1.97/package.lisp
Log:
kmrcl removed two offending symbols from export list
Modified: branches/trunk-reorg/thirdparty/kmrcl-1.97/package.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/kmrcl-1.97/package.lisp (original)
+++ branches/trunk-reorg/thirdparty/kmrcl-1.97/package.lisp Mon Feb 11 12:22:22 2008
@@ -119,7 +119,7 @@
#:cwd
#:quit
#:command-line-arguments
- #:copy-file
+ ;; #:copy-file
#:run-shell-command
;; lists.lisp
@@ -253,7 +253,7 @@
#:init/repl
;; From web-utils
- #:*base-url*
+ ;; #:*base-url*
#:base-url!
#:make-url
#:*standard-html-header*
1
0
[bknr-cvs] r2476 - branches/trunk-reorg/thirdparty/cl-gd-0.5.6
by hhubner＠common-lisp.net 11 Feb '08
by hhubner＠common-lisp.net 11 Feb '08
11 Feb '08
Author: hhubner
Date: Mon Feb 11 09:27:45 2008
New Revision: 2476
Modified:
branches/trunk-reorg/thirdparty/cl-gd-0.5.6/ (props changed)
branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd
Log:
ignore .so file, fix conflict
Modified: branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd
==============================================================================
--- branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd (original)
+++ branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd Mon Feb 11 09:27:45 2008
@@ -54,9 +54,5 @@
(:file "drawing")
(:file "strings")
(:file "misc"))
-<<<<<<< .mine
:depends-on (#-clisp :uffi
#+clisp :cffi-uffi-compat))
-=======
- :depends-on (:uffi))
->>>>>>> .r2473
1
0
[bknr-cvs] r2475 - in branches/trunk-reorg/thirdparty/slime: . CVS contrib contrib/CVS
by hhubner＠common-lisp.net 11 Feb '08
by hhubner＠common-lisp.net 11 Feb '08
11 Feb '08
Author: hhubner
Date: Mon Feb 11 09:24:55 2008
New Revision: 2475
Modified:
branches/trunk-reorg/thirdparty/slime/CVS/Entries
branches/trunk-reorg/thirdparty/slime/ChangeLog
branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries
branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog
branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el
branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el
branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp
branches/trunk-reorg/thirdparty/slime/slime.el
branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp
branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp
branches/trunk-reorg/thirdparty/slime/swank-backend.lisp
branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp
branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp
branches/trunk-reorg/thirdparty/slime/swank-corman.lisp
branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp
branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp
branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp
branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp
branches/trunk-reorg/thirdparty/slime/swank-scl.lisp
branches/trunk-reorg/thirdparty/slime/swank.lisp
Log:
update slime from cvs
Modified: branches/trunk-reorg/thirdparty/slime/CVS/Entries
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Entries (original)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Entries Mon Feb 11 09:24:55 2008
@@ -1,7 +1,6 @@
D/contrib////
D/doc////
/.cvsignore/1.5/Thu Oct 11 14:10:25 2007//
-/ChangeLog/1.1282/Thu Feb 7 08:07:30 2008//
/HACKING/1.8/Thu Oct 11 14:10:25 2007//
/NEWS/1.9/Sun Dec 2 04:22:09 2007//
/PROBLEMS/1.8/Thu Oct 11 14:10:25 2007//
@@ -12,24 +11,25 @@
/nregex.lisp/1.4/Thu Oct 11 14:10:25 2007//
/sbcl-pprint-patch.lisp/1.1/Thu Oct 11 14:10:25 2007//
/slime-autoloads.el/1.4/Thu Feb 7 08:07:30 2008//
-/slime.el/1.901/Thu Feb 7 08:07:31 2008//
-/swank-abcl.lisp/1.45/Thu Feb 7 08:07:31 2008//
-/swank-allegro.lisp/1.99/Thu Feb 7 08:07:31 2008//
-/swank-backend.lisp/1.127/Thu Feb 7 08:07:31 2008//
-/swank-clisp.lisp/1.65/Thu Feb 7 08:07:31 2008//
-/swank-cmucl.lisp/1.176/Thu Feb 7 08:07:31 2008//
-/swank-corman.lisp/1.13/Thu Feb 7 08:07:31 2008//
-/swank-ecl.lisp/1.12/Thu Feb 7 08:07:31 2008//
/swank-gray.lisp/1.10/Thu Oct 11 14:10:25 2007//
-/swank-lispworks.lisp/1.94/Thu Feb 7 08:07:31 2008//
/swank-loader.lisp/1.77/Thu Feb 7 08:07:31 2008//
-/swank-openmcl.lisp/1.122/Thu Feb 7 08:07:31 2008//
-/swank-sbcl.lisp/1.189/Thu Feb 7 08:07:31 2008//
-/swank-scl.lisp/1.15/Thu Feb 7 08:07:31 2008//
/swank-source-file-cache.lisp/1.8/Thu Oct 11 14:10:25 2007//
/swank-source-path-parser.lisp/1.18/Thu Feb 7 07:59:36 2008//
/swank.asd/1.5/Thu Oct 11 14:10:25 2007//
-/swank.lisp/1.527/Thu Feb 7 08:07:31 2008//
/test-all.sh/1.2/Thu Oct 11 14:10:25 2007//
/test.sh/1.9/Thu Oct 11 14:10:25 2007//
/xref.lisp/1.2/Thu Oct 11 14:10:25 2007//
+/ChangeLog/1.1289/Mon Feb 11 14:20:11 2008//
+/slime.el/1.904/Mon Feb 11 14:20:11 2008//
+/swank-abcl.lisp/1.47/Mon Feb 11 14:20:11 2008//
+/swank-allegro.lisp/1.101/Mon Feb 11 14:20:11 2008//
+/swank-backend.lisp/1.129/Mon Feb 11 14:20:11 2008//
+/swank-clisp.lisp/1.67/Mon Feb 11 14:20:11 2008//
+/swank-cmucl.lisp/1.178/Mon Feb 11 14:20:11 2008//
+/swank-corman.lisp/1.15/Mon Feb 11 14:20:11 2008//
+/swank-ecl.lisp/1.14/Mon Feb 11 14:20:11 2008//
+/swank-lispworks.lisp/1.97/Mon Feb 11 14:20:11 2008//
+/swank-openmcl.lisp/1.124/Mon Feb 11 14:20:11 2008//
+/swank-sbcl.lisp/1.191/Mon Feb 11 14:20:11 2008//
+/swank-scl.lisp/1.18/Mon Feb 11 14:20:11 2008//
+/swank.lisp/1.531/Mon Feb 11 14:20:11 2008//
Modified: branches/trunk-reorg/thirdparty/slime/ChangeLog
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/ChangeLog (original)
+++ branches/trunk-reorg/thirdparty/slime/ChangeLog Mon Feb 11 09:24:55 2008
@@ -1,3 +1,78 @@
+2008-02-10 Helmut Eller <heller(a)common-lisp.net>
+
+ Remove remaining traces of make-default-inspector.
+
+ * swank-scl.lisp (make-default-inspector, scl-inspector): Deleted.
+ * swank-lispworks.lisp (make-default-inspector)
+ (lispworks-inspector): Deleted.
+
+2008-02-09 Helmut Eller <heller(a)common-lisp.net>
+
+ Drop the first return value of emacs-inspect.
+
+ * swank.lisp (emacs-inspect): Drop the first return value. It
+ wasn't used anymore. Update all methods and callers.
+
+2008-02-09 Helmut Eller <heller(a)common-lisp.net>
+
+ Remove obsolete *slime-inspect-contents-limit*.
+
+ * swank.lisp (*slime-inspect-contents-limit*): Deleted and all its
+ uses. The new implementation isn't specific to hash-tables or
+ arrays.
+
+2008-02-09 Helmut Eller <heller(a)common-lisp.net>
+
+ Limit the length of the inspector content.
+ That's similar to the limitation of the length of backtraces in
+ the debugger.
+
+ * swank.lisp (*inspectee-content*): New variable.
+ (content-range): New function.
+ (inspect-object): Use it with a length of 1000.
+ (inspector-range): New function. Called from Emacs.
+
+ * slime.el (slime-inspector-insert-content)
+ (slime-inspector-insert-range, slime-inspector-insert-range-button)
+ (slime-inspector-fetch-range): New functions.
+ (slime-inspector-operate-on-point): Handle range-buttons.
+
+2008-02-09 Helmut Eller <heller(a)common-lisp.net>
+
+ Make slime-property-bounds more useful.
+
+ * slime.el (slime-property-bounds): Remove special casing for
+ whitespace at the end.
+ (slime-repl-send-input): Don't mark the newline with the
+ slime-repl-old-input property.
+ (sldb-frame-region): Use slime-property-bounds.
+
+2008-02-09 Helmut Eller <heller(a)common-lisp.net>
+
+ Inspector cleanups.
+
+ * swank.lisp (emacs-inspect): Renamed from inspect-for-emacs.
+ Changed all method-defs accordingly.
+ (common-seperated-spec, inspector-princ): Moved to
+ swank-fancy-inspector.lisp.
+ (inspector-content): Renamed from inspector-content-for-emacs.
+ (value-part): Renamed from value-part-for-emacs.
+ (action-part): Renamed from action-part-for-emacs.
+ (inspect-list): Renamed from inspect-for-emacs-list.
+ (inspect-list-aux): New.
+ (inspect-cons): Renamed from inspect-for-emacs-simple-cons.
+ (*inspect-length*): Deleted.
+ (inspect-list): Ignore max-length stuff.
+ (inspector-content): Don't allow nil elements.
+ (emacs-inspect array): Make the label of element type more
+ consistent with the others.
+
+2008-02-09 Helmut Eller <heller(a)common-lisp.net>
+
+ Cleanup slime-repl-set-package.
+
+ * slime.el (slime-repl-set-package): Make it fit within 80 columns.
+
2008-02-05 Marco Baringer <mb(a)bese.it>
* slime.el (slime-search-buffer-package): Ask the lisp to read the
Modified: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries (original)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries Mon Feb 11 09:24:55 2008
@@ -1,4 +1,3 @@
-/ChangeLog/1.87/Thu Feb 7 08:07:31 2008//
/README/1.3/Thu Oct 11 14:10:25 2007//
/bridge.el/1.1/Thu Oct 11 14:10:25 2007//
/inferior-slime.el/1.2/Thu Oct 11 14:10:25 2007//
@@ -7,8 +6,6 @@
/slime-banner.el/1.4/Thu Oct 11 14:10:25 2007//
/slime-c-p-c.el/1.8/Thu Oct 11 14:10:25 2007//
/slime-editing-commands.el/1.6/Thu Feb 7 07:59:35 2008//
-/slime-fancy-inspector.el/1.2/Thu Oct 11 14:10:25 2007//
-/slime-fancy.el/1.4/Thu Oct 11 14:10:25 2007//
/slime-fuzzy.el/1.6/Thu Feb 7 07:59:35 2008//
/slime-highlight-edits.el/1.3/Thu Oct 11 14:10:25 2007//
/slime-indentation.el/1.1/Sun Feb 3 18:45:14 2008//
@@ -25,7 +22,6 @@
/swank-arglists.lisp/1.20/Thu Feb 7 08:07:31 2008//
/swank-asdf.lisp/1.1/Thu Oct 11 14:10:25 2007//
/swank-c-p-c.lisp/1.2/Thu Oct 11 14:10:25 2007//
-/swank-fancy-inspector.lisp/1.7/Thu Feb 7 08:07:32 2008//
/swank-fuzzy.lisp/1.7/Thu Feb 7 07:59:35 2008//
/swank-goo.goo/1.1/Thu Feb 7 08:07:32 2008//
/swank-indentation.lisp/1.1/Sun Feb 3 18:45:14 2008//
@@ -34,4 +30,8 @@
/swank-motd.lisp/1.1/Sun Feb 3 18:39:23 2008//
/swank-presentation-streams.lisp/1.5/Thu Feb 7 08:07:32 2008//
/swank-presentations.lisp/1.4/Thu Oct 11 14:10:25 2007//
+/ChangeLog/1.89/Mon Feb 11 14:20:11 2008//
+/slime-fancy-inspector.el/1.3/Mon Feb 11 14:20:11 2008//
+/slime-fancy.el/1.5/Mon Feb 11 14:20:11 2008//
+/swank-fancy-inspector.lisp/1.11/Mon Feb 11 14:20:11 2008//
D
Modified: branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog (original)
+++ branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog Mon Feb 11 09:24:55 2008
@@ -1,3 +1,16 @@
+2008-02-10 Helmut Eller <heller(a)common-lisp.net>
+
+ Fix some bugs introduced by the recent reorganization.
+
+ * swank-fancy-inspector.lisp (emacs-inspect pathname): Fix it
+ again.
+
+ * slime-fancy-inspector.el: Use slime-require.
+
+ * slime-fancy.el: slime-fancy-inspector-init no longer exists, so
+ don't call it. Once loaded, it's also no longer possible to turn
+ the fancy inspector off.
+
2008-02-04 Marco Baringer <mb(a)bese.it>
* swank-presentation-streams.lisp (presenting-object-1): Add
Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el (original)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el Mon Feb 11 09:24:55 2008
@@ -3,26 +3,7 @@
;; Author: Marco Baringer <mb(a)bese.it> and others
;; License: GNU GPL (same license as Emacs)
;;
-;;; Installation
-;;
-;; Add this to your .emacs:
-;;
-;; (add-to-list 'load-path "<directory-of-this-file>")
-;; (add-hook 'slime-load-hook (lambda () (require 'slime-fancy-inspector)))
-;; (add-hook 'slime-connected-hook 'slime-install-fancy-inspector)
-
-(defun slime-install-fancy-inspector ()
- (slime-eval-async '(swank:swank-require :swank-fancy-inspector)
- (lambda (_)
- (slime-eval-async '(swank:fancy-inspector-init)))))
-
-(defun slime-deinstall-fancy-inspector ()
- (slime-eval-async '(swank:fancy-inspector-unload)))
-
-(defun slime-fancy-inspector-init ()
- (add-hook 'slime-connected-hook 'slime-install-fancy-inspector))
-(defun slime-fancy-inspector-unload ()
- (remove-hook 'slime-connected-hook 'slime-install-fancy-inspector))
+(slime-require :swank-fancy-inspector)
(provide 'slime-fancy-inspector)
\ No newline at end of file
Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el (original)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el Mon Feb 11 09:24:55 2008
@@ -31,9 +31,8 @@
(require 'slime-editing-commands)
(slime-editing-commands-init)
-;; Makes the inspector fancier.
+;; Makes the inspector fancier. (Once loaded, can't be turned off.)
(require 'slime-fancy-inspector)
-(slime-fancy-inspector-init)
;; Just adds the command C-c M-i. We do not make fuzzy completion the
;; default completion invoked by TAB. --mkoeppe
Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp Mon Feb 11 09:24:55 2008
@@ -6,14 +6,12 @@
(in-package :swank)
-(defmethod inspect-for-emacs ((symbol symbol))
+(defmethod emacs-inspect ((symbol symbol))
(let ((package (symbol-package symbol)))
(multiple-value-bind (_symbol status)
(and package (find-symbol (string symbol) package))
(declare (ignore _symbol))
- (values
- "A symbol."
- (append
+ (append
(label-value-line "Its name is" (symbol-name symbol))
;;
;; Value
@@ -77,7 +75,7 @@
;; More package
(if (find-package symbol)
(label-value-line "It names the package" (find-package symbol)))
- )))))
+ ))))
(defun docstring-ispec (label object kind)
"Return a inspector spec if OBJECT has a docstring of of kind KIND."
@@ -89,16 +87,15 @@
(t
(list label ": " '(:newline) " " docstring '(:newline))))))
-(defmethod inspect-for-emacs ((f function))
- (values "A function."
- (append
+(defmethod emacs-inspect ((f function))
+ (append
(label-value-line "Name" (function-name f))
`("Its argument list is: "
,(inspector-princ (arglist f)) (:newline))
(docstring-ispec "Documentation" f t)
(if (function-lambda-expression f)
(label-value-line "Lambda Expression"
- (function-lambda-expression f))))))
+ (function-lambda-expression f)))))
(defun method-specializers-for-inspect (method)
"Return a \"pretty\" list of the method's specializers. Normal
@@ -122,11 +119,10 @@
(swank-mop:method-qualifiers method)
(method-specializers-for-inspect method)))
-(defmethod inspect-for-emacs ((object standard-object))
+(defmethod emacs-inspect ((object standard-object))
(let ((class (class-of object)))
- (values "An object."
`("Class: " (:value ,class) (:newline)
- ,@(all-slots-for-inspector object)))))
+ ,@(all-slots-for-inspector object))))
(defvar *gf-method-getter* 'methods-by-applicability
"This function is called to get the methods of a generic function.
@@ -224,11 +220,9 @@
append slot-presentation
collect '(:newline))))))
-(defmethod inspect-for-emacs ((gf standard-generic-function))
+(defmethod emacs-inspect ((gf standard-generic-function))
(flet ((lv (label value) (label-value-line label value)))
- (values
- "A generic function."
- (append
+ (append
(lv "Name" (swank-mop:generic-function-name gf))
(lv "Arguments" (swank-mop:generic-function-lambda-list gf))
(docstring-ispec "Documentation" gf t)
@@ -247,10 +241,9 @@
(remove-method gf m))))
(:newline)))
`((:newline))
- (all-slots-for-inspector gf)))))
+ (all-slots-for-inspector gf))))
-(defmethod inspect-for-emacs ((method standard-method))
- (values "A method."
+(defmethod emacs-inspect ((method standard-method))
`("Method defined on the generic function "
(:value ,(swank-mop:method-generic-function method)
,(inspector-princ
@@ -267,10 +260,9 @@
(:newline)
"Method function: " (:value ,(swank-mop:method-function method))
(:newline)
- ,@(all-slots-for-inspector method))))
+ ,@(all-slots-for-inspector method)))
-(defmethod inspect-for-emacs ((class standard-class))
- (values "A class."
+(defmethod emacs-inspect ((class standard-class))
`("Name: " (:value ,(class-name class))
(:newline)
"Super classes: "
@@ -326,10 +318,9 @@
`(:value ,(swank-mop:class-prototype class))
'"#<N/A (class not finalized)>")
(:newline)
- ,@(all-slots-for-inspector class))))
+ ,@(all-slots-for-inspector class)))
-(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition))
- (values "A slot."
+(defmethod emacs-inspect ((slot swank-mop:standard-slot-definition))
`("Name: " (:value ,(swank-mop:slot-definition-name slot))
(:newline)
,@(when (swank-mop:slot-definition-documentation slot)
@@ -342,7 +333,7 @@
"#<unspecified>") (:newline)
"Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
(:newline)
- ,@(all-slots-for-inspector slot))))
+ ,@(all-slots-for-inspector slot)))
;; Wrapper structure over the list of symbols of a package that should
@@ -434,10 +425,10 @@
(:newline)
)))))
-(defmethod inspect-for-emacs ((%container %package-symbols-container))
+(defmethod emacs-inspect ((%container %package-symbols-container))
(with-struct (%container. title description symbols grouping-kind) %container
- (values title
- `(,@description
+ `(,title (:newline)
+ ,@description
(:newline)
" " ,(ecase grouping-kind
(:symbol
@@ -449,9 +440,9 @@
,(lambda () (setf grouping-kind :symbol))
:refreshp t)))
(:newline) (:newline)
- ,@(make-symbols-listing grouping-kind symbols)))))
+ ,@(make-symbols-listing grouping-kind symbols))))
-(defmethod inspect-for-emacs ((package package))
+(defmethod emacs-inspect ((package package))
(let ((package-name (package-name package))
(package-nicknames (package-nicknames package))
(package-use-list (package-use-list package))
@@ -479,8 +470,6 @@
external-symbols (sort external-symbols #'string<)) ; SBCL 0.9.18.
- (values
- "A package."
`("" ; dummy to preserve indentation.
"Name: " (:value ,package-name) (:newline)
@@ -542,27 +531,27 @@
(:newline)
,(display-link "shadowed" shadowed-symbols (length shadowed-symbols)
:title (format nil "All shadowed symbols of package \"~A\"" package-name)
- :description nil)))))))
+ :description nil))))))
-(defmethod inspect-for-emacs ((pathname pathname))
- (values (if (wild-pathname-p pathname)
- "A wild pathname."
- "A pathname.")
- (append (label-value-line*
- ("Namestring" (namestring pathname))
- ("Host" (pathname-host pathname))
- ("Device" (pathname-device pathname))
- ("Directory" (pathname-directory pathname))
- ("Name" (pathname-name pathname))
- ("Type" (pathname-type pathname))
- ("Version" (pathname-version pathname)))
- (unless (or (wild-pathname-p pathname)
- (not (probe-file pathname)))
- (label-value-line "Truename" (truename pathname))))))
+(defmethod emacs-inspect ((pathname pathname))
+ `(,(if (wild-pathname-p pathname)
+ "A wild pathname."
+ "A pathname.")
+ (:newline)
+ ,@(label-value-line*
+ ("Namestring" (namestring pathname))
+ ("Host" (pathname-host pathname))
+ ("Device" (pathname-device pathname))
+ ("Directory" (pathname-directory pathname))
+ ("Name" (pathname-name pathname))
+ ("Type" (pathname-type pathname))
+ ("Version" (pathname-version pathname)))
+ ,@ (unless (or (wild-pathname-p pathname)
+ (not (probe-file pathname)))
+ (label-value-line "Truename" (truename pathname)))))
-(defmethod inspect-for-emacs ((pathname logical-pathname))
- (values "A logical pathname."
+(defmethod emacs-inspect ((pathname logical-pathname))
(append
(label-value-line*
("Namestring" (namestring pathname))
@@ -579,10 +568,10 @@
("Type" (pathname-type pathname))
("Version" (pathname-version pathname))
("Truename" (if (not (wild-pathname-p pathname))
- (probe-file pathname)))))))
+ (probe-file pathname))))))
-(defmethod inspect-for-emacs ((n number))
- (values "A number." `("Value: " ,(princ-to-string n))))
+(defmethod emacs-inspect ((n number))
+ `("Value: " ,(princ-to-string n)))
(defun format-iso8601-time (time-value &optional include-timezone-p)
"Formats a universal time TIME-VALUE in ISO 8601 format, with
@@ -604,8 +593,7 @@
year month day hour minute second
include-timezone-p (format-iso8601-timezone zone)))))
-(defmethod inspect-for-emacs ((i integer))
- (values "A number."
+(defmethod emacs-inspect ((i integer))
(append
`(,(format nil "Value: ~D = #x~8,'0X = #o~O = #b~,,' ,8:B~@[ = ~E~]"
i i i i (ignore-errors (coerce i 'float)))
@@ -614,23 +602,20 @@
(label-value-line "Code-char" (code-char i)))
(label-value-line "Integer-length" (integer-length i))
(ignore-errors
- (label-value-line "Universal-time" (format-iso8601-time i t))))))
+ (label-value-line "Universal-time" (format-iso8601-time i t)))))
-(defmethod inspect-for-emacs ((c complex))
- (values "A complex number."
+(defmethod emacs-inspect ((c complex))
(label-value-line*
("Real part" (realpart c))
- ("Imaginary part" (imagpart c)))))
+ ("Imaginary part" (imagpart c))))
-(defmethod inspect-for-emacs ((r ratio))
- (values "A non-integer ratio."
+(defmethod emacs-inspect ((r ratio))
(label-value-line*
("Numerator" (numerator r))
("Denominator" (denominator r))
- ("As float" (float r)))))
+ ("As float" (float r))))
-(defmethod inspect-for-emacs ((f float))
- (values "A floating point number."
+(defmethod emacs-inspect ((f float))
(cond
((> f most-positive-long-float)
(list "Positive infinity."))
@@ -647,13 +632,11 @@
(:value ,significand) " * "
(:value ,(float-radix f)) "^" (:value ,exponent) (:newline))
(label-value-line "Digits" (float-digits f))
- (label-value-line "Precision" (float-precision f))))))))
+ (label-value-line "Precision" (float-precision f)))))))
-(defmethod inspect-for-emacs ((stream file-stream))
- (multiple-value-bind (title content)
+(defmethod emacs-inspect ((stream file-stream))
+ (multiple-value-bind (content)
(call-next-method)
- (declare (ignore title))
- (values "A file stream."
(append
`("Pathname: "
(:value ,(pathname stream))
@@ -665,14 +648,13 @@
(ed-in-emacs `(,pathname :charpos ,position))))
:refreshp nil)
(:newline))
- content))))
+ content)))
-(defmethod inspect-for-emacs ((condition stream-error))
- (multiple-value-bind (title content)
+(defmethod emacs-inspect ((condition stream-error))
+ (multiple-value-bind (content)
(call-next-method)
(let ((stream (stream-error-stream condition)))
(if (typep stream 'file-stream)
- (values "A stream error."
(append
`("Pathname: "
(:value ,(pathname stream))
@@ -684,16 +666,22 @@
(ed-in-emacs `(,pathname :charpos ,position))))
:refreshp nil)
(:newline))
- content))
- (values title content)))))
+ content)
+ content))))
-(defvar *fancy-inpector-undo-list* nil)
-
-(defslimefun fancy-inspector-init ()
- t)
-
-(defslimefun fancy-inspector-unload ()
- (loop while *fancy-inpector-undo-list* do
- (funcall (pop *fancy-inpector-undo-list*))))
+(defun common-seperated-spec (list &optional (callback (lambda (v)
+ `(:value ,v))))
+ (butlast
+ (loop
+ for i in list
+ collect (funcall callback i)
+ collect ", ")))
+
+(defun inspector-princ (list)
+ "Like princ-to-string, but don't rewrite (function foo) as #'foo.
+Do NOT pass circular lists to this function."
+ (let ((*print-pprint-dispatch* (copy-pprint-dispatch)))
+ (set-pprint-dispatch '(cons (member function)) nil)
+ (princ-to-string list)))
(provide :swank-fancy-inspector)
Modified: branches/trunk-reorg/thirdparty/slime/slime.el
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/slime.el (original)
+++ branches/trunk-reorg/thirdparty/slime/slime.el Mon Feb 11 09:24:55 2008
@@ -2267,11 +2267,7 @@
(save-excursion
(when (or (re-search-backward regexp nil t)
(re-search-forward regexp nil t))
- ;; package name can be a string designator, convert it to a string.
- ;;(slime-eval `(cl:string (cl:second (cl:read-from-string ,(match-string-no-properties 0))))
- ;; "COMMON-LISP-USER")
- (match-string-no-properties 2)
- ))))
+ (match-string-no-properties 2)))))
;;; Synchronous requests are implemented in terms of asynchronous
;;; ones. We make an asynchronous request with a continuation function
@@ -3176,14 +3172,14 @@
(let ((end (point))) ; end of input, without the newline
(slime-repl-add-to-input-history
(buffer-substring slime-repl-input-start-mark end))
- (when newline
- (insert "\n")
- (slime-repl-show-maximum-output))
(let ((inhibit-read-only t))
(add-text-properties slime-repl-input-start-mark
(point)
`(slime-repl-old-input
,(incf slime-repl-old-input-counter))))
+ (when newline
+ (insert "\n")
+ (slime-repl-show-maximum-output))
(let ((overlay (make-overlay slime-repl-input-start-mark end)))
;; These properties are on an overlay so that they won't be taken
;; by kill/yank.
@@ -3216,25 +3212,9 @@
(defun slime-property-bounds (prop)
"Return two the positions of the previous and next changes to PROP.
PROP is the name of a text property."
- (let* ((beg (save-excursion
- ;; previous-single-char-property-change searches for a
- ;; property change from the previous character, but we
- ;; want to look for a change from the point. We step
- ;; forward one char to avoid doing the wrong thing if
- ;; we're at the beginning of the old input. -luke
- ;; (18/Jun/2004)
- (unless (not (get-text-property (point) prop))
- ;; alanr unless we are sitting right after it May 19, 2005
- (ignore-errors (forward-char)))
- (previous-single-char-property-change (point) prop)))
- (end (save-excursion
- (if (get-text-property (point) prop)
- (progn (goto-char (next-single-char-property-change
- (point) prop))
- (skip-chars-backward "\n \t\r" beg)
- (point))
- (point)))))
- (values beg end)))
+ (assert (get-text-property (point) prop))
+ (let ((end (next-single-char-property-change (point) prop)))
+ (list (previous-single-char-property-change end prop) end)))
(defun slime-repl-closing-return ()
"Evaluate the current input string after closing all open lists."
@@ -3321,12 +3301,11 @@
(defun slime-repl-set-package (package)
"Set the package of the REPL buffer to PACKAGE."
- (interactive (list (slime-read-package-name "Package: "
- (if (string= (slime-current-package)
- (with-current-buffer (slime-repl-buffer)
- (slime-current-package)))
- nil
- (slime-pretty-find-buffer-package)))))
+ (interactive (list (slime-read-package-name
+ "Package: "
+ (if (equal (slime-current-package) (slime-lisp-package))
+ nil
+ (slime-pretty-find-buffer-package)))))
(with-current-buffer (slime-output-buffer)
(let ((unfinished-input (slime-repl-current-input)))
(destructuring-bind (name prompt-string)
@@ -6821,11 +6800,7 @@
(get-text-property (point) 'details-visible-p)))
(defun sldb-frame-region ()
- (save-excursion
- (goto-char (next-single-property-change (point) 'frame nil (point-max)))
- (backward-char)
- (values (previous-single-property-change (point) 'frame)
- (next-single-property-change (point) 'frame nil (point-max)))))
+ (slime-property-bounds 'frame))
(defun sldb-forward-frame ()
(goto-char (next-single-char-property-change (point) 'frame)))
@@ -7540,8 +7515,8 @@
(while (eq (char-before) ?\n)
(backward-delete-char 1))
(insert "\n" (fontify label "--------------------") "\n")
- (save-excursion
- (mapc slime-inspector-insert-ispec-function content))
+ (save-excursion
+ (slime-inspector-insert-content content))
(pop-to-buffer (current-buffer))
(when point
(check-type point cons)
@@ -7549,6 +7524,22 @@
(goto-line (car point))
(move-to-column (cdr point)))))))))
+(defun slime-inspector-insert-content (content)
+ (destructuring-bind (ispecs len start end) content
+ (slime-inspector-insert-range ispecs len start end t t)))
+
+(defun slime-inspector-insert-range (ispecs len start end prev next)
+ "Insert ISPECS at point.
+LEN is the length of the entire content on the Lisp side.
+START and END are the positions of the subsequnce that ISPECS represents.
+If PREV resp. NEXT are true insert range-buttons as needed."
+ (let ((limit 2000))
+ (when (and prev (> start 0))
+ (slime-inspector-insert-range-button (max 0 (- start limit)) start t))
+ (mapc #'slime-inspector-insert-ispec ispecs)
+ (when (and next (< end len))
+ (slime-inspector-insert-range-button end (min len (+ end limit)) nil))))
+
(defun slime-inspector-insert-ispec (ispec)
(if (stringp ispec)
(insert ispec)
@@ -7580,10 +7571,14 @@
(current-column))))
(defun slime-inspector-operate-on-point ()
- "If point is on a value then recursivly call the inspector on
- that value. If point is on an action then call that action."
+ "Invoke the command for the text at point.
+1. If point is on a value then recursivly call the inspector on
+that value.
+2. If point is on an action then call that action.
+3. If point is on a range-button fetch and insert the range."
(interactive)
(let ((part-number (get-text-property (point) 'slime-part-number))
+ (range-button (get-text-property (point) 'slime-range-button))
(action-number (get-text-property (point) 'slime-action-number))
(opener (lexical-let ((point (slime-inspector-position)))
(lambda (parts)
@@ -7593,6 +7588,8 @@
(slime-eval-async `(swank:inspect-nth-part ,part-number)
opener)
(push (slime-inspector-position) slime-inspector-mark-stack))
+ (range-button
+ (slime-inspector-fetch-range range-button))
(action-number
(slime-eval-async `(swank::inspector-call-nth-action ,action-number)
opener)))))
@@ -7693,7 +7690,6 @@
(progn (goto-char maxpos) (setq previously-wrapped-p t))
(error "No inspectable objects")))))))
-
(defun slime-inspector-previous-inspectable-object (arg)
"Move point to the previous inspectable object.
With optional ARG, move across that many objects.
@@ -7717,6 +7713,25 @@
(lambda (parts)
(slime-open-inspector parts point)))))
+(defun slime-inspector-insert-range-button (start end previous)
+ (slime-insert-propertized
+ (list 'slime-range-button (list start end previous)
+ 'mouse-face 'highlight
+ 'face 'slime-inspector-action-face)
+ (if previous " [--more--]\n" " [--more--]")))
+
+(defun slime-inspector-fetch-range (button)
+ (destructuring-bind (start end previous) button
+ (slime-eval-async
+ `(swank:inspector-range ,start ,end)
+ (slime-rcurry
+ (lambda (content prev)
+ (let ((inhibit-read-only t))
+ (apply #'delete-region (slime-property-bounds 'slime-range-button))
+ (destructuring-bind (i l s e) content
+ (slime-inspector-insert-range i l s e prev (not prev)))))
+ previous))))
+
(slime-define-keys slime-inspector-mode-map
([return] 'slime-inspector-operate-on-point)
((kbd "M-RET") 'slime-inspector-copy-down)
@@ -9630,7 +9645,7 @@
;; Local Variables:
;; outline-regexp: ";;;;+"
;; indent-tabs-mode: nil
-;; coding: latin-1-unix!
+;; coding: latin-1-unix
;; unibyte: t
;; compile-command: "emacs -batch -L . -eval '(byte-compile-file \"slime.el\")' ; rm -v slime.elc"
;; End:
Modified: branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp Mon Feb 11 09:24:55 2008
@@ -421,8 +421,7 @@
;;;; Inspecting
-(defmethod inspect-for-emacs ((slot mop::slot-definition))
- (values "A slot."
+(defmethod emacs-inspect ((slot mop::slot-definition))
`("Name: " (:value ,(mop::%slot-definition-name slot))
(:newline)
"Documentation:" (:newline)
@@ -434,10 +433,9 @@
`(:value ,(mop::%slot-definition-initform slot))
"#<unspecified>") (:newline)
" Function: " (:value ,(mop::%slot-definition-initfunction slot))
- (:newline))))
+ (:newline)))
-(defmethod inspect-for-emacs ((f function))
- (values "A function."
+(defmethod emacs-inspect ((f function))
`(,@(when (function-name f)
`("Name: "
,(princ-to-string (function-name f)) (:newline)))
@@ -449,19 +447,18 @@
`("Documentation:" (:newline) ,(documentation f t) (:newline)))
,@(when (function-lambda-expression f)
`("Lambda expression:"
- (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline))))))
+ (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline)))))
#|
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(let* ((class (class-of o))
(slots (mop::class-slots class)))
- (values (format nil "~A~% is a ~A" o class)
(mapcar (lambda (slot)
(let ((name (mop::slot-definition-name slot)))
(cons (princ-to-string name)
(slot-value o name))))
- slots))))
+ slots)))
|#
;;;; Multithreading
Modified: branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp Mon Feb 11 09:24:55 2008
@@ -564,23 +564,22 @@
;;;; Inspecting
-(defmethod inspect-for-emacs ((f function))
- (values "A function."
+(defmethod emacs-inspect ((f function))
(append
(label-value-line "Name" (function-name f))
`("Formals" ,(princ-to-string (arglist f)) (:newline))
(let ((doc (documentation (excl::external-fn_symdef f) 'function)))
(when doc
- `("Documentation:" (:newline) ,doc))))))
+ `("Documentation:" (:newline) ,doc)))))
-(defmethod inspect-for-emacs ((o t))
- (values "A value." (allegro-inspect o)))
+(defmethod emacs-inspect ((o t))
+ (allegro-inspect o))
-(defmethod inspect-for-emacs ((o function))
- (values "A function." (allegro-inspect o)))
+(defmethod emacs-inspect ((o function))
+ (allegro-inspect o))
-(defmethod inspect-for-emacs ((o standard-object))
- (values (format nil "~A is a standard-object." o) (allegro-inspect o)))
+(defmethod emacs-inspect ((o standard-object))
+ (allegro-inspect o))
(defun allegro-inspect (o)
(loop for (d dd) on (inspect::inspect-ctl o)
Modified: branches/trunk-reorg/thirdparty/slime/swank-backend.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-backend.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-backend.lisp Mon Feb 11 09:24:55 2008
@@ -33,11 +33,7 @@
#:declaration-arglist
#:type-specifier-arglist
;; inspector related symbols
- #:inspector
- #:backend-inspector
- #:inspect-for-emacs
- #:raw-inspection
- #:fancy-inspection
+ #:emacs-inspect
#:label-value-line
#:label-value-line*
#:with-struct
@@ -840,13 +836,11 @@
;;;; Inspector
-(defgeneric inspect-for-emacs (object)
+(defgeneric emacs-inspect (object)
(:documentation
"Explain to Emacs how to inspect OBJECT.
-Returns two values: a string which will be used as the title of
-the inspector buffer and a list specifying how to render the
-object for inspection.
+Returns a list specifying how to render the object for inspection.
Every element of the list must be either a string, which will be
inserted into the buffer as is, or a list of the form:
@@ -861,20 +855,17 @@
string) which when clicked will call LAMBDA. If REFRESH is
non-NIL the currently inspected object will be re-inspected
after calling the lambda.
+"))
- NIL - do nothing."))
-
-(defmethod inspect-for-emacs ((object t))
+(defmethod emacs-inspect ((object t))
"Generic method for inspecting any kind of object.
Since we don't know how to deal with OBJECT we simply dump the
output of CL:DESCRIBE."
- (values
- "A value."
`("Type: " (:value ,(type-of object)) (:newline)
"Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
(:newline) (:newline)
- ,(with-output-to-string (desc) (describe object desc)))))
+ ,(with-output-to-string (desc) (describe object desc))))
;;; Utilities for inspector methods.
;;;
Modified: branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp Mon Feb 11 09:24:55 2008
@@ -627,7 +627,7 @@
;;;; Inspecting
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(let* ((*print-array* nil) (*print-pretty* t)
(*print-circle* t) (*print-escape* t)
(*print-lines* custom:*inspect-print-lines*)
@@ -638,9 +638,10 @@
(*package* tmp-pack)
(sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
(let ((inspection (sys::inspect-backend o)))
- (values (format nil "~S~% ~A~{~%~A~}" o
+ (append (list
+ (format nil "~S~% ~A~{~%~A~}~%" o
(sys::insp-title inspection)
- (sys::insp-blurb inspection))
+ (sys::insp-blurb inspection)))
(loop with count = (sys::insp-num-slots inspection)
for i below count
append (multiple-value-bind (value name)
Modified: branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp Mon Feb 11 09:24:55 2008
@@ -1822,11 +1822,6 @@
;;;; Inspecting
-(defclass cmucl-inspector (backend-inspector) ())
-
-(defimplementation make-default-inspector ()
- (make-instance 'cmucl-inspector))
-
(defconstant +lowtag-symbols+
'(vm:even-fixnum-type
vm:function-pointer-type
@@ -1869,10 +1864,9 @@
:key #'symbol-value)))
(format t ", type: ~A" type-symbol))))))
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(cond ((di::indirect-value-cell-p o)
- (values (format nil "~A is a value cell." o)
- `("Value: " (:value ,(c:value-cell-ref o)))))
+ `("Value: " (:value ,(c:value-cell-ref o))))
((alien::alien-value-p o)
(inspect-alien-value o))
(t
@@ -1880,63 +1874,59 @@
(defun cmucl-inspect (o)
(destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
- (values (format nil "~A~%" text)
- (if labeledp
- (loop for (label . value) in parts
- append (label-value-line label value))
- (loop for value in parts for i from 0
- append (label-value-line i value))))))
+ (list* (format nil "~A~%" text)
+ (if labeledp
+ (loop for (label . value) in parts
+ append (label-value-line label value))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))
-(defmethod inspect-for-emacs ((o function))
+(defmethod emacs-inspect ((o function))
(let ((header (kernel:get-type o)))
(cond ((= header vm:function-header-type)
- (values (format nil "~A is a function." o)
- (append (label-value-line*
- ("Self" (kernel:%function-self o))
- ("Next" (kernel:%function-next o))
- ("Name" (kernel:%function-name o))
- ("Arglist" (kernel:%function-arglist o))
- ("Type" (kernel:%function-type o))
- ("Code" (kernel:function-code-header o)))
- (list
- (with-output-to-string (s)
- (disassem:disassemble-function o :stream s))))))
+ (append (label-value-line*
+ ("Self" (kernel:%function-self o))
+ ("Next" (kernel:%function-next o))
+ ("Name" (kernel:%function-name o))
+ ("Arglist" (kernel:%function-arglist o))
+ ("Type" (kernel:%function-type o))
+ ("Code" (kernel:function-code-header o)))
+ (list
+ (with-output-to-string (s)
+ (disassem:disassemble-function o :stream s)))))
((= header vm:closure-header-type)
- (values (format nil "~A is a closure" o)
- (append
- (label-value-line "Function" (kernel:%closure-function o))
- `("Environment:" (:newline))
- (loop for i from 0 below (1- (kernel:get-closure-length o))
- append (label-value-line
- i (kernel:%closure-index-ref o i))))))
+ (list* (format nil "~A is a closure.~%" o)
+ (append
+ (label-value-line "Function" (kernel:%closure-function o))
+ `("Environment:" (:newline))
+ (loop for i from 0 below (1- (kernel:get-closure-length o))
+ append (label-value-line
+ i (kernel:%closure-index-ref o i))))))
((eval::interpreted-function-p o)
(cmucl-inspect o))
(t
(call-next-method)))))
-(defmethod inspect-for-emacs ((o kernel:funcallable-instance))
- (values
- (format nil "~A is a funcallable-instance." o)
- (append (label-value-line*
- (:function (kernel:%funcallable-instance-function o))
- (:lexenv (kernel:%funcallable-instance-lexenv o))
- (:layout (kernel:%funcallable-instance-layout o)))
- (nth-value 1 (cmucl-inspect o)))))
-
-(defmethod inspect-for-emacs ((o kernel:code-component))
- (values (format nil "~A is a code data-block." o)
- (append
- (label-value-line*
- ("code-size" (kernel:%code-code-size o))
- ("entry-points" (kernel:%code-entry-points o))
- ("debug-info" (kernel:%code-debug-info o))
- ("trace-table-offset" (kernel:code-header-ref
- o vm:code-trace-table-offset-slot)))
- `("Constants:" (:newline))
- (loop for i from vm:code-constants-offset
- below (kernel:get-header-data o)
- append (label-value-line i (kernel:code-header-ref o i)))
- `("Code:" (:newline)
+(defmethod emacs-inspect ((o kernel:funcallable-instance))
+ (append (label-value-line*
+ (:function (kernel:%funcallable-instance-function o))
+ (:lexenv (kernel:%funcallable-instance-lexenv o))
+ (:layout (kernel:%funcallable-instance-layout o)))
+ (cmucl-inspect o)))
+
+(defmethod emacs-inspect ((o kernel:code-component))
+ (append
+ (label-value-line*
+ ("code-size" (kernel:%code-code-size o))
+ ("entry-points" (kernel:%code-entry-points o))
+ ("debug-info" (kernel:%code-debug-info o))
+ ("trace-table-offset" (kernel:code-header-ref
+ o vm:code-trace-table-offset-slot)))
+ `("Constants:" (:newline))
+ (loop for i from vm:code-constants-offset
+ below (kernel:get-header-data o)
+ append (label-value-line i (kernel:code-header-ref o i)))
+ `("Code:" (:newline)
, (with-output-to-string (s)
(cond ((kernel:%code-debug-info o)
(disassem:disassemble-code-component o :stream s))
@@ -1948,63 +1938,57 @@
(* vm:code-constants-offset vm:word-bytes))
(ash 1 vm:lowtag-bits))
(ash (kernel:%code-code-size o) vm:word-shift)
- :stream s))))))))
+ :stream s)))))))
-(defmethod inspect-for-emacs ((o kernel:fdefn))
- (values (format nil "~A is a fdenf object." o)
- (label-value-line*
- ("name" (kernel:fdefn-name o))
- ("function" (kernel:fdefn-function o))
- ("raw-addr" (sys:sap-ref-32
- (sys:int-sap (kernel:get-lisp-obj-address o))
- (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+(defmethod emacs-inspect ((o kernel:fdefn))
+ (label-value-line*
+ ("name" (kernel:fdefn-name o))
+ ("function" (kernel:fdefn-function o))
+ ("raw-addr" (sys:sap-ref-32
+ (sys:int-sap (kernel:get-lisp-obj-address o))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes)))))
-(defmethod inspect-for-emacs ((o array))
+#+(or)
+(defmethod emacs-inspect ((o array))
(if (typep o 'simple-array)
(call-next-method)
- (values (format nil "~A is an array." o)
- (label-value-line*
- (:header (describe-primitive-type o))
- (:rank (array-rank o))
- (:fill-pointer (kernel:%array-fill-pointer o))
- (:fill-pointer-p (kernel:%array-fill-pointer-p o))
- (:elements (kernel:%array-available-elements o))
- (:data (kernel:%array-data-vector o))
- (:displacement (kernel:%array-displacement o))
- (:displaced-p (kernel:%array-displaced-p o))
- (:dimensions (array-dimensions o))))))
-
-(defmethod inspect-for-emacs ((o simple-vector))
- (values (format nil "~A is a simple-vector." o)
- (append
- (label-value-line*
- (:header (describe-primitive-type o))
- (:length (c::vector-length o)))
- (loop for i below (length o)
- append (label-value-line i (aref o i))))))
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:rank (array-rank o))
+ (:fill-pointer (kernel:%array-fill-pointer o))
+ (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+ (:elements (kernel:%array-available-elements o))
+ (:data (kernel:%array-data-vector o))
+ (:displacement (kernel:%array-displacement o))
+ (:displaced-p (kernel:%array-displaced-p o))
+ (:dimensions (array-dimensions o)))))
+
+(defmethod emacs-inspect ((o simple-vector))
+ (append
+ (label-value-line*
+ (:header (describe-primitive-type o))
+ (:length (c::vector-length o)))
+ (loop for i below (length o)
+ append (label-value-line i (aref o i)))))
(defun inspect-alien-record (alien)
- (values
- (format nil "~A is an alien value." alien)
- (with-struct (alien::alien-value- sap type) alien
- (with-struct (alien::alien-record-type- kind name fields) type
- (append
- (label-value-line*
- (:sap sap)
- (:kind kind)
- (:name name))
- (loop for field in fields
- append (let ((slot (alien::alien-record-field-name field)))
- (label-value-line slot (alien:slot alien slot)))))))))
+ (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-record-type- kind name fields) type
+ (append
+ (label-value-line*
+ (:sap sap)
+ (:kind kind)
+ (:name name))
+ (loop for field in fields
+ append (let ((slot (alien::alien-record-field-name field)))
+ (label-value-line slot (alien:slot alien slot))))))))
(defun inspect-alien-pointer (alien)
- (values
- (format nil "~A is an alien value." alien)
- (with-struct (alien::alien-value- sap type) alien
- (label-value-line*
- (:sap sap)
- (:type type)
- (:to (alien::deref alien))))))
+ (with-struct (alien::alien-value- sap type) alien
+ (label-value-line*
+ (:sap sap)
+ (:type type)
+ (:to (alien::deref alien)))))
(defun inspect-alien-value (alien)
(typecase (alien::alien-value-type alien)
Modified: branches/trunk-reorg/thirdparty/slime/swank-corman.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-corman.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-corman.lisp Mon Feb 11 09:24:55 2008
@@ -393,8 +393,7 @@
collect (funcall callback e)
collect ", ")))
-(defmethod inspect-for-emacs ((class standard-class))
- (values "A class."
+(defmethod emacs-inspect ((class standard-class))
`("Name: " (:value ,(class-name class))
(:newline)
"Super classes: "
@@ -428,12 +427,11 @@
(lambda (class)
`(:value ,class ,(princ-to-string (class-name class)))))
'("#<N/A (class not finalized)>"))
- (:newline))))
+ (:newline)))
-(defmethod inspect-for-emacs ((slot cons))
+(defmethod emacs-inspect ((slot cons))
;; Inspects slot definitions
(if (eq (car slot) :name)
- (values "A slot."
`("Name: " (:value ,(swank-mop:slot-definition-name slot))
(:newline)
,@(when (swank-mop:slot-definition-documentation slot)
@@ -445,13 +443,14 @@
`(:value ,(swank-mop:slot-definition-initform slot))
"#<unspecified>") (:newline)
"Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
- (:newline)))
+ (:newline))
(call-next-method)))
-(defmethod inspect-for-emacs ((pathname pathnames::pathname-internal))
- (values (if (wild-pathname-p pathname)
+(defmethod emacs-inspect ((pathname pathnames::pathname-internal))
+ (list* (if (wild-pathname-p pathname)
"A wild pathname."
"A pathname.")
+ '(:newline)
(append (label-value-line*
("Namestring" (namestring pathname))
("Host" (pathname-host pathname))
@@ -464,13 +463,11 @@
(not (probe-file pathname)))
(label-value-line "Truename" (truename pathname))))))
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(cond ((cl::structurep o) (inspect-structure o))
(t (call-next-method))))
(defun inspect-structure (o)
- (values
- (format nil "~A is a structure" o)
(let* ((template (cl::uref o 1))
(num-slots (cl::struct-template-num-slots template)))
(cond ((symbolp template)
@@ -479,7 +476,7 @@
(t
(loop for i below num-slots
append (label-value-line (elt template (+ 6 (* i 5)))
- (cl::uref o (+ 2 i)))))))))
+ (cl::uref o (+ 2 i))))))))
;;; Threads
Modified: branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp Mon Feb 11 09:24:55 2008
@@ -248,12 +248,12 @@
;;;; Inspector
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
; ecl clos support leaves some to be desired
(cond
((streamp o)
- (values
- (format nil "~S is an ordinary stream" o)
+ (list*
+ (format nil "~S is an ordinary stream~%" o)
(append
(list
"Open for "
@@ -285,7 +285,7 @@
(t
(let* ((cl (si:instance-class o))
(slots (clos:class-slots cl)))
- (values (format nil "~S is an instance of class ~A"
+ (list* (format nil "~S is an instance of class ~A~%"
o (clos::class-name cl))
(loop for x in slots append
(let* ((name (clos:slot-definition-name x))
Modified: branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp Mon Feb 11 09:24:55 2008
@@ -624,32 +624,27 @@
append (frob-locs dspec (dspec:dspec-definition-locations dspec)))))
;;; Inspector
-(defclass lispworks-inspector (backend-inspector) ())
-(defimplementation make-default-inspector ()
- (make-instance 'lispworks-inspector))
-
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(lispworks-inspect o))
-(defmethod inspect-for-emacs ((o function))
+(defmethod emacs-inspect ((o function))
(lispworks-inspect o))
;; FIXME: slot-boundp-using-class in LW works with names so we can't
;; use our method in swank.lisp.
-(defmethod inspect-for-emacs ((o standard-object))
+(defmethod emacs-inspect ((o standard-object))
(lispworks-inspect o))
(defun lispworks-inspect (o)
(multiple-value-bind (names values _getter _setter type)
(lw:get-inspector-values o nil)
(declare (ignore _getter _setter))
- (values "A value."
(append
(label-value-line "Type" type)
(loop for name in names
for value in values
- append (label-value-line name value))))))
+ append (label-value-line name value)))))
;;; Miscellaneous
Modified: branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp Mon Feb 11 09:24:55 2008
@@ -802,7 +802,7 @@
(string (gethash typecode *value2tag*))
(string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm))))))
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(let* ((i (inspector::make-inspector o))
(count (inspector::compute-line-count i))
(lines
@@ -814,24 +814,16 @@
collect " = "
collect `(:value ,value)
collect '(:newline))))
- (values (with-output-to-string (s)
- (let ((*print-lines* 1)
- (*print-right-margin* 80))
- (pprint o s)))
- lines)))
+ lines))
-(defmethod inspect-for-emacs :around ((o t))
+(defmethod emacs-inspect :around ((o t))
(if (or (uvector-inspector-p o)
(not (ccl:uvectorp o)))
(call-next-method)
- (multiple-value-bind (title content)
- (call-next-method)
- (values
- title
- (append content
+ (append (call-next-method)
`((:newline)
(:value ,(make-instance 'uvector-inspector :object o)
- "Underlying UVECTOR")))))))
+ "Underlying UVECTOR")))))
(defclass uvector-inspector ()
((object :initarg :object)))
@@ -840,15 +832,14 @@
(:method ((object t)) nil)
(:method ((object uvector-inspector)) t))
-(defmethod inspect-for-emacs ((uv uvector-inspector))
+(defmethod emacs-inspect ((uv uvector-inspector))
(with-slots (object)
uv
- (values (format nil "The UVECTOR for ~S." object)
(loop
for index below (ccl::uvsize object)
collect (format nil "~D: " index)
collect `(:value ,(ccl::uvref object index))
- collect `(:newline)))))
+ collect `(:newline))))
(defun closure-closed-over-values (closure)
(let ((howmany (nth-value 8 (ccl::function-args (ccl::closure-function closure)))))
@@ -860,9 +851,9 @@
(cellp (ccl::closed-over-value-p value)))
(list label (if cellp (ccl::closed-over-value value) value))))))
-(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure))
- (values
- (format nil "A closure: ~a" c)
+(defmethod emacs-inspect ((c ccl::compiled-lexical-closure))
+ (list*
+ (format nil "A closure: ~a~%" c)
`(,@(if (arglist c)
(list "Its argument list is: "
(funcall (intern "INSPECTOR-PRINC" 'swank) (arglist c)))
Modified: branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp Mon Feb 11 09:24:55 2008
@@ -1001,41 +1001,38 @@
;;;; Inspector
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(cond ((sb-di::indirect-value-cell-p o)
- (values "A value cell." (label-value-line*
- (:value (sb-kernel:value-cell-ref o)))))
+ (label-value-line* (:value (sb-kernel:value-cell-ref o))))
(t
(multiple-value-bind (text label parts) (sb-impl::inspected-parts o)
- (if label
- (values text (loop for (l . v) in parts
- append (label-value-line l v)))
- (values text (loop for value in parts for i from 0
- append (label-value-line i value))))))))
+ (list* (format nil "~a~%" text)
+ (if label
+ (loop for (l . v) in parts
+ append (label-value-line l v))
+ (loop for value in parts for i from 0
+ append (label-value-line i value))))))))
-(defmethod inspect-for-emacs ((o function))
+(defmethod emacs-inspect ((o function))
(let ((header (sb-kernel:widetag-of o)))
(cond ((= header sb-vm:simple-fun-header-widetag)
- (values "A simple-fun."
(label-value-line*
(:name (sb-kernel:%simple-fun-name o))
(:arglist (sb-kernel:%simple-fun-arglist o))
(:self (sb-kernel:%simple-fun-self o))
(:next (sb-kernel:%simple-fun-next o))
(:type (sb-kernel:%simple-fun-type o))
- (:code (sb-kernel:fun-code-header o)))))
+ (:code (sb-kernel:fun-code-header o))))
((= header sb-vm:closure-header-widetag)
- (values "A closure."
(append
(label-value-line :function (sb-kernel:%closure-fun o))
`("Closed over values:" (:newline))
(loop for i below (1- (sb-kernel:get-closure-length o))
append (label-value-line
- i (sb-kernel:%closure-index-ref o i))))))
+ i (sb-kernel:%closure-index-ref o i)))))
(t (call-next-method o)))))
-(defmethod inspect-for-emacs ((o sb-kernel:code-component))
- (values (format nil "~A is a code data-block." o)
+(defmethod emacs-inspect ((o sb-kernel:code-component))
(append
(label-value-line*
(:code-size (sb-kernel:%code-code-size o))
@@ -1060,28 +1057,24 @@
sb-vm:n-word-bytes))
(ash 1 sb-vm:n-lowtag-bits))
(ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
- :stream s))))))))
+ :stream s)))))))
-(defmethod inspect-for-emacs ((o sb-ext:weak-pointer))
- (values "A weak pointer."
+(defmethod emacs-inspect ((o sb-ext:weak-pointer))
(label-value-line*
- (:value (sb-ext:weak-pointer-value o)))))
+ (:value (sb-ext:weak-pointer-value o))))
-(defmethod inspect-for-emacs ((o sb-kernel:fdefn))
- (values "A fdefn object."
+(defmethod emacs-inspect ((o sb-kernel:fdefn))
(label-value-line*
(:name (sb-kernel:fdefn-name o))
- (:function (sb-kernel:fdefn-fun o)))))
+ (:function (sb-kernel:fdefn-fun o))))
-(defmethod inspect-for-emacs :around ((o generic-function))
- (multiple-value-bind (title contents) (call-next-method)
- (values title
+(defmethod emacs-inspect :around ((o generic-function))
(append
- contents
+ (call-next-method)
(label-value-line*
(:pretty-arglist (sb-pcl::generic-function-pretty-arglist o))
(:initial-methods (sb-pcl::generic-function-initial-methods o))
- )))))
+ )))
;;;; Multiprocessing
Modified: branches/trunk-reorg/thirdparty/slime/swank-scl.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-scl.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank-scl.lisp Mon Feb 11 09:24:55 2008
@@ -1693,11 +1693,6 @@
;;;; Inspecting
-(defclass scl-inspector (backend-inspector) ())
-
-(defimplementation make-default-inspector ()
- (make-instance 'scl-inspector))
-
(defconstant +lowtag-symbols+
'(vm:even-fixnum-type
vm:instance-pointer-type
@@ -1740,10 +1735,9 @@
:key #'symbol-value)))
(format t ", type: ~A" type-symbol))))))
-(defmethod inspect-for-emacs ((o t))
+(defmethod emacs-inspect ((o t))
(cond ((di::indirect-value-cell-p o)
- (values (format nil "~A is a value cell." o)
- `("Value: " (:value ,(c:value-cell-ref o)))))
+ `("Value: " (:value ,(c:value-cell-ref o))))
((alien::alien-value-p o)
(inspect-alien-value o))
(t
@@ -1752,17 +1746,17 @@
(defun scl-inspect (o)
(destructuring-bind (text labeledp . parts)
(inspect::describe-parts o)
- (values (format nil "~A~%" text)
+ (list* (format nil "~A~%" text)
(if labeledp
(loop for (label . value) in parts
append (label-value-line label value))
(loop for value in parts for i from 0
append (label-value-line i value))))))
-(defmethod inspect-for-emacs ((o function))
+(defmethod emacs-inspect ((o function))
(let ((header (kernel:get-type o)))
(cond ((= header vm:function-header-type)
- (values (format nil "~A is a function." o)
+ (list* (format nil "~A is a function.~%" o)
(append (label-value-line*
("Self" (kernel:%function-self o))
("Next" (kernel:%function-next o))
@@ -1774,7 +1768,7 @@
(with-output-to-string (s)
(disassem:disassemble-function o :stream s))))))
((= header vm:closure-header-type)
- (values (format nil "~A is a closure" o)
+ (list* (format nil "~A is a closure.~%" o)
(append
(label-value-line "Function" (kernel:%closure-function o))
`("Environment:" (:newline))
@@ -1788,8 +1782,7 @@
(call-next-method)))))
-(defmethod inspect-for-emacs ((o kernel:code-component))
- (values (format nil "~A is a code data-block." o)
+(defmethod emacs-inspect ((o kernel:code-component))
(append
(label-value-line*
("code-size" (kernel:%code-code-size o))
@@ -1813,20 +1806,19 @@
(* vm:code-constants-offset vm:word-bytes))
(ash 1 vm:lowtag-bits))
(ash (kernel:%code-code-size o) vm:word-shift)
- :stream s))))))))
+ :stream s)))))))
-(defmethod inspect-for-emacs ((o kernel:fdefn))
- (values (format nil "~A is a fdenf object." o)
- (label-value-line*
+(defmethod emacs-inspect ((o kernel:fdefn))
+ (label-value-line*
("name" (kernel:fdefn-name o))
("function" (kernel:fdefn-function o))
("raw-addr" (sys:sap-ref-32
(sys:int-sap (kernel:get-lisp-obj-address o))
- (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+ (* vm:fdefn-raw-addr-slot vm:word-bytes)))))
-(defmethod inspect-for-emacs ((o array))
+(defmethod emacs-inspect ((o array))
(cond ((kernel:array-header-p o)
- (values (format nil "~A is an array." o)
+ (list* (format nil "~A is an array.~%" o)
(label-value-line*
(:header (describe-primitive-type o))
(:rank (array-rank o))
@@ -1838,13 +1830,13 @@
(:displaced-p (kernel:%array-displaced-p o))
(:dimensions (array-dimensions o)))))
(t
- (values (format nil "~A is an simple-array." o)
+ (list* (format nil "~A is an simple-array.~%" o)
(label-value-line*
(:header (describe-primitive-type o))
(:length (length o)))))))
-(defmethod inspect-for-emacs ((o simple-vector))
- (values (format nil "~A is a vector." o)
+(defmethod emacs-inspect ((o simple-vector))
+ (list* (format nil "~A is a vector.~%" o)
(append
(label-value-line*
(:header (describe-primitive-type o))
@@ -1854,8 +1846,6 @@
append (label-value-line i (aref o i)))))))
(defun inspect-alien-record (alien)
- (values
- (format nil "~A is an alien value." alien)
(with-struct (alien::alien-value- sap type) alien
(with-struct (alien::alien-record-type- kind name fields) type
(append
@@ -1865,16 +1855,14 @@
(:name name))
(loop for field in fields
append (let ((slot (alien::alien-record-field-name field)))
- (label-value-line slot (alien:slot alien slot)))))))))
+ (label-value-line slot (alien:slot alien slot))))))))
(defun inspect-alien-pointer (alien)
- (values
- (format nil "~A is an alien value." alien)
- (with-struct (alien::alien-value- sap type) alien
+ (with-struct (alien::alien-value- sap type) alien
(label-value-line*
(:sap sap)
(:type type)
- (:to (alien::deref alien))))))
+ (:to (alien::deref alien)))))
(defun inspect-alien-value (alien)
(typecase (alien::alien-value-type alien)
Modified: branches/trunk-reorg/thirdparty/slime/swank.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/slime/swank.lisp (original)
+++ branches/trunk-reorg/thirdparty/slime/swank.lisp Mon Feb 11 09:24:55 2008
@@ -13,7 +13,7 @@
;;; available to us here via the `SWANK-BACKEND' package.
(defpackage :swank
- (:use :common-lisp :swank-backend)
+ (:use :cl :swank-backend)
(:export #:startup-multiprocessing
#:start-server
#:create-server
@@ -24,8 +24,8 @@
#:print-indentation-lossage
#:swank-debugger-hook
#:run-after-init-hook
- #:inspect-for-emacs
- #:inspect-slot-for-emacs
+ #:emacs-inspect
+ ;;#:inspect-slot-for-emacs
;; These are user-configurable variables:
#:*communication-style*
#:*dont-close*
@@ -2677,176 +2677,19 @@
;;;; Inspecting
-(defun common-seperated-spec (list &optional (callback (lambda (v)
- `(:value ,v))))
- (butlast
- (loop
- for i in list
- collect (funcall callback i)
- collect ", ")))
-
-(defun inspector-princ (list)
- "Like princ-to-string, but don't rewrite (function foo) as #'foo.
-Do NOT pass circular lists to this function."
- (let ((*print-pprint-dispatch* (copy-pprint-dispatch)))
- (set-pprint-dispatch '(cons (member function)) nil)
- (princ-to-string list)))
-
-(defmethod inspect-for-emacs ((object cons))
- (if (consp (cdr object))
- (inspect-for-emacs-list object)
- (inspect-for-emacs-simple-cons object)))
-
-(defun inspect-for-emacs-simple-cons (cons)
- (values "A cons cell."
- (label-value-line*
- ('car (car cons))
- ('cdr (cdr cons)))))
-
-(defun inspect-for-emacs-list (list)
- (let ((maxlen 40))
- (multiple-value-bind (length tail) (safe-length list)
- (flet ((frob (title list)
- (let (lines)
- (loop for i from 0 for rest on list do
- (if (consp (cdr rest)) ; e.g. (A . (B . ...))
- (push (label-value-line i (car rest)) lines)
- (progn ; e.g. (A . NIL) or (A . B)
- (push (label-value-line i (car rest) :newline nil) lines)
- (when (cdr rest)
- (push '((:newline)) lines)
- (push (label-value-line ':tail () :newline nil) lines))
- (loop-finish)))
- finally
- (setf lines (reduce #'append (nreverse lines) :from-end t)))
- (values title (append '("Elements:" (:newline)) lines)))))
-
- (cond ((not length) ; circular
- (frob "A circular list."
- (cons (car list)
- (ldiff (cdr list) list))))
- ((and (<= length maxlen) (not tail))
- (frob "A proper list." list))
- (tail
- (frob "An improper list." list))
- (t
- (frob "A proper list." list)))))))
-
-;; (inspect-for-emacs-list '#1=(a #1# . #1# ))
-
-(defun safe-length (list)
- "Similar to `list-length', but avoid errors on improper lists.
-Return two values: the length of the list and the last cdr.
-NIL is returned if the list is circular."
- (do ((n 0 (+ n 2)) ;Counter.
- (fast list (cddr fast)) ;Fast pointer: leaps by 2.
- (slow list (cdr slow))) ;Slow pointer: leaps by 1.
- (nil)
- (cond ((null fast) (return (values n nil)))
- ((not (consp fast)) (return (values n fast)))
- ((null (cdr fast)) (return (values (1+ n) (cdr fast))))
- ((and (eq fast slow) (> n 0)) (return nil))
- ((not (consp (cdr fast))) (return (values (1+ n) (cdr fast)))))))
-
-(defvar *slime-inspect-contents-limit* nil "How many elements of
- a hash table or array to show by default. If table has more than
- this then offer actions to view more. Set to nil for no limit." )
-
-(defmethod inspect-for-emacs ((ht hash-table))
- (values (prin1-to-string ht)
- (append
- (label-value-line*
- ("Count" (hash-table-count ht))
- ("Size" (hash-table-size ht))
- ("Test" (hash-table-test ht))
- ("Rehash size" (hash-table-rehash-size ht))
- ("Rehash threshold" (hash-table-rehash-threshold ht)))
- (let ((weakness (hash-table-weakness ht)))
- (when weakness
- `("Weakness: " (:value ,weakness) (:newline))))
- (unless (zerop (hash-table-count ht))
- `((:action "[clear hashtable]" ,(lambda () (clrhash ht))) (:newline)
- "Contents: " (:newline)))
- (if (and *slime-inspect-contents-limit*
- (>= (hash-table-count ht) *slime-inspect-contents-limit*))
- (inspect-bigger-piece-actions ht (hash-table-count ht))
- nil)
- (loop for key being the hash-keys of ht
- for value being the hash-values of ht
- repeat (or *slime-inspect-contents-limit* most-positive-fixnum)
- append `((:value ,key) " = " (:value ,value)
- " " (:action "[remove entry]"
- ,(let ((key key))
- (lambda () (remhash key ht))))
- (:newline))))))
-
-(defun inspect-bigger-piece-actions (thing size)
- (append
- (if (> size *slime-inspect-contents-limit*)
- (list (inspect-show-more-action thing)
- '(:newline))
- nil)
- (list (inspect-whole-thing-action thing size)
- '(:newline))))
-
-(defun inspect-whole-thing-action (thing size)
- `(:action ,(format nil "Inspect all ~a elements."
- size)
- ,(lambda()
- (let ((*slime-inspect-contents-limit* nil))
- (swank::inspect-object thing)))))
-
-(defun inspect-show-more-action (thing)
- `(:action ,(format nil "~a elements shown. Prompt for how many to inspect..."
- *slime-inspect-contents-limit* )
- ,(lambda()
- (let ((*slime-inspect-contents-limit*
- (progn (format t "How many elements should be shown? ") (read))))
- (swank::inspect-object thing)))))
-
-(defmethod inspect-for-emacs ((array array))
- (values "An array."
- (append
- (label-value-line*
- ("Dimensions" (array-dimensions array))
- ("Its element type is" (array-element-type array))
- ("Total size" (array-total-size array))
- ("Adjustable" (adjustable-array-p array)))
- (when (array-has-fill-pointer-p array)
- (label-value-line "Fill pointer" (fill-pointer array)))
- '("Contents:" (:newline))
- (if (and *slime-inspect-contents-limit*
- (>= (array-total-size array) *slime-inspect-contents-limit*))
- (inspect-bigger-piece-actions array (length array))
- nil)
- (loop for i below (or *slime-inspect-contents-limit* (array-total-size array))
- append (label-value-line i (row-major-aref array i))))))
-
-(defmethod inspect-for-emacs ((char character))
- (values "A character."
- (append
- (label-value-line*
- ("Char code" (char-code char))
- ("Lower cased" (char-downcase char))
- ("Upper cased" (char-upcase char)))
- (if (get-macro-character char)
- `("In the current readtable ("
- (:value ,*readtable*) ") it is a macro character: "
- (:value ,(get-macro-character char)))))))
-
(defvar *inspectee*)
+(defvar *inspectee-content*)
(defvar *inspectee-parts*)
(defvar *inspectee-actions*)
-(defvar *inspector-stack* '())
-(defvar *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))
-(declaim (type vector *inspector-history*))
-(defvar *inspect-length* 30)
+(defvar *inspector-stack*)
+(defvar *inspector-history*)
(defun reset-inspector ()
(setq *inspectee* nil
- *inspector-stack* nil
+ *inspectee-content* nil
*inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0)
*inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)
+ *inspector-stack* '()
*inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
(defslimefun init-inspector (string)
@@ -2854,54 +2697,57 @@
(reset-inspector)
(inspect-object (eval (read-from-string string)))))
-(defun print-part-to-string (value)
- (let ((string (to-string value))
- (pos (position value *inspector-history*)))
- (if pos
- (format nil "#~D=~A" pos string)
- string)))
+(defun inspect-object (o)
+ (push (setq *inspectee* o) *inspector-stack*)
+ (unless (find o *inspector-history*)
+ (vector-push-extend o *inspector-history*))
+ (let ((*print-pretty* nil) ; print everything in the same line
+ (*print-circle* t)
+ (*print-readably* nil))
+ (setq *inspectee-content* (inspector-content (emacs-inspect o))))
+ (list :title (with-output-to-string (s)
+ (print-unreadable-object (o s :type t :identity t)))
+ :id (assign-index o *inspectee-parts*)
+ :content (content-range *inspectee-content* 0 500)))
-(defun inspector-content-for-emacs (specs)
+(defun inspector-content (specs)
(loop for part in specs collect
(etypecase part
- (null ; XXX encourages sloppy programming
- nil)
+ ;;(null ; XXX encourages sloppy programming
+ ;; nil)
(string part)
(cons (destructure-case part
((:newline)
- (string #\newline))
+ '#.(string #\newline))
((:value obj &optional str)
- (value-part-for-emacs obj str))
+ (value-part obj str))
((:action label lambda &key (refreshp t))
- (action-part-for-emacs label lambda refreshp)))))))
+ (action-part label lambda refreshp)))))))
(defun assign-index (object vector)
(let ((index (fill-pointer vector)))
(vector-push-extend object vector)
index))
-(defun value-part-for-emacs (object string)
+(defun value-part (object string)
(list :value
(or string (print-part-to-string object))
(assign-index object *inspectee-parts*)))
-(defun action-part-for-emacs (label lambda refreshp)
+(defun action-part (label lambda refreshp)
(list :action label (assign-index (list lambda refreshp)
*inspectee-actions*)))
-(defun inspect-object (object)
- (push (setq *inspectee* object) *inspector-stack*)
- (unless (find object *inspector-history*)
- (vector-push-extend object *inspector-history*))
- (let ((*print-pretty* nil) ; print everything in the same line
- (*print-circle* t)
- (*print-readably* nil))
- (multiple-value-bind (_ content) (inspect-for-emacs object)
- (declare (ignore _))
- (list :title (with-output-to-string (s)
- (print-unreadable-object (object s :type t :identity t)))
- :id (assign-index object *inspectee-parts*)
- :content (inspector-content-for-emacs content)))))
+(defun print-part-to-string (value)
+ (let ((string (to-string value))
+ (pos (position value *inspector-history*)))
+ (if pos
+ (format nil "#~D=~A" pos string)
+ string)))
+
+(defun content-range (list start end)
+ (let* ((len (length list)) (end (min len end)))
+ (list (subseq list start end) len start end)))
(defslimefun inspector-nth-part (index)
(aref *inspectee-parts* index))
@@ -2910,18 +2756,20 @@
(with-buffer-syntax ()
(inspect-object (inspector-nth-part index))))
+(defslimefun inspector-range (from to)
+ (content-range *inspectee-content* from to))
+
(defslimefun inspector-call-nth-action (index &rest args)
- (destructuring-bind (action-lambda refreshp)
- (aref *inspectee-actions* index)
- (apply action-lambda args)
+ (destructuring-bind (fun refreshp) (aref *inspectee-actions* index)
+ (apply fun args)
(if refreshp
(inspect-object (pop *inspector-stack*))
;; tell emacs that we don't want to refresh the inspector buffer
nil)))
(defslimefun inspector-pop ()
- "Drop the inspector stack and inspect the second element. Return
-nil if there's no second element."
+ "Drop the inspector stack and inspect the second element.
+Return nil if there's no second element."
(with-buffer-syntax ()
(cond ((cdr *inspector-stack*)
(pop *inspector-stack*)
@@ -2931,10 +2779,10 @@
(defslimefun inspector-next ()
"Inspect the next element in the *inspector-history*."
(with-buffer-syntax ()
- (let ((position (position *inspectee* *inspector-history*)))
- (cond ((= (1+ position) (length *inspector-history*))
+ (let ((pos (position *inspectee* *inspector-history*)))
+ (cond ((= (1+ pos) (length *inspector-history*))
nil)
- (t (inspect-object (aref *inspector-history* (1+ position))))))))
+ (t (inspect-object (aref *inspector-history* (1+ pos))))))))
(defslimefun inspector-reinspect ()
(inspect-object *inspectee*))
@@ -2968,6 +2816,111 @@
(reset-inspector)
(inspect-object (frame-var-value frame var))))
+;;;;; Lists
+
+(defmethod emacs-inspect ((o cons))
+ (if (consp (cdr o))
+ (inspect-list o)
+ (inspect-cons o)))
+
+(defun inspect-cons (cons)
+ (label-value-line*
+ ('car (car cons))
+ ('cdr (cdr cons))))
+
+;; (inspect-list '#1=(a #1# . #1# ))
+;; (inspect-list (list* 'a 'b 'c))
+;; (inspect-list (make-list 10000))
+
+(defun inspect-list (list)
+ (multiple-value-bind (length tail) (safe-length list)
+ (flet ((frob (title list)
+ (list* title '(:newline) (inspect-list-aux list))))
+ (cond ((not length)
+ (frob "A circular list:"
+ (cons (car list)
+ (ldiff (cdr list) list))))
+ ((not tail)
+ (frob "A proper list:" list))
+ (t
+ (frob "An improper list:" list))))))
+
+(defun inspect-list-aux (list)
+ (loop for i from 0 for rest on list while (consp rest) append
+ (cond ((consp (cdr rest))
+ (label-value-line i (car rest)))
+ ((cdr rest)
+ (label-value-line* (i (car rest))
+ (:tail (cdr rest))))
+ (t
+ (label-value-line i (car rest))))))
+
+(defun safe-length (list)
+ "Similar to `list-length', but avoid errors on improper lists.
+Return two values: the length of the list and the last cdr.
+Return NIL if LIST is circular."
+ (do ((n 0 (+ n 2)) ;Counter.
+ (fast list (cddr fast)) ;Fast pointer: leaps by 2.
+ (slow list (cdr slow))) ;Slow pointer: leaps by 1.
+ (nil)
+ (cond ((null fast) (return (values n nil)))
+ ((not (consp fast)) (return (values n fast)))
+ ((null (cdr fast)) (return (values (1+ n) (cdr fast))))
+ ((and (eq fast slow) (> n 0)) (return nil))
+ ((not (consp (cdr fast))) (return (values (1+ n) (cdr fast)))))))
+
+;;;;; Hashtables
+
+(defmethod emacs-inspect ((ht hash-table))
+ (append
+ (label-value-line*
+ ("Count" (hash-table-count ht))
+ ("Size" (hash-table-size ht))
+ ("Test" (hash-table-test ht))
+ ("Rehash size" (hash-table-rehash-size ht))
+ ("Rehash threshold" (hash-table-rehash-threshold ht)))
+ (let ((weakness (hash-table-weakness ht)))
+ (when weakness
+ (label-value-line "Weakness:" weakness)))
+ (unless (zerop (hash-table-count ht))
+ `((:action "[clear hashtable]"
+ ,(lambda () (clrhash ht))) (:newline)
+ "Contents: " (:newline)))
+ (loop for key being the hash-keys of ht
+ for value being the hash-values of ht
+ append `((:value ,key) " = " (:value ,value)
+ " " (:action "[remove entry]"
+ ,(let ((key key))
+ (lambda () (remhash key ht))))
+ (:newline)))))
+
+;;;;; Arrays
+
+(defmethod emacs-inspect ((array array))
+ (append
+ (label-value-line*
+ ("Dimensions" (array-dimensions array))
+ ("Element type" (array-element-type array))
+ ("Total size" (array-total-size array))
+ ("Adjustable" (adjustable-array-p array)))
+ (when (array-has-fill-pointer-p array)
+ (label-value-line "Fill pointer" (fill-pointer array)))
+ '("Contents:" (:newline))
+ (loop for i below (array-total-size array)
+ append (label-value-line i (row-major-aref array i)))))
+
+;;;;; Chars
+
+(defmethod emacs-inspect ((char character))
+ (append
+ (label-value-line*
+ ("Char code" (char-code char))
+ ("Lower cased" (char-downcase char))
+ ("Upper cased" (char-upcase char)))
+ (if (get-macro-character char)
+ `("In the current readtable ("
+ (:value ,*readtable*) ") it is a macro character: "
+ (:value ,(get-macro-character char))))))
;;;; Thread listing
1
0
[bknr-cvs] r2474 - in branches/trunk-reorg/thirdparty: cl-gd-0.5.6 uffi uffi-1.6.0 uffi-1.6.0/benchmarks uffi-1.6.0/doc uffi-1.6.0/examples uffi-1.6.0/src uffi-1.6.0/src/corman uffi-1.6.0/tests
by hhubner＠common-lisp.net 11 Feb '08
by hhubner＠common-lisp.net 11 Feb '08
11 Feb '08
Author: hhubner
Date: Mon Feb 11 09:23:05 2008
New Revision: 2474
Added:
branches/trunk-reorg/thirdparty/uffi-1.6.0/
branches/trunk-reorg/thirdparty/uffi-1.6.0/AUTHORS
branches/trunk-reorg/thirdparty/uffi-1.6.0/ChangeLog
branches/trunk-reorg/thirdparty/uffi-1.6.0/INSTALL
branches/trunk-reorg/thirdparty/uffi-1.6.0/LICENSE
branches/trunk-reorg/thirdparty/uffi-1.6.0/Makefile
branches/trunk-reorg/thirdparty/uffi-1.6.0/Makefile.common
branches/trunk-reorg/thirdparty/uffi-1.6.0/NEWS
branches/trunk-reorg/thirdparty/uffi-1.6.0/README
branches/trunk-reorg/thirdparty/uffi-1.6.0/TODO
branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/
branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/Makefile
branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/allocation.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/COPYING.GFDL
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/Makefile
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/appendix.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/bookinfo.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-darwin.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-debian.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-mandrake.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse90.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse91.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-ubuntu.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/entities.inc
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/fo.xsl
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/glossary.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html.tar.gz (contents, props changed)
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html.xsl
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html_chunk.xsl
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/intro.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/notes.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/preface.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_aggregate.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_declare.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_func_libr.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_object.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_primitive.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_string.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/schemas.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/uffi.pdf
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/uffi.xml
branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/xinclude.mod
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/Makefile
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/Makefile.msvc
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/acl-compat-tester.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/arrays.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/atoifl.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/c-test-fns.c
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/c-test-fns.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/compress.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/file-socket.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/getenv.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/gethostname.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/getshells.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/gettime.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/run-examples.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/strtol.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/test-examples.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/union.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/Makefile
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/corman-notes.txt
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/getenv-ccl.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/functions.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/libraries.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/objects.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/os.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/package.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/readmacros-mcl.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/strings.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/Makefile
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/Makefile.msvc
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/arrays.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/atoifl.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/casts.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/compress.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/foreign-loader.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/foreign-var.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/getenv.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/gethostname.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/make.sh
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/objects.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/package.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/rt.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/strtol.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/structs.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/time.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/uffi-c-test-lib.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/uffi-c-test.c
branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/union.lisp
branches/trunk-reorg/thirdparty/uffi-1.6.0/uffi-tests.asd
branches/trunk-reorg/thirdparty/uffi-1.6.0/uffi.asd
Removed:
branches/trunk-reorg/thirdparty/uffi/
Modified:
branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd
Log:
switch to release uffi
Modified: branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd
==============================================================================
--- branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd (original)
+++ branches/trunk-reorg/thirdparty/cl-gd-0.5.6/cl-gd.asd Mon Feb 11 09:23:05 2008
@@ -54,4 +54,9 @@
(:file "drawing")
(:file "strings")
(:file "misc"))
+<<<<<<< .mine
+ :depends-on (#-clisp :uffi
+ #+clisp :cffi-uffi-compat))
+=======
:depends-on (:uffi))
+>>>>>>> .r2473
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/AUTHORS
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/AUTHORS Mon Feb 11 09:23:05 2008
@@ -0,0 +1,12 @@
+Kevin M. Rosenberg <kevin(a)rosenberg.net>
+ Primary author
+
+John Desoi <desoi(a)mac.com>
+ Contributed MCL & OpenMCL support
+
+Reini Urban <rurban(a)x-ray.at>
+ Contributed initial Corman support
+
+Edi Weitz <edi(a)weitz.de>
+ Contributed with-cast-pointer and def-foreign-var along with
+ documentation
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/ChangeLog
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/ChangeLog Mon Feb 11 09:23:05 2008
@@ -0,0 +1,350 @@
+2007-07-22 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.6.0 (SPECIFICATION CHANGE)
+ * doc/ref_func_libr.xml: Change the specification of
+ load-foreign-library to better match the actual action of the
+ function. Rather than returning NIL for failure to load library,
+ signal an error.
+ * src/libraries.lisp: Rework load-foreign-library to ensure errors
+ are signaled on failure to load library. This was the case for
+ some implementations, change the other implementations to
+ match. (Inconsistency found due to Mark Wooding's remarks)
+
+2007-04-12 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.18
+ * src/functions.lisp: Patch from Ian Eslick for Lispworks 5
+
+2006-10-10 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.17
+ * src/functions.lisp: Patch from Edi Weitz for Lispworks 5/Linux
+
+2006-09-02 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.16
+ * src/libraries.lisp: Add cygwin support
+
+2006-08-13 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.15
+ * src/{objects,strings}.lisp: Add support for Lispworks 5
+ thanks to patches from Bill Atkins
+
+2006-07-04 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.14
+ * src/{objects,strings}.lisp: Apply patch from Edi Weitz
+
+2006-05-17 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.13
+ * src/libraries.lisp: Revert buggy patch from Yaroslav Kavenchuk.
+
+2006-05-17 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.12
+ * src/libraries.lisp: Patch from Yaroslav Kavenchuk to set
+ default drive letters on MS Windows.
+
+2006-05-11 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.11: Export new macro DEF-POINTER-VAR based on patch from
+ James Bielman to support defining variables on platforms which
+ support saving objects, such as openmcl
+
+2006-04-17 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.10: Commit patch from Gary King for openmcl's
+ feature list change
+
+2005-11-14 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.7
+ * src/strings.lisp: Add with-foreign-strings by James Biel
+
+2005-11-14 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.6
+ * src/os.lisp: Remove getenv setter
+
+2005-11-07 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.5
+ * src/os.lisp: Add support for getenv getter and setter
+
+2005-09-17 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.4
+ * src/objects.lisp: prepend _ character for entry
+ point on Allegro macosx, patch by Luis Oliveira
+
+2005-07-05 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.5.0
+ * Remove vestigial LLGPL license notices as UFFI as been
+ BSD-licensed for several years.
+
+2005-06-09 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.4.39
+ * tests/objects.lisp: Rename from pointers.lisp.
+ Fix test CHPTR.4 as noted by Jorg Hohle
+ * src/objects.lisp: Remove default from ensure-char-integer
+
+2005-06-09 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.4.38
+ * src/libraries.lisp: Commit patch from Edi Weitz to
+ allow plain filename library names to allow underlying
+ lisp implementation to find foreign libraries in the
+ locations known to the operating system.
+ * tests/cast.lisp: Add :module keyword as noted by Jorg Hohle.
+ * src/strings.lisp: Avoid multiple evaluation of input
+ parameters for macros as noted by Jorg Hohle.
+
+2005-04-12 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Version 1.4.37
+ * src/strings.lisp: Fix variable name
+
+2005-04-04 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/strings.lisp, src/aggregates.lisp: Support change in SBCL copy
+ function [Thanks for Nathan Froyd and Zach Beane]
+
+2005-04-03 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/objects.lisp: Commit patch from James Bielman to add
+ def-foreign-var support for OpenMCL
+
+2005-03-03 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/primitives.lisp: Add support for :union types
+ [patch from Cyrus Harmon]
+ * tests/union.lisp, tests/structs.lisp: Tests for
+ union and structure types [from Cyrus Harmon]
+
+2005-02-22 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/primitives.lisp, src/strings.lisp: Better support
+ for sb-unicode [from Yoshinori Tahara and R. Mattes]
+
+2005-01-22 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/primitives.lisp: Better support SBCL-AMD64
+
+2004-11-08 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/strings.lisp: Better support sb-unicode
+ * tests/compress.lisp: Support sb-unicode
+
+2004-10-07 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/objects.lisp: Add new function:
+ convert-from-foreign-usb8
+
+2004-04-15 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/objects.lisp: Add new functions:
+ MAKE-POINTER and POINTER-ADDRESS
+
+2004-04-13 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/string.lisp: Add new FOREIGN-STRING-LENGTH
+
+2003-08-15 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Added with-cast-pointer and def-foreign-var (patches submitted
+ by Edi Weitz).
+ * Added many new tests
+
+2002-10-16 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Added support for SBCL and SCL
+
+2002-09-29 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * Numerous changes in openmcl support (uffi now supports
+ clsql on openmcl)
+
+2002-09-19 Kevin Rosenberg (kevin(a)rosenberg.net)
+ - Integrate John Desoi's OpenMCL support into src-mcl
+ * examples/Makefile: add section for building on MacOS X (John Desoi)
+ * examples/test-examples: changed from mk: to asdf: package loading (KMR)
+ * examples/run-examples: changed from mk: to asdf: package loading (KMR),
+ add conditional loading if UFFI not loaded (John Desoi)
+ * examples/compress.cl: Add dylib to library types for MacOSX (John Desoi),
+ converted compressed output to hexidecimal display (KMR)
+ * examples/union.cl: Rework the tests (KMR)
+ * src-main/libraries.cl: add dylib as default library type on MacOSX (John Desoi)
+ * src-main/aggregates.cl: convert from uffi type in deref-array (John Desoi)
+
+2002-09-16 Kevin Rosenberg (kevin(a)rosenberg.net)
+ - Restructure directories to move to a asdf definition file
+ without pathnames.
+
+2002-08-25 Kevin Rosenberg (kevin(a)rosenberg.net)
+ - Restructure directories to attempt to properly handle both
+ Common Lisp Controller and non-CLC systems
+
+2002-08-17 Kevin Rosenberg (kevin(a)rosenberg.net)
+
+ - add uffi.asd for ASDF users
+
+2002-08-01 Kevin Rosenberg (kevin(a)rosenberg.net)
+ - Restructure directories to improve Common Lisp Controller v3
+ compatibility
+
+2002-07-25 Kevin Rosenberg (kevin(a)rosenberg.net)
+
+ - Rework handling of logical pathnames.
+ - Move run-examples.cl to examples directory.
+
+2002-06-28 Kevin Rosenberg (kevin(a)rosenberg.net)
+
+ - Added size-of-foreign-type function.
+
+2002-06-26 Kevin Rosenberg (kevin(a)rosenberg.net)
+
+ - Fix bug in Lispworks allocate-foreign-object
+ - Added new :unsigned-byte type. Made :byte signed.
+
+2002-04-27 Kevin Rosenberg (kevin(a)rosenberg.net)
+ - misc files
+ First debian version
+
+2002-04-23 Kevin Rosenberg (kevin(a)rosenberg.net)
+ - doc/*
+ Updated to debian docbook catalog
+
+2002-04-23 John DeSoi (desoi(a)mac.com)
+ * src/mcl/*
+ Improved MCL support
+
+2002-04-06 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/mcl/libraries.cl:
+ Removed unnecessary function and added find-foreign-library
+ * src/mcl/*.cl:
+ Added authorship for John DeSoi
+ * doc/ref.sgml:
+ Added documentation for find-foreign-library
+ * uffi.system:
+ Simplied logical pathnames and MCL loading
+
+2002-04-04 John DeSoi (desoi(a)mac.com)
+ * src/mcl/*.cl
+ Added initial support for MCL
+
+2002-04-02 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/libraries.cl:
+ Added test for .so libraries on CMUCL and use sys::load-object-file instead
+ of alien:load-library-file
+ * examples/Makefile:
+ Updated defaults so library is created correctly on Linux, FreeBSD, and Solaris
+
+2002-04-02 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * examples/compress.cl:
+ Fixed missing '/'
+ * examples/union.cl:
+ Added support for SPARC big-endian
+ * test-examples.cl:
+ Automated testing suite
+
+2002-04-01 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/libraries.cl:
+ * examples/Makefile:
+ Changed default type for FreeBSD and updated Makefile for
+ FreeBSD and Solaris. Enhanced find-foreign-library to
+ take a list of types to search.
+ * examples/compress.cl:
+ Add support to use find-foreign-library
+
+2002-03-31 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/strings.cl:
+ Fixed bug in with-foreign-string (Thanks Harald Hanche-Olsen)
+ * examples/Makefile:
+ Create a .a library file for FreeBSD
+ * src/libraries.cl:
+ Added default type and find-foreign-library functions
+
+2002-03-29 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/objects.cl:
+ Fixed bug in deref-pointer (Thanks John Desoi!)
+
+2002-03-22 Kevin Rosenberg (kevin(a)rosenberg.net)
+ * src/aggregates.cl:
+ Changed name and implementation of def-array to more appropriate
+ def-array-pointer
+ * src/ref.sgml:
+ Updated def-array-pointer documentation
+ * src/primitives.cl:
+ Made results of def-constant equal those of cl:defconstant
+ * src/objects.cl:
+ Made type be evaluated for with-foreign-object and allocate-foreign-object
+ * VERSION:
+ Increase to 0.3.0 to coincide with the release of CLSQL.
+
+21 Mar 2002
+ * Fixed problem with NULL foreign-strings with CMUCL
+ * Added c-test-fns to examples for allow more specific testing
+ of UFFI. Builds on UNIX and Win32 platforms.
+ * Added def-union function, added union.cl example
+ * Fixed error with ensure-char-[character|integer]
+ * Added 2-d array example to examples/arrays.cl
+ * Fixed documentation error on gethostname
+ * Added ensure-char-* and def-union to documentation
+ * Added double-float vector example to c-test-fns
+ * Reworked cstring on Lispworks to have LW handle string conversion
+ * First pass at with-foreign-object -- unoptimized
+ * Added gethostname2 example which uses with-foreign-object
+ * Added char-array-to-pointer function to encapsulate
+ converting a char array to a char pointer
+ * Converted with-foreign-object to use stack allocation on CMUCL and LW
+ * Added benchmark code, first file is for allocation
+
+20 Mar 2002
+ * Updated strings.cl so that foreign-strings are always unsigned.
+ Fixes a problem with strtol example.
+ * Added ensure-char-character and ensure-char-integer to handle
+ differences in implementations dereferencing of (* :char).
+ * Added section on design priorities for UFFI
+ * Added section in TODO on splitting implementation-dependent code
+
+19 Mar 2002
+ * Added size parameter to allocate-foreign-object. Creates an array
+ of dimensions size.
+ * Got array-2d example working with a 1-d array.
+ * Cleaned strtol example
+ * Added TODO file
+
+18 Mar 2002
+ * Documentation fixes (Erik Winkels)
+ * Fixed missing '.' in CMUCL type declarations (Erik Winkels)
+
+17 Mar 2002
+ * Changed deref-pointer so it always returns a character when
+ called with a :char or :unsigned-char type
+ * Removed function ensure-char as no longer needed
+ * Added missing :byte specifier to Lispworks
+ * Changed default string type in Lispworks to :unsigned-char
+ which is the native type for Lispworks foreign-strings.
+ * Reworked strtol to handle new character pointing method
+
+16 Mar 2002
+ * Fixed return value in load-foreign-library (Thanks Erik Winkels),
+ modified routine to accept pathnames as well as strings.
+ * Fix documention with :pointer-void (Again, Erik Winkels)
+ * Added missing type specifiers for CMUCL (Thanks a bunch, Erik!)
+
+15 Mar 2002
+ * Finished basic skeleton of documentation.
+
+14 Mar 2002
+ * Changed license to more liberal Lisp Lessor GNU Public License
+ * Fixed problem with uffi.system absent from in distribution
+ (Thanks John DeSoi)
+ * Fixed compiler warnings
+
+
+11 Mar 2002
+ * Changed def-type to def-foreign-type
+ * Created new macro def-type to generate cl:deftype forms. Removed
+ uffi-declare and uffi-slot-type as they are no longer necessary.
+
+10 Mar 2002
+ * Modified input parameters to load-foreign-library
+ * Added to documention
+ * Changed parameter order in get-slot-value and deref-array
+
+9 Mar 2002
+ * Added to documentation
+ * Made Allegro CL array access more efficient
+ * Changed def-routine name to def-function
+ * Fixed bug in def-function for Lispworks]
+ * Fixed error in +null-c-string-pointer+ name
+ * Fixed error in (make-null-pointer) for Lispworks
+ * Reworked Lispwork c-strings to be (* :char) rather than the
+ implementation default of (* (:unsigned :char)) to be consistent
+ with CMUCL. Bumped version to 0.2.0 because of change this change.
+ * Renamed c-string to cstring to emphasize it as a basic type
+ * Modified getenv.cl example to avoid name collison with LW
+ * Modified compress.cl to setup output buffer as :unsigned*char
+ * Added test-all-examples function. All routines tested okay with
+ ACL, LW, and CMUCL
+
+8 Mar 2002
+ * Added ZIP file output with LF->CRLF translations to distribution
+ * Modified def-enum to use uffi:def-constant rather than
+ cl:defconstant
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/INSTALL
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/INSTALL Mon Feb 11 09:23:05 2008
@@ -0,0 +1,3 @@
+Detailed installation instructions are supplied in PDF format
+in the file ./doc/uffi.pdf.
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/LICENSE
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/LICENSE Mon Feb 11 09:23:05 2008
@@ -0,0 +1,26 @@
+Copyright (c) 2001-2003 Kevin M. Rosenberg and contributors.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+1. Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+3. Neither the name of the author nor the names of the contributors
+ may be used to endorse or promote products derived from this software
+ without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/Makefile
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/Makefile Mon Feb 11 09:23:05 2008
@@ -0,0 +1,45 @@
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the uffi package
+# Programer: Kevin M. Rosenberg, M.D.
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile 10614 2005-07-06 01:05:14Z kevin $
+#
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+
+PKG:=uffi
+DEBPKG=cl-uffi
+SUBDIRS:= examples src benchmarks
+DOCSUBDIRS:=doc
+
+include Makefile.common
+
+
+.PHONY: all
+all:
+
+
+.PHONY: distclean
+distclean: clean
+ @$(MAKE) -C doc $@
+# ./debian/rules clean
+
+
+SOURCE_FILES=src doc examples Makefile uffi.system uffi.debian.system \
+ benchmarks COPYRIGHT README TODO INSTALL ChangeLog NEWS \
+ test-examples.cl set-logical.cl
+
+.PHONY: doc
+doc:
+ $(MAKE) -C doc
+
+.PHONY: dist
+dist: clean
+ $(MAKE) -C doc $@
+
+.PHONY: TAGS
+TAGS:
+ if [ -f TAGS ]; then mv -f TAGS TAGS~; fi
+ find . -name \*.lisp -exec /usr/bin/etags -a \{\} \;
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/Makefile.common
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/Makefile.common Mon Feb 11 09:23:05 2008
@@ -0,0 +1,17 @@
+all:
+
+
+.PHONY: clean
+clean:
+ @rm -rf .bin
+ @rm -f *.ufsl *.fsl *.fas *.x86f *.sparcf *.fasl
+ @rm -f *.fasla8 *.fasla16 *.faslm8 *.faslm16 *.faslmt
+ @rm -f *~ *.bak *.orig *.err \#*\# .#*
+ @rm -f *.so *.a
+ @rm -rf debian/cl-uffi
+ifneq ($(SUBDIRS)$(DOCSUBDIRS),)
+ @set -e; for i in $(SUBDIRS) $(DOCSUBDIRS); do \
+ $(MAKE) -C $$i $@; done
+endif
+
+.SUFFIXES: # No default suffixes
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/NEWS
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/NEWS Mon Feb 11 09:23:05 2008
@@ -0,0 +1 @@
+UFFI now supports AllegroCL AMD64
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/README
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/README Mon Feb 11 09:23:05 2008
@@ -0,0 +1,20 @@
+Package: UFFI (Universal Foreign Language Interface)
+Web site: http://uffi.b9.com
+Author: Kevin M. Rosenberg
+
+
+BRIEF DESCRIPTION
+-----------------
+uffi is a Common Lisp package for interfacing C-language compatible
+libraries. Every Common Lisp implementation has a method for
+interfacing to such libraries. Unfortunately, these method vary widely
+amongst implementations. uffi gathers a common subset of functionality
+between Common Lisp implementations. uffi wraps this common subset of
+functionality into it's own syntax and provides macro translation of
+uffi features into the specific syntax of supported Common Lisp
+implementations.
+
+Currently, AllegroCL (Linux and Microsoft Windows), Lispworks (Linux
+and Microsoft Windows), CMUCL, SBCL, and OpenMCL are supported.
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/TODO
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/TODO Mon Feb 11 09:23:05 2008
@@ -0,0 +1,7 @@
+- Run test-suite on MCL port
+
+- Add OpenMCL support for with-cast-pointer and def-foreign-var
+
+- Add support for direct vector passing to and from foreign functions
+ to avoid copying elements in and out of vector.
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/Makefile
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/Makefile Mon Feb 11 09:23:05 2008
@@ -0,0 +1,6 @@
+SUBDIRS :=
+
+include ../Makefile.common
+
+.PHONY: distclean
+distclean: clean
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/allocation.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/benchmarks/allocation.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,126 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: allocation.cl
+;;;; Purpose: Benchmark allocation and slot-access speed
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: allocation.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+
+(defun stk-int ()
+ #+allegro
+ (ff:with-stack-fobject (ptr :int)
+ (setf (ff:fslot-value ptr) 0))
+ #+lispworks
+ (fli:with-dynamic-foreign-objects ((ptr :int))
+ (setf (fli:dereference ptr) 0))
+ #+cmu
+ (alien:with-alien ((ptr alien:signed))
+ (let ((p (alien:addr ptr)))
+ (setf (alien:deref p) 0)))
+ #+sbcl
+ (sb-alien:with-alien ((ptr sb-alien:signed))
+ (let ((p (sb-alien:addr ptr)))
+ (setf (sb-alien:deref p) 0)))
+ )
+
+(defun stk-vector ()
+ #+allegro
+ (ff:with-stack-fobject (ptr '(:array :int 10) )
+ (setf (ff:fslot-value ptr 5) 0))
+ #+lispworks
+ (fli:with-dynamic-foreign-objects ((ptr (:c-array :int 10)))
+ (setf (fli:dereference ptr 5) 0))
+ #+cmu
+ (alien:with-alien ((ptr (alien:array alien:signed 10)))
+ (setf (alien:deref ptr 5) 0))
+ #+sbcl
+ (sb-alien:with-alien ((ptr (sb-alien:array sb-alien:signed 10)))
+ (setf (sb-alien:deref ptr 5) 0))
+ )
+
+(defun stat-int ()
+ #+allegro
+ (let ((ptr (ff:allocate-fobject :int :c)))
+ (declare (dynamic-extent ptr))
+ (setf (ff:fslot-value-typed :int :c ptr) 0)
+ (ff:free-fobject ptr))
+ #+lispworks
+ (let ((ptr (fli:allocate-foreign-object :type :int)))
+ (declare (dynamic-extent ptr))
+ (setf (fli:dereference ptr) 0)
+ (fli:free-foreign-object ptr))
+ #+cmu
+ (let ((ptr (alien:make-alien (alien:signed 32))))
+ (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
+ (dynamic-extent ptr))
+ (setf (alien:deref ptr) 0)
+ (alien:free-alien ptr))
+ #+sbcl
+ (let ((ptr (sb-alien:make-alien (sb-alien:signed 32))))
+ (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
+ (dynamic-extent ptr))
+ (setf (sb-alien:deref ptr) 0)
+ (sb-alien:free-alien ptr))
+ )
+
+(defun stat-vector ()
+ #+allegro
+ (let ((ptr (ff:allocate-fobject '(:array :int 10) :c)))
+ (declare (dynamic-extent ptr))
+ (setf (ff:fslot-value-typed '(:array :int 10) :c ptr 5) 0)
+ (ff:free-fobject ptr))
+ #+lispworks
+ (let ((ptr (fli:allocate-foreign-object :type '(:c-array :int 10))))
+ (declare (dynamic-extent ptr))
+ (setf (fli:dereference ptr 5) 0)
+ (fli:free-foreign-object ptr))
+ #+cmu
+ (let ((ptr (alien:make-alien (alien:array (alien:signed 32) 10))))
+ (declare ;;(type (alien (* (alien:unsigned 32))) ptr)
+ (dynamic-extent ptr))
+ (setf (alien:deref ptr 5) 0)
+ (alien:free-alien ptr))
+ #+sbcl
+ (let ((ptr (sb-alien:make-alien (sb-alien:array (sb-alien:signed 32) 10))))
+ (declare ;;(type (sb-alien (* (sb-alien:unsigned 32))) ptr)
+ (dynamic-extent ptr))
+ (setf (sb-alien:deref ptr 5) 0)
+ (sb-alien:free-alien ptr))
+ )
+
+
+(defun stk-vs-stat ()
+ (format t "~&Stack allocation, Integer")
+ (time (dotimes (i 1000)
+ (dotimes (j 1000)
+ (stk-int))))
+ (format t "~&Static allocation, Integer")
+ (time (dotimes (i 1000)
+ (dotimes (j 1000)
+ (stat-int))))
+ (format t "~&Stack allocation, Vector")
+ (time (dotimes (i 1000)
+ (dotimes (j 1000)
+ (stk-int))))
+ (format t "~&Static allocation, Vector")
+ (time (dotimes (i 1000)
+ (dotimes (j 1000)
+ (stat-int))))
+)
+
+
+(stk-vs-stat)
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/COPYING.GFDL
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/COPYING.GFDL Mon Feb 11 09:23:05 2008
@@ -0,0 +1,330 @@
+ GNU Free Documentation License
+ Version 1.1, March 2000
+
+ Copyright (C) 2000 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+0. PREAMBLE
+
+The purpose of this License is to make a manual, textbook, or other
+written document "free" in the sense of freedom: to assure everyone
+the effective freedom to copy and redistribute it, with or without
+modifying it, either commercially or noncommercially. Secondarily,
+this License preserves for the author and publisher a way to get
+credit for their work, while not being considered responsible for
+modifications made by others.
+
+This License is a kind of "copyleft", which means that derivative
+works of the document must themselves be free in the same sense. It
+complements the GNU General Public License, which is a copyleft
+license designed for free software.
+
+We have designed this License in order to use it for manuals for free
+software, because free software needs free documentation: a free
+program should come with manuals providing the same freedoms that the
+software does. But this License is not limited to software manuals;
+it can be used for any textual work, regardless of subject matter or
+whether it is published as a printed book. We recommend this License
+principally for works whose purpose is instruction or reference.
+
+
+1. APPLICABILITY AND DEFINITIONS
+
+This License applies to any manual or other work that contains a
+notice placed by the copyright holder saying it can be distributed
+under the terms of this License. The "Document", below, refers to any
+such manual or work. Any member of the public is a licensee, and is
+addressed as "you".
+
+A "Modified Version" of the Document means any work containing the
+Document or a portion of it, either copied verbatim, or with
+modifications and/or translated into another language.
+
+A "Secondary Section" is a named appendix or a front-matter section of
+the Document that deals exclusively with the relationship of the
+publishers or authors of the Document to the Document's overall subject
+(or to related matters) and contains nothing that could fall directly
+within that overall subject. (For example, if the Document is in part a
+textbook of mathematics, a Secondary Section may not explain any
+mathematics.) The relationship could be a matter of historical
+connection with the subject or with related matters, or of legal,
+commercial, philosophical, ethical or political position regarding
+them.
+
+The "Invariant Sections" are certain Secondary Sections whose titles
+are designated, as being those of Invariant Sections, in the notice
+that says that the Document is released under this License.
+
+The "Cover Texts" are certain short passages of text that are listed,
+as Front-Cover Texts or Back-Cover Texts, in the notice that says that
+the Document is released under this License.
+
+A "Transparent" copy of the Document means a machine-readable copy,
+represented in a format whose specification is available to the
+general public, whose contents can be viewed and edited directly and
+straightforwardly with generic text editors or (for images composed of
+pixels) generic paint programs or (for drawings) some widely available
+drawing editor, and that is suitable for input to text formatters or
+for automatic translation to a variety of formats suitable for input
+to text formatters. A copy made in an otherwise Transparent file
+format whose markup has been designed to thwart or discourage
+subsequent modification by readers is not Transparent. A copy that is
+not "Transparent" is called "Opaque".
+
+Examples of suitable formats for Transparent copies include plain
+ASCII without markup, Texinfo input format, LaTeX input format, SGML
+or XML using a publicly available DTD, and standard-conforming simple
+HTML designed for human modification. Opaque formats include
+PostScript, PDF, proprietary formats that can be read and edited only
+by proprietary word processors, SGML or XML for which the DTD and/or
+processing tools are not generally available, and the
+machine-generated HTML produced by some word processors for output
+purposes only.
+
+The "Title Page" means, for a printed book, the title page itself,
+plus such following pages as are needed to hold, legibly, the material
+this License requires to appear in the title page. For works in
+formats which do not have any title page as such, "Title Page" means
+the text near the most prominent appearance of the work's title,
+preceding the beginning of the body of the text.
+
+
+2. VERBATIM COPYING
+
+You may copy and distribute the Document in any medium, either
+commercially or noncommercially, provided that this License, the
+copyright notices, and the license notice saying this License applies
+to the Document are reproduced in all copies, and that you add no other
+conditions whatsoever to those of this License. You may not use
+technical measures to obstruct or control the reading or further
+copying of the copies you make or distribute. However, you may accept
+compensation in exchange for copies. If you distribute a large enough
+number of copies you must also follow the conditions in section 3.
+
+You may also lend copies, under the same conditions stated above, and
+you may publicly display copies.
+
+
+3. COPYING IN QUANTITY
+
+If you publish printed copies of the Document numbering more than 100,
+and the Document's license notice requires Cover Texts, you must enclose
+the copies in covers that carry, clearly and legibly, all these Cover
+Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
+the back cover. Both covers must also clearly and legibly identify
+you as the publisher of these copies. The front cover must present
+the full title with all words of the title equally prominent and
+visible. You may add other material on the covers in addition.
+Copying with changes limited to the covers, as long as they preserve
+the title of the Document and satisfy these conditions, can be treated
+as verbatim copying in other respects.
+
+If the required texts for either cover are too voluminous to fit
+legibly, you should put the first ones listed (as many as fit
+reasonably) on the actual cover, and continue the rest onto adjacent
+pages.
+
+If you publish or distribute Opaque copies of the Document numbering
+more than 100, you must either include a machine-readable Transparent
+copy along with each Opaque copy, or state in or with each Opaque copy
+a publicly-accessible computer-network location containing a complete
+Transparent copy of the Document, free of added material, which the
+general network-using public has access to download anonymously at no
+charge using public-standard network protocols. If you use the latter
+option, you must take reasonably prudent steps, when you begin
+distribution of Opaque copies in quantity, to ensure that this
+Transparent copy will remain thus accessible at the stated location
+until at least one year after the last time you distribute an Opaque
+copy (directly or through your agents or retailers) of that edition to
+the public.
+
+It is requested, but not required, that you contact the authors of the
+Document well before redistributing any large number of copies, to give
+them a chance to provide you with an updated version of the Document.
+
+
+4. MODIFICATIONS
+
+You may copy and distribute a Modified Version of the Document under
+the conditions of sections 2 and 3 above, provided that you release
+the Modified Version under precisely this License, with the Modified
+Version filling the role of the Document, thus licensing distribution
+and modification of the Modified Version to whoever possesses a copy
+of it. In addition, you must do these things in the Modified Version:
+
+A. Use in the Title Page (and on the covers, if any) a title distinct
+ from that of the Document, and from those of previous versions
+ (which should, if there were any, be listed in the History section
+ of the Document). You may use the same title as a previous version
+ if the original publisher of that version gives permission.
+B. List on the Title Page, as authors, one or more persons or entities
+ responsible for authorship of the modifications in the Modified
+ Version, together with at least five of the principal authors of the
+ Document (all of its principal authors, if it has less than five).
+C. State on the Title page the name of the publisher of the
+ Modified Version, as the publisher.
+D. Preserve all the copyright notices of the Document.
+E. Add an appropriate copyright notice for your modifications
+ adjacent to the other copyright notices.
+F. Include, immediately after the copyright notices, a license notice
+ giving the public permission to use the Modified Version under the
+ terms of this License, in the form shown in the Addendum below.
+G. Preserve in that license notice the full lists of Invariant Sections
+ and required Cover Texts given in the Document's license notice.
+H. Include an unaltered copy of this License.
+I. Preserve the section entitled "History", and its title, and add to
+ it an item stating at least the title, year, new authors, and
+ publisher of the Modified Version as given on the Title Page. If
+ there is no section entitled "History" in the Document, create one
+ stating the title, year, authors, and publisher of the Document as
+ given on its Title Page, then add an item describing the Modified
+ Version as stated in the previous sentence.
+J. Preserve the network location, if any, given in the Document for
+ public access to a Transparent copy of the Document, and likewise
+ the network locations given in the Document for previous versions
+ it was based on. These may be placed in the "History" section.
+ You may omit a network location for a work that was published at
+ least four years before the Document itself, or if the original
+ publisher of the version it refers to gives permission.
+K. In any section entitled "Acknowledgements" or "Dedications",
+ preserve the section's title, and preserve in the section all the
+ substance and tone of each of the contributor acknowledgements
+ and/or dedications given therein.
+L. Preserve all the Invariant Sections of the Document,
+ unaltered in their text and in their titles. Section numbers
+ or the equivalent are not considered part of the section titles.
+M. Delete any section entitled "Endorsements". Such a section
+ may not be included in the Modified Version.
+N. Do not retitle any existing section as "Endorsements"
+ or to conflict in title with any Invariant Section.
+
+If the Modified Version includes new front-matter sections or
+appendices that qualify as Secondary Sections and contain no material
+copied from the Document, you may at your option designate some or all
+of these sections as invariant. To do this, add their titles to the
+list of Invariant Sections in the Modified Version's license notice.
+These titles must be distinct from any other section titles.
+
+You may add a section entitled "Endorsements", provided it contains
+nothing but endorsements of your Modified Version by various
+parties--for example, statements of peer review or that the text has
+been approved by an organization as the authoritative definition of a
+standard.
+
+You may add a passage of up to five words as a Front-Cover Text, and a
+passage of up to 25 words as a Back-Cover Text, to the end of the list
+of Cover Texts in the Modified Version. Only one passage of
+Front-Cover Text and one of Back-Cover Text may be added by (or
+through arrangements made by) any one entity. If the Document already
+includes a cover text for the same cover, previously added by you or
+by arrangement made by the same entity you are acting on behalf of,
+you may not add another; but you may replace the old one, on explicit
+permission from the previous publisher that added the old one.
+
+The author(s) and publisher(s) of the Document do not by this License
+give permission to use their names for publicity for or to assert or
+imply endorsement of any Modified Version.
+
+
+5. COMBINING DOCUMENTS
+
+You may combine the Document with other documents released under this
+License, under the terms defined in section 4 above for modified
+versions, provided that you include in the combination all of the
+Invariant Sections of all of the original documents, unmodified, and
+list them all as Invariant Sections of your combined work in its
+license notice.
+
+The combined work need only contain one copy of this License, and
+multiple identical Invariant Sections may be replaced with a single
+copy. If there are multiple Invariant Sections with the same name but
+different contents, make the title of each such section unique by
+adding at the end of it, in parentheses, the name of the original
+author or publisher of that section if known, or else a unique number.
+Make the same adjustment to the section titles in the list of
+Invariant Sections in the license notice of the combined work.
+
+In the combination, you must combine any sections entitled "History"
+in the various original documents, forming one section entitled
+"History"; likewise combine any sections entitled "Acknowledgements",
+and any sections entitled "Dedications". You must delete all sections
+entitled "Endorsements."
+
+
+6. COLLECTIONS OF DOCUMENTS
+
+You may make a collection consisting of the Document and other documents
+released under this License, and replace the individual copies of this
+License in the various documents with a single copy that is included in
+the collection, provided that you follow the rules of this License for
+verbatim copying of each of the documents in all other respects.
+
+You may extract a single document from such a collection, and distribute
+it individually under this License, provided you insert a copy of this
+License into the extracted document, and follow this License in all
+other respects regarding verbatim copying of that document.
+
+
+7. AGGREGATION WITH INDEPENDENT WORKS
+
+A compilation of the Document or its derivatives with other separate
+and independent documents or works, in or on a volume of a storage or
+distribution medium, does not as a whole count as a Modified Version
+of the Document, provided no compilation copyright is claimed for the
+compilation. Such a compilation is called an "aggregate", and this
+License does not apply to the other self-contained works thus compiled
+with the Document, on account of their being thus compiled, if they
+are not themselves derivative works of the Document.
+
+If the Cover Text requirement of section 3 is applicable to these
+copies of the Document, then if the Document is less than one quarter
+of the entire aggregate, the Document's Cover Texts may be placed on
+covers that surround only the Document within the aggregate.
+Otherwise they must appear on covers around the whole aggregate.
+
+
+8. TRANSLATION
+
+Translation is considered a kind of modification, so you may
+distribute translations of the Document under the terms of section 4.
+Replacing Invariant Sections with translations requires special
+permission from their copyright holders, but you may include
+translations of some or all Invariant Sections in addition to the
+original versions of these Invariant Sections. You may include a
+translation of this License provided that you also include the
+original English version of this License. In case of a disagreement
+between the translation and the original English version of this
+License, the original English version will prevail.
+
+
+9. TERMINATION
+
+You may not copy, modify, sublicense, or distribute the Document except
+as expressly provided for under this License. Any other attempt to
+copy, modify, sublicense or distribute the Document is void, and will
+automatically terminate your rights under this License. However,
+parties who have received copies, or rights, from you under this
+License will not have their licenses terminated so long as such
+parties remain in full compliance.
+
+
+10. FUTURE REVISIONS OF THIS LICENSE
+
+The Free Software Foundation may publish new, revised versions
+of the GNU Free Documentation License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns. See
+http://www.gnu.org/copyleft/.
+
+Each version of the License is given a distinguishing version number.
+If the Document specifies that a particular numbered version of this
+License "or any later version" applies to it, you have the option of
+following the terms and conditions either of that specified version or
+of any later version that has been published (not as a draft) by the
+Free Software Foundation. If the Document does not specify a version
+number of this License, you may choose any version ever published (not
+as a draft) by the Free Software Foundation.
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/Makefile
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/Makefile Mon Feb 11 09:23:05 2008
@@ -0,0 +1,144 @@
+##############################################################################
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for the uffi documentation
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile 11021 2006-08-14 04:22:28Z kevin $
+#
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+##############################################################################
+
+DOCFILE_BASE_DEFAULT:=uffi
+DOCFILE_EXT_DEFAULT:=xml
+
+
+# Standard docfile processing
+
+DEBIAN=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Debian.*')
+UBUNTU=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Ubuntu.*')
+SUSE=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*SuSE.*')
+SUSE91=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*SuSE Linux 9.1.*')
+REDHAT=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Red Hat.*')
+MANDRAKE=$(shell expr "`cat /etc/issue 2> /dev/null`" : '.*Mandrake.*')
+DARWIN=$(shell expr "`uname -a`" : '.*Darwin.*')
+
+ifneq (${DEBIAN},0)
+OS:=debian
+else
+ ifneq (${SUSE91},0)
+ OS=suse91
+ else
+ ifneq (${SUSE},0)
+ OS=suse
+ else
+ ifneq (${REDHAT},0)
+ OS=redhat
+ else
+ ifneq (${MANDRAKE},0)
+ OS=mandrake
+ else
+ ifneq (${DARWIN},0)
+ OS=darwin
+ else
+ ifneq (${UBUNTU},0)
+ OS=ubuntu
+ endif
+ endif
+ endif
+ endif
+ endif
+ endif
+endif
+
+ifndef DOCFILE_BASE
+DOCFILE_BASE=${DOCFILE_BASE_DEFAULT}
+endif
+
+ifndef DOCFILE_EXT
+DOCFILE_EXT=${DOCFILE_EXT_DEFAULT}
+endif
+
+DOCFILE:=${DOCFILE_BASE}.${DOCFILE_EXT}
+FOFILE:=${DOCFILE_BASE}.fo
+PDFFILE:=${DOCFILE_BASE}.pdf
+PSFILE:=${DOCFILE_BASE}.ps
+DVIFILE:=${DOCFILE_BASE}.dvi
+TXTFILE:=${DOCFILE_BASE}.txt
+HTMLFILE:=${DOCFILE_BASE}.html
+TMPFILES:=${DOCFILE_BASE}.aux ${DOCFILE_BASE}.out ${DOCFILE_BASE}.log
+DOCFILES:=$(shell echo *.xml *.xsl)
+
+ifeq ($(XSLTPROC),)
+ XSLTPROC:=xsltproc
+endif
+
+CATALOG:=`pwd`/catalog-${OS}.xml
+CHECK:=XML_CATALOG_FILES="$(CATALOG)" xmllint --noout --xinclude --postvalid $(DOCFILE) || exit 1
+
+.PHONY: all
+all: html pdf
+
+.PHONY: dist
+dist: html pdf
+
+.PHONY: doc
+doc: html pdf
+
+.PHONY: check
+check:
+ @echo "Operating System Detected: ${OS}"
+ @$(CHECK)
+
+.PHONY: html
+html: html.tar.gz
+
+html.tar.gz: $(DOCFILES) Makefile
+ @rm -rf html
+ @mkdir html
+ @XML_CATALOG_FILES="$(CATALOG)" $(XSLTPROC) --stringparam chunker.output.encoding ISO-8859-1 \
+ --xinclude --output html/ html_chunk.xsl $(DOCFILE)
+ @GZIP='-9' tar czf html.tar.gz html
+
+.PHONY: fo
+fo: ${FOFILE}
+
+${FOFILE}: $(DOCFILES) Makefile
+ @XML_CATALOG_FILES="$(CATALOG)" xsltproc --xinclude --output $(FOFILE) fo.xsl $(DOCFILE)
+
+.PHONY: pdf
+pdf: ${PDFFILE}
+
+${PDFFILE}: ${DOCFILES} Makefile
+ @$(MAKE) fo
+ @fop $(FOFILE) -pdf $(PDFFILE) > /dev/null
+
+.PHONY: dvi
+dvi: ${DVIFILE}
+
+.PHONY: ps
+ps: ${PSFILE}
+
+${PSFILE}: ${DOCFILES} Makefile
+ @$(MAKE) fo
+ @fop $(FOFILE) -ps $(PSFILE) > /dev/null
+
+
+.PHONY: txt
+txt: ${TXTFILE}
+
+${TXTFILE}: ${FOFILE}
+ @XML_CATALOG_FILES="$(CATALOG)" xsltproc --xinclude --output ${HTMLFILE} html.xsl $(DOCFILE)
+ lynx -dump ${HTMLFILE} > ${TXTFILE}
+
+.PHONY: clean
+clean:
+ @rm -f *~ *.bak *.orig \#*\# .\#* texput.log
+ @rm -rf html ${PSFILE} ${HTMLFILE}
+ @rm -f ${TMPFILES} ${FOFILE}
+ @rm -f ${DVIFILE} ${TXTFILE}
+
+.PHONY: distclean
+distclean: clean
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/appendix.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/appendix.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,35 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<appendix id="installation">
+ <title>Installation</title>
+ <sect1 id="download">
+ <title>Download &uffi;</title>
+ <para>
+You need to download the &uffi; package from its web
+<ulink url="http://uffi.b9.com"><citetitle>home</citetitle></ulink>.
+You also need to have a copy of &asdf;. If you need a copy of
+&asdf;, it is included in the
+ <ulink
+ url="http://www.sourceforge.net/projects/cclan">
+ <citetitle>CCLAN</citetitle></ulink> package. You can download
+the file <filename>defsystem.lisp</filename> from the CVS
+<ulink url="http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/asdf.lisp"><citetitle>tree</citetitle></ulink>.
+ </para>
+ </sect1>
+ <sect1 id="loading">
+ <title>Loading</title>
+ <para>
+ After downloading and installing &asdf;, simply
+ <function>push</function> the
+ directory containing &uffi; into
+ <varname>asdf:*central-registry*</varname> variable. Whenever you
+want to load the &uffi; package, use the form
+ <computeroutput>(asdf:operate 'asdf:load-op :uffi)</computeroutput>.
+ </para>
+ </sect1>
+</appendix>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/bookinfo.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/bookinfo.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,77 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<bookinfo>
+ <title>&uffi; Reference Guide</title>
+ <author>
+ <firstname>Kevin</firstname>
+ <othername>M.</othername>
+ <surname>Rosenberg</surname>
+ <affiliation>
+ <orgname>Heart Hospital of New Mexico</orgname>
+ <address>
+ <email>kevin(a)rosenberg.net</email>
+ <street>504 Elm Street N.E.</street>
+ <city>Albuquerque</city>
+ <state>New Mexico</state>
+ <postcode>87102</postcode>
+ </address>
+ </affiliation>
+ </author>
+
+ <printhistory>
+ <simpara>$Id: bookinfo.xml 8263 2003-11-21 05:44:46Z kevin $</simpara>
+ <simpara>File $Date: 2003-11-20 22:44:46 -0700 (Thu, 20 Nov 2003) $</simpara>
+ </printhistory>
+ <copyright>
+ <year>2002-2003</year>
+ <holder>Kevin M. Rosenberg</holder>
+ </copyright>
+ <legalnotice>
+ <itemizedlist>
+ <listitem>
+ <para>The &uffi; package was designed and
+ written by Kevin M. Rosenberg.
+ </para>
+ </listitem>
+ <listitem>
+ <para>
+ Permission is granted to copy, distribute and/or modify this document
+ under the terms of the GNU Free Documentation License, Version 1.1
+ or any later version published by the Free Software Foundation;
+ with no Invariant Sections, with the no
+ Front-Cover Texts, and with no Back-Cover Texts.
+ A copy of the license is included in the &uffi; distribution.
+ </para>
+ </listitem>
+ <listitem>
+ <para>
+ <application>Allegro CL</application>® is a registered
+ trademark of Franz Inc.
+ </para>
+ </listitem>
+ <listitem>
+ <para>
+ <application>Lispworks</application>® is a registered
+ trademark of Xanalys Inc.
+ </para>
+ </listitem>
+ <listitem>
+ <para>
+ <application>Microsoft Windows</application>® is a
+ registered trademark of Microsoft Inc.
+ </para>
+ </listitem>
+ <listitem>
+ <para>
+ Other brand or product names are the registered trademarks
+ or trademarks of their respective holders.
+ </para>
+ </listitem>
+ </itemizedlist>
+ </legalnotice>
+</bookinfo>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-darwin.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-darwin.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,43 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///sw/share/xml/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="dtd/docbookx/4.2.0/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="xsl/docbook-xsl/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="dtd/xml/4.2/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="dtd/xml/4.2.0/xml/docbookx.dtd" />
+
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="xsl/docbook-xsl/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="xsl/docbook-xsl/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="xsl/docbook-xsl/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-debian.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-debian.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,43 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///usr/share/sgml/docbook/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="dtd/xml/4.2/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="stylesheet/xsl/nwalsh/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="dtd/xml/4.2/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="dtd/xml/4.2/xml/docbookx.dtd" />
+
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="stylesheet/xsl/nwalsh/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="stylesheet/xsl/nwalsh/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="stylesheet/xsl/nwalsh/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-mandrake.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-mandrake.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,43 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///usr/share/sgml/docbook/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="xml-dtd-4.2/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="xsl-stylesheets/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="xml-dtd-4.2/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="xml-dtd-4.2/docbookx.dtd" />
+
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="xsl-stylesheets/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="xsl-stylesheets/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="xsl-stylesheets/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,43 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///usr/share/xml/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="db42xml/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="docbook/docbook-xsl/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="db42xml/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="db42xml/docbookx.dtd" />
+
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="docbook/stylesheet/nwalsh/current/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="docbook/stylesheet/nwalsh/current/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="docbook/stylesheet/nwalsh/current/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse90.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse90.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,43 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///usr/share/sgml/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="db42xml/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="docbook/docbook-xsl/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="db42xml/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="db42xml/docbookx.dtd" />
+
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="docbook/docbook-xsl/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="docbook/docbook-xsl/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="docbook/docbook-xsl/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse91.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-suse91.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,48 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///usr/share/xml/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="docbook/schema/dtd/4.2/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="docbook/stylesheet/nwalsh/current/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="docbook/schema/dtd/4.2/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="docbook/schema/dtd/4.2/docbookx.dtd" />
+ <uri
+ name="docbookx.dtd"
+ uri="docbook/schema/dtd/4.2/docbookx.dtd" />
+ <system
+ systemId="docbookx.dtd"
+ uri="docbook/schema/dtd/4.2/docbookx.dtd" />
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="docbook/stylesheet/nwalsh/current/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="docbook/stylesheet/nwalsh/current/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="docbook/stylesheet/nwalsh/current/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-ubuntu.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/catalog-ubuntu.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,43 @@
+<?xml version="1.0" ?>
+<!DOCTYPE catalog
+ PUBLIC "-//OASIS/DTD Entity Resolution XML Catalog V1.0//EN"
+ "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd">
+
+<catalog xmlns="urn:oasis:names:tc:entity:xmlns:xml:catalog">
+
+ <!-- The directory DTD and stylesheet files are installed under -->
+ <group xml:base="file:///usr/share/sgml/docbook/" >
+
+ <!-- Resolve DTD URL system ID to local file -->
+ <rewriteSystem
+ systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/"
+ rewritePrefix="dtd/xml/4.2/" />
+ <!-- Resolve stylesheet URL to local file -->
+ <rewriteURI
+ uriStartString="http://docbook.sourceforge.net/release/xsl/current/"
+ rewritePrefix="stylesheet/xsl/nwalsh/" />
+
+ <!-- Resolve DTD PUBLIC identifiers -->
+ <nextCatalog catalog="dtd/xml/4.2/catalog.xml" />
+
+ <!-- To resolve simple DTD SYSTEM identifiers. -->
+ <!-- Note: this does not work with Java resolver -->
+ <!-- classes in Saxon or Xalan -->
+ <system
+ systemId="docbook.dtd"
+ uri="dtd/xml/4.2/xml/docbookx.dtd" />
+
+ <!-- To resolve short stylesheet references -->
+ <uri
+ name="docbook_html.xsl"
+ uri="stylesheet/xsl/nwalsh/xhtml/docbook.xsl" />
+ <uri
+ name="docbook_chunk.xsl"
+ uri="stylesheet/xsl/nwalsh/xhtml/chunk.xsl" />
+ <uri
+ name="docbook_fo.xsl"
+ uri="stylesheet/xsl/nwalsh/fo/docbook.xsl" />
+
+ </group>
+
+</catalog>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/entities.inc
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/entities.inc Mon Feb 11 09:23:05 2008
@@ -0,0 +1,16 @@
+<!ENTITY uffi "<application><emphasis>UFFI</emphasis></application>">
+<!ENTITY ffi "<acronym>FFI</acronym>">
+<!ENTITY cmucl "<application>CMUCL</application>">
+<!ENTITY scl "<application>SCL</application>">
+<!ENTITY lw "<application>Lispworks</application>">
+<!ENTITY sbcl "<application>SBCL</application>">
+<!ENTITY openmcl "<application>OpenMCL</application>">
+<!ENTITY mcl "<application>MCL</application>">
+<!ENTITY acl "<application>AllegroCL</application>">
+<!ENTITY cl "<application>ANSI Common Lisp</application>">
+<!ENTITY t "<constant>T</constant>">
+<!ENTITY nil "<constant>NIL</constant>">
+<!ENTITY null "<constant>NULL</constant>">
+<!ENTITY c "<computeroutput>C</computeroutput>">
+<!ENTITY defsystem "<application>defsystem</application>">
+<!ENTITY asdf "<application>ASDF</application>">
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/fo.xsl
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/fo.xsl Mon Feb 11 09:23:05 2008
@@ -0,0 +1,8 @@
+<?xml version='1.0'?>
+<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+ version="1.0">
+
+<xsl:import href="docbook_fo.xsl"/>
+<xsl:param name="fop.extensions" select="1"/>
+</xsl:stylesheet>
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/glossary.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/glossary.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,21 @@
+<?xml version="1.0" ?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<glossary id="glossary">
+ <glossentry id="gloss-ffi">
+ <glossterm>Foreign Function Interface
+ <acronym>FFI</acronym>)
+ </glossterm>
+ <glossdef>
+ <para>
+ An interface to a C-compatible library.
+ </para>
+ </glossdef>
+ </glossentry>
+</glossary>
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html.tar.gz
==============================================================================
Binary file. No diff available.
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html.xsl
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html.xsl Mon Feb 11 09:23:05 2008
@@ -0,0 +1,10 @@
+<?xml version='1.0'?>
+<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+ version="1.0">
+
+<xsl:import href="docbook_html.xsl"/>
+<xsl:param name="use.id.as.filename" select="1"/>
+<xsl:output encoding="ISO-8859-1" method="html" />
+
+</xsl:stylesheet>
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html_chunk.xsl
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/html_chunk.xsl Mon Feb 11 09:23:05 2008
@@ -0,0 +1,9 @@
+<?xml version='1.0'?>
+<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform"
+ version="1.0">
+
+<xsl:import href="docbook_chunk.xsl"/>
+<xsl:param name="use.id.as.filename" select="1"/>
+
+</xsl:stylesheet>
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/intro.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/intro.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,113 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+"http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<chapter id="introduction">
+ <title>Introduction</title>
+ <sect1 id="purpose">
+ <title>Purpose</title>
+ <para>
+ This reference guide describes &uffi;, a package that provides a
+ cross-implementation interface from Common Lisp to C-language
+ compatible libraries.
+ </para>
+ </sect1>
+
+ <sect1 id="background">
+ <title>Background
+ </title>
+ <para>
+ Every Common Lisp implementation has a method for interfacing to
+ C-language compatible libraries. These methods are often termed
+ a <emphasis>Foreign Function Library Interface</emphasis>
+ (&ffi;). Unfortunately, these methods vary widely amongst
+ implementations, thus preventing the writing of a portable FFI
+ to a particular C-library.
+ </para>
+ <para>
+ &uffi; gathers a common subset of functionality between Common
+ Lisp implementations. &uffi; wraps this common subset of
+ functionality with it's own syntax and provides macro
+ translation of uffi functions into the specific syntax of
+ supported Common Lisp implementations.
+ </para>
+ <para>
+ Developers who use &uffi; to interface with C libraries will
+ automatically have their code function in each of uffi's supported
+ implementations.
+ </para>
+ </sect1>
+
+ <sect1 id="supported-impl">
+ <title>Supported Implementations</title>
+ <para>The primary tested and supported platforms for &uffi; are:
+ </para>
+ <itemizedlist mark="opencircle">
+ <listitem><para>&acl; v6.2 on Debian GNU/Linux
+ FreeBSD 4.5, Solaris v2.8, and Microsoft Windows XP.</para></listitem>
+ <listitem><para>&lw; v4.2 on Debian GNU/Linux and Microsoft Windows XP.</para></listitem>
+ <listitem><para>&cmucl; 18d on Debian GNU/Linux, FreeBSD 4.5, and Solaris 2.8</para></listitem>
+ <listitem><para>&sbcl; 0.7.8 on Debian GNU/Linux</para></listitem>
+ <listitem><para>&scl; 1.1.1 on Debian GNU/Linux</para></listitem>
+ <listitem><para>&openmcl; 0.13 on Debian GNU/Linux for PowerPC</para></listitem>
+ </itemizedlist>
+ <para>Beta code is included with &uffi; for
+ </para>
+ <itemizedlist mark="opencircle">
+ <listitem><para>&openmcl; and &mcl; with MacOSX</para></listitem>
+ </itemizedlist>
+ </sect1>
+
+ <sect1 id="design">
+ <title>Design</title>
+ <sect2>
+ <title>Overview</title>
+ <para>
+ &uffi; was designed as a cross-implementation
+ compatible <emphasis>Foreign Function Interface</emphasis>.
+ Necessarily,
+ only a common subset of functionality can be
+ provided. Likewise, not every optimization for that a specific
+ implementation provides can be supported. Wherever possible,
+ though, implementation-specific optimizations are invoked.
+ </para>
+ </sect2>
+
+ <sect2>
+ <title>Priorities</title>
+ <para>
+ The design of &uffi; is dictated by the order of these priorities:
+ </para>
+ <itemizedlist>
+ <listitem>
+ <para>
+ Code using &uffi; must operate correctly on all
+ supported implementations.
+ </para>
+ </listitem>
+ <listitem>
+ <para>
+ Take advantage of implementation-specific optimizations. Ideally,
+ there will not a situation where an implementation-specific
+ &ffi; will be chosen due to lack of optimizations in &uffi;.
+ </para>
+ </listitem>
+ <listitem>
+ <para>Provide a simple interface to developers using
+ &uffi;. This priority is quite a bit lower than the above priorities.
+ This lower priority is manifest by programmers having to pass types in
+ pointer and array dereferencing, needing to use
+ <constant>cstring</constant> wrapper functions, and the use of
+ ensure-char-character and ensure-char-integer functions. My hope is
+ that the developer inconvenience will be outweighed by the generation
+ of optimized code that is cross-implementation compatible.
+ </para>
+ </listitem>
+ </itemizedlist>
+ </sect2>
+ </sect1>
+
+</chapter>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/notes.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/notes.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,94 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<chapter id="notes">
+ <title>Programming Notes</title>
+
+ <sect1 id="impl-specific">
+ <title>Implementation Specific Notes</title>
+ <para>
+ </para>
+ <sect2>
+ <title>&acl;</title>
+ <para>
+ </para>
+ </sect2>
+ <sect2>
+ <title>&lw;</title>
+ <para>
+ </para>
+ </sect2>
+ <sect2>
+ <title>&cmucl;</title>
+ <para>
+ </para>
+ </sect2>
+ </sect1>
+
+ <sect1 id="object-represen">
+ <title>Foreign Object Representation and Access</title>
+ <para> There are two main approaches used to represent foreign
+ objects: an integer that represents an address in memory, and a
+ object that also includes run-time typing. The advantage of
+ run-time typing is the system can dereference pointers and perform
+ array access without those functions requiring a type at the cost
+ of additional overhead to generate and store the run-time
+ typing. The advantage of integer representation, at least for
+ &acl;, is that the compiler can generate inline code to
+ dereference pointers. Further, the overhead of the run-time type
+ information is eliminated. The disadvantage is the program must
+ then supply
+ the type to the functions to dereference objects and array.
+ </para>
+ </sect1>
+
+ <sect1 id="optimizing">
+ <title>Optimizing Code Using UFFI</title>
+ <sect2>
+ <title>Background</title>
+ <para>
+ Two implementions have different techniques to optimize
+ (open-code) foreign objects. &acl; can open-code foreign
+ object
+ access if pointers are integers and the type of object is
+ specified in the access function. Thus, &uffi; represents objects
+ in &acl; as integers which don't have type information.
+ </para> <para>
+ &cmucl; works best when keeping objects as typed
+ objects. However, it's compiler can open-code object access when
+ the object type is specified in <function>declare</function>
+ commands and in <varname>:type</varname> specifiers in
+ <function>defstruct</function> and <function>defclass</function>.
+ </para> <para> &lw;, in converse to &acl; and &cmucl; does not do
+ any open coding of object access. &lw;, by default, maintains
+ objects with run-time typing. </para>
+ </sect2>
+ <sect2>
+ <title>Cross-Implementation Optimization</title>
+ <para>
+ To fully optimize across platforms, both explicit type
+ information must be passed to dereferencing of pointers and
+ arrays. Though this optimization only helps with &acl;, &uffi;
+ is designed to require this type information be passed the
+ dereference functions. Second, declarations of type should be
+ made in functions, structures, and classes where foreign
+ objects will be help. This will optimize access for &lw;
+ </para>
+ <para>
+ Here is an example that should both methods being used for
+ maximum cross-implementation optimization:
+ <screen>
+(uffi:def-type the-struct-type-def the-struct-type)
+(let ((a-foreign-struct (allocate-foreign-object 'the-struct-type)))
+ (declare 'the-struct-type-def a-foreign-struct)
+ (get-slot-value a-foreign-struct 'the-struct-type 'field-name))
+ </screen>
+ </para>
+ </sect2>
+ </sect1>
+
+</chapter>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/preface.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/preface.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,16 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<preface id="preface">
+ <title>Preface</title>
+ <para>This reference guide describes the usage and features of
+ &uffi;. The first chapter provides an overview to the design of
+ &uffi;. Following that chapter is the reference section for all
+ user accessible functions of &uffi;. The appendix covers the
+ installation and implementation-specifc features of &uffi;.
+ </para>
+</preface>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_aggregate.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_aggregate.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,524 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<reference id="aggregates">
+ <title>Aggregate Types</title>
+ <partintro>
+ <title>Overview</title>
+ <para>
+ Aggregate types are comprised of one or more primitive types.
+ </para>
+ </partintro>
+
+ <refentry id="def-enum">
+ <refnamediv>
+ <refname>def-enum</refname>
+ <refpurpose>Defines a &c; enumeration.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-enum</function> <replaceable>name fields &key separator-string</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A symbol that names the enumeration.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>fields</parameter></term>
+ <listitem>
+ <para>A list of field defintions. Each definition can be
+a symbol or a list of two elements. Symbols get assigned a value of the
+current counter which starts at <computeroutput>0</computeroutput> and
+increments by <computeroutput>1</computeroutput> for each subsequent symbol. It the field definition is a list, the first position is the symbol and the second
+position is the value to assign the the symbol. The current counter gets set
+to <computeroutput>1+</computeroutput> this value.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>separator-string</parameter></term>
+ <listitem>
+ <para>A string that governs the creation of constants. The
+default is <computeroutput>"#"</computeroutput>.</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Declares a &c; enumeration. It generates constants with integer values for the elements of the enumeration. The symbols for the these constant
+values are created by the <function>concatenation</function> of the
+enumeration name, separator-string, and field symbol. Also creates
+a foreign type with the name <parameter>name</parameter> of type
+<constant>:int</constant>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-enum abc (:a :b :c))
+;; Creates constants abc#a (1), abc#b (2), abc#c (3) and defines
+;; the foreign type "abc" to be :int
+
+(def-enum efoo (:e1 (:e2 10) :e3) :separator-string "-")
+;; Creates constants efoo-e1 (1), efoo-e2 (10), efoo-e3 (11) and defines
+;; the foreign type efoo to be :int
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Creates a :int foreign type, defines constants.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="def-struct">
+ <refnamediv>
+ <refname>def-struct</refname>
+ <refpurpose>Defines a &c; structure.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-struct</function> <replaceable>name &rest fields</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A symbol that names the structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>fields</parameter></term>
+ <listitem>
+ <para>A variable number of field defintions. Each definition is a list consisting of a symbol naming the field followed by its foreign type.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Declares a structure. A special type is available as a slot
+in the field. It is a pointer that points to an instance of the parent
+structure. It's type is <constant>:pointer-self</constant>.
+
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-struct foo (a :unsigned-int)
+ (b (* :char))
+ (c (:array :int 10))
+ (next :pointer-self))
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Creates a foreign type.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="get-slot-value">
+ <refnamediv>
+ <refname>get-slot-value</refname>
+ <refpurpose>Retrieves a value from a slot of a structure.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>get-slot-value</function> <replaceable>obj type field</replaceable> => <returnvalue>value</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>obj</parameter></term>
+ <listitem>
+ <para>A pointer to foreign structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A name of the foreign structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>field</parameter></term>
+ <listitem>
+ <para>A name of the desired field in foreign structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>value</returnvalue></term>
+ <listitem>
+ <para>The value of the field in the structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Accesses a slot value from a structure. This is generalized
+ and can be used with <function>setf</function>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(get-slot-value foo-ptr 'foo-structure 'field-name)
+(setf (get-slot-value foo-ptr 'foo-structure 'field-name) 10)
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="get-slot-pointer">
+ <refnamediv>
+ <refname>get-slot-pointer</refname>
+ <refpurpose>Retrieves a pointer from a slot of a structure.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>get-slot-pointer</function> <replaceable>obj type field</replaceable> => <returnvalue>pointer</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>obj</parameter></term>
+ <listitem>
+ <para>A pointer to foreign structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A name of the foreign structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>field</parameter></term>
+ <listitem>
+ <para>A name of the desired field in foreign structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>pointer</returnvalue></term>
+ <listitem>
+ <para>The value of the field in the structure.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ This is similar to <function>get-slot-value</function>. It
+ is used when the value of a slot is a pointer type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(get-slot-pointer foo-ptr 'foo-structure 'my-char-ptr)
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="def-array-pointer">
+ <refnamediv>
+ <refname>def-array-pointer</refname>
+ <refpurpose>Defines a pointer to a array of type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-array-pointer</function> <replaceable>name type</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A name of the new foreign type.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>The foreign type of the array elements.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Defines a type tat is a pointer to an array of type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-array-pointer byte-array-pointer :unsigned-char)
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Defines a new foreign type.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="deref-array">
+ <refnamediv>
+ <refname>deref-array</refname>
+ <refpurpose>Deference an array.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>deref-array</function> <replaceable>array type position</replaceable> => <returnvalue>value</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>array</parameter></term>
+ <listitem>
+ <para>A foreign array.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>The foreign type of the array.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>position</parameter></term>
+ <listitem>
+ <para>An integer specifying the position to retrieve from
+the array.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>value</returnvalue></term>
+ <listitem>
+ <para>The value stored in the position of the array.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Dereferences (retrieves) the value of an array element.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-array-pointer ca :char)
+(let ((fs (convert-to-foreign-string "ab")))
+ (values (null-char-p (deref-array fs 'ca 0))
+ (null-char-p (deref-array fs 'ca 2))))
+=> &nil;
+ &t;
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>
+ The TYPE argument is ignored for CL implementations other than
+ AllegroCL. If you want to cast a pointer to another type use
+ WITH-CAST-POINTER together with DEREF-POINTER/DEREF-ARRAY.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="def-union">
+ <refnamediv>
+ <refname>def-union</refname>
+ <refpurpose>Defines a foreign union type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-union</function> <replaceable>name &rest fields</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A name of the new union type.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>fields</parameter></term>
+ <listitem>
+ <para>A list of fields of the union.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Defines a foreign union type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-union test-union
+ (a-char :char)
+ (an-int :int))
+
+(let ((u (allocate-foreign-object 'test-union))
+ (setf (get-slot-value u 'test-union 'an-int) (+ 65 (* 66 256)))
+ (prog1
+ (ensure-char-character (get-slot-value u 'test-union 'a-char))
+ (free-foreign-object u)))
+=> #\A
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Defines a new foreign type.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+</reference>
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_declare.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_declare.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,82 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<reference id="ref_declarations">
+ <title>Declarations</title>
+
+ <partintro>
+ <sect1>
+ <title>Overview</title>
+ <para>Declarations are used to give the compiler optimizing
+ information about foreign types. Currently, only &cmucl;
+ supports declarations. On &acl; and &lw;, these expressions
+ declare the type generically as &t;
+ </para>
+ </sect1>
+ </partintro>
+
+ <refentry id="def-type">
+ <refnamediv>
+ <refname>def-type</refname>
+ <refpurpose>Defines a Common Lisp type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-type</function> <replaceable>name type</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A symbol naming the type</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A form that specifies the &uffi; type. It is not evaluated.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Defines a Common Lisp type based on a &uffi; type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-type char-ptr '(* :char))
+...
+(defun foo (ptr)
+(declare (type char-ptr ptr))
+...
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Defines a new &cl; type.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+</reference>
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_func_libr.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_func_libr.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,264 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<reference id="func_libr">
+ <title>Functions & Libraries</title>
+
+ <refentry id="def-function">
+ <refnamediv>
+ <refname>def-function</refname>
+ <refpurpose>Declares a function.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-function</function> <replaceable>name args &key module returning</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A string or list specificying the function name. If it is a string, that names the foreign function. A Lisp name is created by translating #\_ to #\- and by converting to upper-case in case-insensitive Lisp implementations. If it is a list, the first item is a string specifying the foreign function name and the second it is a symbol stating the Lisp name.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>args</parameter></term>
+ <listitem>
+ <para>A list of argument declarations. If &nil;, indicates that the function does not take any arguments.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>module</parameter></term>
+ <listitem>
+ <para>A string specifying which module (or library) that the foreign function resides. (Required by Lispworks)</para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>returning</returnvalue></term>
+ <listitem>
+ <para>A declaration specifying the result type of the
+foreign function. If <constant>:void</constant> indicates module does not return any value.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Declares a foreign function.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-function "gethostname"
+ ((name (* :unsigned-char))
+ (len :int))
+ :returning :int)
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="load-foreign-library">
+ <refnamediv>
+ <refname>load-foreign-library</refname>
+ <refpurpose>Loads a foreign library.
+ </refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+<synopsis>
+ <function>load-foreign-library</function> <replaceable>filename &key module supporting-libraries force-load</replaceable> => <returnvalue>success</returnvalue>
+</synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>filename</parameter></term>
+ <listitem>
+ <para>A string or pathname specifying the library location
+in the filesystem. At least one implementation (&lw;) can not
+accept a logical pathname. If this parameter denotes a pathname without a
+directory component then most of the supported Lisp implementations will be
+able to find the library themselves if it is located in one of the standard
+locations as defined by the underlying operating system.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>module</parameter></term>
+ <listitem>
+ <para>A string designating the name of the module to apply
+to functions in this library. (Required for Lispworks)
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>supporting-libraries</parameter></term>
+ <listitem>
+ <para>A list of strings naming the libraries required to
+link the foreign library. (Required by CMUCL)
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>force-load</parameter></term>
+ <listitem>
+ <para>Forces the loading of the library if it has been previously loaded.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>success</returnvalue></term>
+ <listitem>
+ <para>A boolean flag, &t; if the library was able to be
+loaded successfully or if the library has been previously loaded,
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Loads a foreign library. Applies a module name to functions
+within the library. Ensures that a library is only loaded once during
+a session. A library can be reloaded by using the <symbol>:force-load</symbol> key.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+ (load-foreign-library #p"/usr/lib/libmysqlclient.so"
+ :module "mysql"
+ :supporting-libraries '("c"))
+ => T
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Loads the foreign code into the Lisp system.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>Ability to load the file.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>An error will be signaled if the library is unable to be loaded.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="find-foreign-library">
+ <refnamediv>
+ <refname>find-foreign-library</refname>
+ <refpurpose>Finds a foreign library file.
+ </refpurpose>
+ <refclass>Function</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+<synopsis>
+ <function>find-foreign-library</function> <replaceable>names directories & drive-letters types</replaceable> => <returnvalue>path</returnvalue>
+</synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>names</parameter></term>
+ <listitem>
+ <para>A string or list of strings containing the base name of the library file.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>directories</parameter></term>
+ <listitem>
+ <para>A string or list of strings containing the directory the library file.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>drive-letters</parameter></term>
+ <listitem>
+ <para>A string or list of strings containing the drive letters for the library file.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>types</parameter></term>
+ <listitem>
+ <para>A string or list of strings containing the file type of the library file. Default
+is &nil;. If &nil;, will use a default type based on the currently running implementation.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>path</returnvalue></term>
+ <listitem>
+ <para>A path containing the path found, or &nil; if the library file was not found.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Finds a foreign library by searching through a number of possible locations. Returns
+the path of the first found file.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(find-foreign-library '("libmysqlclient" "libmysql")
+ '("/opt/mysql/lib/mysql/" "/usr/local/lib/" "/usr/lib/" "/mysql/lib/opt/")
+ :types '("so" "dll")
+ :drive-letters '("C" "D" "E"))
+=> #P"D:\\mysql\\lib\\opt\\libmysql.dll"
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+</reference>
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_object.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_object.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,859 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<reference id="objects">
+ <title>Objects</title>
+<partintro>
+<title>Overview</title>
+ <para>
+ Objects are entities that can allocated, referred to by pointers, and
+can be freed.
+ </para>
+</partintro>
+
+
+ <refentry id="allocate-foreign-object">
+ <refnamediv>
+ <refname>allocate-foreign-object</refname>
+ <refpurpose>Allocates an instance of a foreign object.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>allocate-foreign-object</function> <replaceable>type &optional size</replaceable> => <returnvalue>ptr</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>The type of foreign object to allocate. This parameter is evaluated.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>size</parameter></term>
+ <listitem>
+ <para>An optional size parameter that is evaluated. If specified, allocates and returns an
+array of <parameter>type</parameter> that is <parameter>size</parameter> members long. This parameter is evaluated.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>ptr</returnvalue></term>
+ <listitem>
+ <para>A pointer to the foreign object.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Allocates an instance of a foreign object. It returns a pointer to the object.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-struct ab (a :int) (b :double))
+(allocate-foreign-object 'ab)
+=> #<ptr>
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="free-foreign-object">
+ <refnamediv>
+ <refname>free-foreign-object</refname>
+ <refpurpose>Frees memory that was allocated for a foreign boject.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>free-foreign-object</function> <replaceable>ptr</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>A pointer to the allocated foreign object to free.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Frees the memory used by the allocation of a foreign object.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="with-foreign-object">
+ <refnamediv>
+ <refname>with-foreign-object</refname>
+ <refpurpose>Wraps the allocation of a foreign object around a body of code.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>with-foreign-object</function> <replaceable>(var type) &body body</replaceable> => <returnvalue>form-return</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>var</parameter></term>
+ <listitem>
+ <para>The variable name to bind.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>The type of foreign object to allocate. This parameter is evaluated.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>form-return</returnvalue></term>
+ <listitem>
+ <para>The result of evaluating the <parameter>body</parameter>.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+This function wraps the allocation, binding, and destruction of a foreign object.
+On &cmucl; and
+&lw; platforms the object is stack allocated for efficiency. Benchmarks show that &acl; performs
+much better with static allocation.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(defun gethostname2 ()
+ "Returns the hostname"
+ (uffi:with-foreign-object (name '(:array :unsigned-char 256))
+ (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
+ (uffi:convert-from-foreign-string name)
+ (error "gethostname() failed."))))
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="size-of-foreign-type">
+ <refnamediv>
+ <refname>size-of-foreign-type</refname>
+ <refpurpose>Returns the number of data bytes used by a foreign object type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>size-of-foreign-type</function> <replaceable>ftype</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>ftype</parameter></term>
+ <listitem>
+ <para>A foreign type specifier. This parameter is evaluated.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Returns the number of data bytes used by a foreign object type. This does not include any Lisp storage overhead.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para>
+<screen>
+(size-of-foreign-object :unsigned-byte)
+=> 1
+(size-of-foreign-object 'my-100-byte-vector-type)
+=> 100
+</screen>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1> <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="pointer-address">
+ <refnamediv>
+ <refname>pointer-address</refname>
+ <refpurpose>Returns the address of a pointer.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>pointer-address</function> <replaceable>ptr</replaceable> => <returnvalue>address</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>A pointer to a foreign object.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>address</parameter></term>
+ <listitem>
+ <para>An integer representing the pointer's address.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Returns the address as an integer of a pointer.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="deref-pointer">
+ <refnamediv>
+ <refname>deref-pointer</refname>
+ <refpurpose>Deferences a pointer.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>deref-pointer</function> <replaceable>ptr type</replaceable> => <returnvalue>value</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>A pointer to a foreign object.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A foreign type of the object being pointed to.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>value</returnvalue></term>
+ <listitem>
+ <para>The value of the object where the pointer points.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Returns the object to which a pointer points.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para>
+<screen>
+(let ((intp (allocate-foreign-object :int)))
+ (setf (deref-pointer intp :int) 10)
+ (prog1
+ (deref-pointer intp :int)
+ (free-foreign-object intp)))
+=> 10
+</screen>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Notes</title>
+ <para>
+ The TYPE argument is ignored for CL implementations other than
+ AllegroCL. If you want to cast a pointer to another type use
+ WITH-CAST-POINTER together with DEREF-POINTER/DEREF-ARRAY.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="ensure-char-character">
+ <refnamediv>
+ <refname>ensure-char-character</refname>
+ <refpurpose>Ensures that a dereferenced <constant>:char</constant> pointer is
+a character.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>ensure-char-character</function> <replaceable>object</replaceable> => <returnvalue>char</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>object</parameter></term>
+ <listitem>
+ <para>Either a character or a integer specifying a character code.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>char</returnvalue></term>
+ <listitem>
+ <para>A character.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Ensures that an objects obtained by dereferencing
+<constant>:char</constant> and <constant>:unsigned-char</constant>
+pointers are a lisp character.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para>
+<screen>
+(let ((fs (convert-to-foreign-string "a")))
+ (prog1
+ (ensure-char-character (deref-pointer fs :char))
+ (free-foreign-object fs)))
+=> #\a
+</screen>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>Depending upon the implementation and what &uffi; expects, this
+macro may signal an error if the object is not a character or
+integer.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="ensure-char-integer">
+ <refnamediv>
+ <refname>ensure-char-integer</refname>
+ <refpurpose>Ensures that a dereferenced <constant>:char</constant> pointer is
+an integer.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>ensure-char-integer</function> <replaceable>object</replaceable> => <returnvalue>int</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>object</parameter></term>
+ <listitem>
+ <para>Either a character or a integer specifying a character code.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>int</returnvalue></term>
+ <listitem>
+ <para>An integer.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Ensures that an object obtained by dereferencing a
+<constant>:char</constant> pointer is an integer.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para>
+<screen>
+(let ((fs (convert-to-foreign-string "a")))
+ (prog1
+ (ensure-char-integer (deref-pointer fs :char))
+ (free-foreign-object fs)))
+=> 96
+</screen>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>Depending upon the implementation and what &uffi; expects, this
+macro may signal an error if the object is not a character or
+integer.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="make-null-pointer">
+ <refnamediv>
+ <refname>make-null-pointer</refname>
+ <refpurpose>Create a &null; pointer.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>make-null-pointer</function> <replaceable>type</replaceable> => <returnvalue>ptr</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A type of object to which the pointer refers.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>The &null; pointer of type <parameter>type</parameter>.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Creates a &null; pointer of a specified type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="null-pointer-p">
+ <refnamediv>
+ <refname>null-pointer-p</refname>
+ <refpurpose>Tests a pointer for &null; value.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>null-pointer-p</function> <replaceable>ptr</replaceable> => <returnvalue>is-null</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>A foreign object pointer.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>is-null</returnvalue></term>
+ <listitem>
+ <para>The boolean flag.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ A predicate testing if a pointer is has a &null; value.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="null-cstring-pointer">
+ <refnamediv>
+ <refname>+null-cstring-pointer+</refname>
+ <refpurpose>A constant &null; cstring pointer.
+ </refpurpose>
+ <refclass>Constant</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ A &null; cstring pointer. This can be used for testing
+if a cstring returned by a function is &null;.
+ </para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="with-cast-pointer">
+ <refnamediv>
+ <refname>with-cast-pointer</refname>
+ <refpurpose>Wraps a body of code with a pointer cast to a new type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>with-cast-pointer</function> (<replaceable>binding-name ptr type) & body body</replaceable> => <returnvalue>value</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>binding-name</parameter></term>
+ <listitem>
+ <para>A symbol which will be bound to the casted object.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>ptr</parameter></term>
+ <listitem>
+ <para>A pointer to a foreign object.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A foreign type of the object being pointed to.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>value</returnvalue></term>
+ <listitem>
+ <para>The value of the object where the pointer points.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Executes BODY with POINTER cast to be a pointer to type TYPE.
+ BINDING-NAME is will be bound to this value during the execution of
+ BODY.
+
+ This is a no-op in AllegroCL but will wrap BODY in a LET form if
+ BINDING-NAME is provided.
+
+ This macro is meant to be used in conjunction with DEREF-POINTER or
+ DEREF-ARRAY. In Allegro CL the "cast" will actually take place in
+ DEREF-POINTER or DEREF-ARRAY.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+<screen>
+(with-foreign-object (size :int)
+ ;; FOO is a foreign function returning a :POINTER-VOID
+ (let ((memory (foo size)))
+ (when (mumble)
+ ;; at this point we know for some reason that MEMORY points
+ ;; to an array of unsigned bytes
+ (with-cast-pointer (memory :unsigned-byte)
+ (dotimes (i (deref-pointer size :int))
+ (do-something-with
+ (deref-array memory '(:array :unsigned-byte) i)))))))
+</screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="def-foreign-var">
+ <refnamediv>
+ <refname>def-foreign-var</refname>
+ <refpurpose>
+Defines a symbol macro to access a variable in foreign code
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-foreign-var</function> <replaceable>name type module</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>
+A string or list specificying the symbol macro's name. If it is a
+ string, that names the foreign variable. A Lisp name is created
+ by translating #\_ to #\- and by converting to upper-case in
+ case-insensitive Lisp implementations. If it is a list, the first
+ item is a string specifying the foreign variable name and the
+ second it is a symbol stating the Lisp name.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>type</parameter></term>
+ <listitem>
+ <para>A foreign type of the foreign variable.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>module</returnvalue></term>
+ <listitem>
+ <para>
+ A string specifying the module (or library) the foreign variable
+ resides in. (Required by Lispworks)
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+Defines a symbol macro which can be used to access (get and set) the
+value of a variable in foreign code.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <refsect2>
+ <title>C code</title>
+<screen>
+ int baz = 3;
+
+ typedef struct {
+ int x;
+ double y;
+ } foo_struct;
+
+ foo_struct the_struct = { 42, 3.2 };
+
+ int foo () {
+ return baz;
+ }
+</screen>
+</refsect2>
+<refsect2>
+<title>Lisp code</title>
+<screen>
+ (uffi:def-struct foo-struct
+ (x :int)
+ (y :double))
+
+ (uffi:def-function ("foo" foo)
+ ()
+ :returning :int
+ :module "foo")
+
+ (uffi:def-foreign-var ("baz" *baz*) :int "foo")
+ (uffi:def-foreign-var ("the_struct" *the-struct*) foo-struct "foo")
+
+
+*baz*
+ => 3
+
+(incf *baz*)
+ => 4
+
+(foo)
+ => 4
+</screen>
+</refsect2>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+</reference>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_primitive.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_primitive.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,279 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<reference id="primitives">
+ <title>Primitive Types</title>
+ <partintro>
+ <title>Overview</title>
+ <para>
+ Primitive types have a single value, these include
+ characters, numbers, and pointers. They are all symbols in
+ the keyword package.
+ </para>
+ <itemizedlist>
+ <listitem>
+ <para><constant>:char</constant> - Signed 8-bits. A
+ dereferenced :char pointer returns an character.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:unsigned-char</constant> - Unsigned 8-bits. A dereferenced :unsigned-char
+ pointer returns an character.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:byte</constant> - Signed 8-bits. A
+ dereferenced :byte pointer returns an integer.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:unsigned-byte</constant> - Unsigned 8-bits. A
+ dereferenced :unsigned-byte pointer returns an integer.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:short</constant> - Signed 16-bits.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:unsigned-short</constant> - Unsigned 16-bits.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:int</constant> - Signed 32-bits.</para>
+ </listitem>
+ <listitem>
+ <para><constant>:unsigned-int</constant> - Unsigned 32-bits.</para>
+ </listitem>
+ <listitem>
+ <para><constant>:long</constant> - Signed 32 or 64 bits, depending upon the platform.</para>
+ </listitem>
+ <listitem>
+ <para><constant>:unsigned-long</constant> - Unsigned 32 or 64 bits, depending upon the platform.</para>
+ </listitem>
+ <listitem>
+ <para><constant>:float</constant> - 32-bit floating point.</para>
+ </listitem>
+ <listitem>
+ <para><constant>:double</constant> - 64-bit floating point.</para>
+ </listitem>
+ <listitem>
+ <para><constant>:cstring</constant> -
+ A &null; terminated string used for passing and returning characters strings with a &c; function.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:void</constant> -
+ The absence of a value. Used to indicate that a function does not return a value.
+ </para>
+ </listitem>
+ <listitem>
+ <para><constant>:pointer-void</constant> - Points to a generic object.</para>
+ </listitem>
+ <listitem>
+ <para><constant>*</constant> - Used to declare a pointer to an object</para>
+ </listitem>
+ </itemizedlist>
+ </partintro>
+
+ <refentry id="def-constant">
+ <refnamediv>
+ <refname>def-constant</refname>
+ <refpurpose>Binds a symbol to a constant.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-constant</function> <replaceable>name value &key export</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A symbol that will be bound to the value.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>value</parameter></term>
+ <listitem>
+ <para>An evaluated form that is bound the the name.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>export</parameter></term>
+ <listitem>
+ <para>When &t;, the name is exported from the current package. The default is &nil;</para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>This is a thin wrapper around <function>defconstant</function>. It evaluates at
+ compile-time and optionally exports the symbol from the package.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-constant pi2 (* 2 pi))
+(def-constant exported-pi2 (* 2 pi) :export t)
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Creates a new special variable..</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="def-foreign-type">
+ <refnamediv>
+ <refname>def-foreign-type</refname>
+ <refpurpose>Defines a new foreign type.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis>
+ <function>def-foreign-type</function> <replaceable>name type</replaceable>
+ </synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>name</parameter></term>
+ <listitem>
+ <para>A symbol naming the new foreign type.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>value</parameter></term>
+ <listitem>
+ <para>A form that is not evaluated that defines the new
+ foreign type.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>Defines a new foreign type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-foreign-type my-generic-pointer :pointer-void)
+(def-foreign-type a-double-float :double-float)
+(def-foreign-type char-ptr (* :char))
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>Defines a new foreign type.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="null-char-p">
+ <refnamediv>
+ <refname>null-char-p</refname>
+ <refpurpose>Tests a character for &null; value.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsect1>
+ <title>Syntax</title>
+ <synopsis>
+ <function>null-char-p</function> <replaceable>char</replaceable> => <returnvalue>is-null</returnvalue>
+ </synopsis>
+ </refsect1>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>char</parameter></term>
+ <listitem>
+ <para>A character or integer.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>is-null</parameter></term>
+ <listitem>
+ <para>A boolean flag indicating if char is a &null; value.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ A predicate testing if a character or integer is &null;. This
+ abstracts the difference in implementations where some return a
+ <computeroutput>character</computeroutput>
+ and some return a
+ <computeroutput>integer</computeroutput>
+ whence dereferencing a
+ <computeroutput>C</computeroutput>
+ character pointer.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <screen>
+(def-array-pointer ca :unsigned-char)
+(let ((fs (convert-to-foreign-string "ab")))
+ (values (null-char-p (deref-array fs 'ca 0))
+ (null-char-p (deref-array fs 'ca 2))))
+=> &nil;
+ &t;
+ </screen>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+</reference>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_string.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/ref_string.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,514 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+%myents;
+]>
+
+<reference id="strings">
+ <title>Strings</title>
+ <partintro>
+ <title>Overview</title>
+ <para>
+ &uffi; has functions to two types of <varname>C</varname>-compatible
+ strings: <emphasis>cstring</emphasis> and <emphasis>foreign</emphasis>
+ strings. cstrings are used <emphasis>only</emphasis> as parameters to
+ and from functions. In some implementations a cstring is not a foreign
+ type but rather the Lisp string itself. On other platforms a cstring
+ is a newly allocated foreign vector for storing characters. The
+ following is an example of using cstrings to both send and return a
+ value.
+ </para>
+
+ <screen>
+(uffi:def-function ("getenv" c-getenv)
+ ((name :cstring))
+ :returning :cstring)
+
+(defun my-getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-cstring (key-native key)
+ (uffi:convert-from-cstring (c-getenv key-native))))
+ </screen>
+
+ <para>
+ In contrast, foreign strings are always a foreign vector of
+ characters which have memory allocated. Thus, if you need to
+ allocate memory to hold the return value of a string, you must
+ use a foreign string and not a cstring. The following is an
+ example of using a foreign string for a return value.
+ </para>
+
+ <screen>
+(uffi:def-function ("gethostname" c-gethostname)
+ ((name (* :unsigned-char))
+ (len :int))
+ :returning :int)
+
+(defun gethostname ()
+ "Returns the hostname"
+ (let* ((name (uffi:allocate-foreign-string 256))
+ (result-code (c-gethostname name 256))
+ (hostname (when (zerop result-code)
+ (uffi:convert-from-foreign-string name))))
+ ;; UFFI does not yet provide a universal way to free
+ ;; memory allocated by C's malloc. At this point, a program
+ ;; needs to call C's free function to free such memory.
+ (unless (zerop result-code)
+ (error "gethostname() failed."))))
+ </screen>
+
+ <para>
+ Foreign functions that return pointers to freshly allocated
+ strings should in general not return cstrings, but foreign
+ strings. (There is no portable way to release such cstrings from
+ Lisp.) The following is an example of handling such a function.
+ </para>
+
+ <screen>
+(uffi:def-function ("readline" c-readline)
+ ((prompt :cstring))
+ :returning (* :char))
+
+(defun readline (prompt)
+ "Reads a string from console with line-editing."
+ (with-cstring (c-prompt prompt)
+ (let* ((c-str (c-readline c-prompt))
+ (str (convert-from-foreign-string c-str)))
+ (uffi:free-foreign-object c-str)
+ str)))
+ </screen>
+
+ </partintro>
+
+ <refentry id="convert-from-cstring">
+ <refnamediv>
+ <refname>convert-from-cstring</refname>
+ <refpurpose>Converts a cstring to a Lisp string.</refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>convert-from-cstring</function>
+ <replaceable>cstring</replaceable>
+ =>
+ <returnvalue>string</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>cstring</parameter></term>
+ <listitem>
+ <para>A cstring.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>string</returnvalue></term>
+ <listitem>
+ <para>A Lisp string.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Converts a Lisp string to a <constant>cstring</constant>. This is
+ most often used when processing the results of a foreign function
+ that returns a cstring.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="convert-to-cstring">
+ <refnamediv>
+ <refname>convert-to-cstring</refname>
+ <refpurpose>Converts a Lisp string to a cstring.</refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>convert-to-cstring</function>
+ <replaceable>string</replaceable>
+ =>
+ <returnvalue>cstring</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>string</parameter></term>
+ <listitem>
+ <para>A Lisp string.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>cstring</returnvalue></term>
+ <listitem>
+ <para>A cstring.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Converts a Lisp string to a <varname>cstring</varname>. The
+ <varname>cstring</varname> should be freed with
+ <function>free-cstring</function>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>On some implementations, this function allocates memory.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="free-cstring">
+ <refnamediv>
+ <refname>free-cstring</refname>
+ <refpurpose>Free memory used by cstring.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>free-cstring</function> <replaceable>cstring</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>cstring</parameter></term>
+ <listitem>
+ <para>A cstring.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Frees any memory possibly allocated by
+ <function>convert-to-cstring</function>. On some implementions, a cstring is just the Lisp string itself.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="with-cstring">
+ <refnamediv>
+ <refname>with-cstring</refname>
+ <refpurpose>Binds a newly created cstring.</refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>with-cstring</function>
+ <replaceable>(cstring string) {body}</replaceable>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>cstring</parameter></term>
+ <listitem>
+ <para>A symbol naming the cstring to be created.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>string</parameter></term>
+ <listitem>
+ <para>A Lisp string that will be translated to a cstring.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>body</parameter></term>
+ <listitem>
+ <para>The body of where the cstring will be bound.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Binds a symbol to a cstring created from conversion of a
+ string. Automatically frees the <varname>cstring</varname>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Examples</title>
+ <para>
+ <screen>
+(def-function ("getenv" c-getenv)
+ ((name :cstring))
+ :returning :cstring)
+
+(defun getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (with-cstring (key-cstring key)
+ (convert-from-cstring (c-getenv key-cstring))))
+ </screen>
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="convert-from-foreign-string">
+ <refnamediv>
+ <refname>convert-from-foreign-string</refname>
+ <refpurpose>Converts a foreign string into a Lisp string.</refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>convert-from-foreign-string</function>
+ <replaceable>foreign-string &key length null-terminated-p</replaceable>
+ =>
+ <returnvalue>string</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>foreign-string</parameter></term>
+ <listitem>
+ <para>A foreign string.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>length</parameter></term>
+ <listitem>
+ <para>The length of the foreign string to convert. The
+ default is the length of the string until a &null;
+ character is reached.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>null-terminated-p</parameter></term>
+ <listitem>
+ <para>A boolean flag with a default value of &t; When true,
+ the string is converted until the first &null; character is reached.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>string</returnvalue></term>
+ <listitem>
+ <para>A Lisp string.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Returns a Lisp string from a foreign string.
+ Can translated ASCII and binary strings.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+
+ <refentry id="convert-to-foreign-string">
+ <refnamediv>
+ <refname>convert-to-foreign-string</refname>
+ <refpurpose>Converts a Lisp string to a foreign string.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>convert-to-foreign-string</function>
+ <replaceable>string</replaceable> =>
+ <returnvalue>foreign-string</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>string</parameter></term>
+ <listitem>
+ <para>A Lisp string.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>foreign-string</returnvalue></term>
+ <listitem>
+ <para>A foreign string.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Converts a Lisp string to a foreign string. Memory should be
+ freed with <function>free-foreign-object</function>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+ <refentry id="allocate-foreign-string">
+ <refnamediv>
+ <refname>allocate-foreign-string</refname>
+ <refpurpose>Allocates space for a foreign string.
+ </refpurpose>
+ <refclass>Macro</refclass>
+ </refnamediv>
+ <refsynopsisdiv>
+ <title>Syntax</title>
+ <synopsis>
+ <function>allocate-foreign-string</function> <replaceable>size
+ &key unsigned</replaceable> =>
+ <returnvalue>foreign-string</returnvalue>
+ </synopsis>
+ </refsynopsisdiv>
+ <refsect1>
+ <title>Arguments and Values</title>
+ <variablelist>
+ <varlistentry>
+ <term><parameter>size</parameter></term>
+ <listitem>
+ <para>The size of the space to be allocated in bytes.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><parameter>unsigned</parameter></term>
+ <listitem>
+ <para>A boolean flag with a default value of &t;. When true,
+ marks the pointer as an <constant>:unsigned-char</constant>.
+ </para>
+ </listitem>
+ </varlistentry>
+ <varlistentry>
+ <term><returnvalue>foreign-string</returnvalue></term>
+ <listitem>
+ <para>A foreign string which has undefined contents.
+ </para>
+ </listitem>
+ </varlistentry>
+ </variablelist>
+ </refsect1>
+ <refsect1>
+ <title>Description</title>
+ <para>
+ Allocates space for a foreign string. Memory should
+ be freed with <function>free-foreign-object</function>.
+ </para>
+ </refsect1>
+ <refsect1>
+ <title>Side Effects</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Affected by</title>
+ <para>None.</para>
+ </refsect1>
+ <refsect1>
+ <title>Exceptional Situations</title>
+ <para>None.</para>
+ </refsect1>
+ </refentry>
+
+</reference>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/schemas.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/schemas.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,16 @@
+<?xml version="1.0"?>
+<locatingRules xmlns="http://thaiopensource.com/ns/locating-rules/1.0">
+ <uri resource="appendix.xml" typeId="DocBook"/>
+ <uri resource="bookinfo.xml" typeId="DocBook"/>
+ <uri resource="glossary.xml" typeId="DocBook"/>
+ <uri resource="intro.xml" typeId="DocBook"/>
+ <uri resource="notes.xml" typeId="DocBook"/>
+ <uri resource="preface.xml" typeId="DocBook"/>
+ <uri resource="ref_aggregate.xml" typeId="DocBook"/>
+ <uri resource="ref_declare.xml" typeId="DocBook"/>
+ <uri resource="ref_func_libr.xml" typeId="DocBook"/>
+ <uri resource="ref_object.xml" typeId="DocBook"/>
+ <uri resource="ref_primitive.xml" typeId="DocBook"/>
+ <uri resource="ref_string.xml" typeId="DocBook"/>
+ <uri resource="uffi.xml" typeId="DocBook"/>
+</locatingRules>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/uffi.pdf
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/uffi.pdf Mon Feb 11 09:23:05 2008
@@ -0,0 +1,3005 @@
+%PDF-1.3
+%����
+4 0 obj
+<< /Type /Info
+/Producer (FOP 0.20.5) >>
+endobj
+5 0 obj
+<< /Length 201 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GaqdX]*cD?&;B(lTAl),iOH@5G$De=MG72'Yq]!?$6qt2q-EJV_Gi>/s/i"t<YjDPpBIl;OsFK],W_VAdjSmtNX!d%$GJd<iKP@`C7F7B\4aN'o`*!Hd\`C527G^=cu>#!0$EmK_'.Pqq^YH!<Kd&3bW6*^_c]c9kmt5c=$QVU6<Rh(R]Z8]_8CuImRsaYGQS>T2*q~>
+endstream
+endobj
+6 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 5 0 R
+>>
+endobj
+7 0 obj
+<< /Length 965 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gau0B9lo#B&A@ZcFA-9Z`S\\a;j*G?g8#gidrqVQ6.j%f@O*E0./ih(NJo,:9QS9/_s"58Dg.h\CL?1UMbsWT#Y#r/$p7>qI,Lur&,a4q*_<sf$j%O31[t"sEAY6i"i!>%??q6/YH:;7_^lb<4qDmi3MlsD"m81?_JGV7i8eK99"_!XJ`"DOWS69%V?g*poDpTOD+NYulf9+Uo`GkpN\R^oiss6d1+_$n^?25[9&oja`4eNgk6:&60/TOB6uH`Wp6H>(0FlQ+&l1e).un/XO\^rLae!\j^aO6ZSR^<5QNT"!'A$fUMJ#msPP>Ik"%k+87<*#mLg"3*M3QXj@(^rV33`Ef<,$'],bHf`&KqG70S_>U@rObfN@Ksee2_<.A2Ype;4lNrOpK1OGTj>/<Ma"UDHg_S,a5W'4EY/#XB<\#Q*tNq9?^Zh-]V.`3@&E]jQW.pO#@ttltjGe#p?dRd2aYi(&2T@n`H,_@0j27nSae5"nl@;-taXu2Una?K]q-E23QVF?gdO1(ZUs?WBMSE*'5u_fc"boeG(P`a;*_&1JCBr(B2<3YDA_&QnfW:dO!lUkp,NHERE-hZXZ*Z)7m1"cDWk?B$3Z%5/i-kqOQV+rZcQeSgNd?[R`o&f2ntr]+CO8V6X:ldO^l'Dih\DmCK?o"nh#P(^%#I!hi&r..)RnpUE=DYekJfLX#V!.mH5&_CU=G)RqESAlT(X@",'+9\;Qo0'aEWgsY]g:/1P[^K>$4**4VkH='g?99)V,6i=K%e<(Y:Igs&e7=Vacjr\mMg^u8J1&`_1/&r`fU3\Ej-d+>-1m@B"_3n-uBP>*n>-c\ZV;2gTE8kkP7[onB-ZrdueerP,n!LL?kH%o&<]GtKfIhq`rShqJdHX,L[,-5?>m[u-Lj:e[Q<)WeX49j5FHX;[#JW4TE1:c)ofX(CW*Oab`A*_g^'q18h$9,LL52At#8'F<d/~>
+endstream
+endobj
+8 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 7 0 R
+>>
+endobj
+9 0 obj
+<< /Length 71 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Garg^iGoCd.c`?]8EV`b1=.gR0K1l>1K?+0ZOMGdU/Zh'Y!=Te%#&:?HH*JE!<<-b&VU~>
+endstream
+endobj
+10 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 9 0 R
+>>
+endobj
+11 0 obj
+<< /Length 1932 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gb"/l95iQS'SZ;X'jS`aUiKdh/8_9h>bk(t/):nF0_C00,E_8Q;NUhQE(E\_P"#M9etsu?(be-:3$JCZ_`Mqc>[:&o5M\#SKG,8Le(Mh:Z4ZX)k)Xa1SbQM&`06PrDn>H;H8/.NcfKj>VI;H@"l\<rEjkZ1\h%T!eCB9I[l=8^)-V:'DanG12PUnbT*TZu+X-*)IB2E[8bKmCf:VkJd\-(q+:r3g,!hlASSp?%8&n`alPS%<Vqn&U7BO`0<EeQsTnQ2D6XL*)"F=fN37g]EeYdgVTRi@sXjjYXg+4_4L-BGc#kW6'\EjdSbKa+NI`td%.dls0"S4P`kaBn>p$d71*d=[HZ;e6]iaHFoMre1rA5O_#mSl%s0G4kD73KrUV5)Ed@b+'0.p:t:d2^"*6lZI8H9hE8oI>QNBWjX=el&Vkq<:3n"&L*OkY16N-A9;i%d0\2lWi_CJ7*3W1C&Ir&#oud=_\\&hl?h/Dr3)_]N&O?P/SUuZMqu'b.:L[X;ugVk<Ku/@.&.G*r"s(]nG$r_VJ+eq(,>9AV+F'!<O8PZn=@OQ?2Y<5*qZeY?tXEbn("='07`Ge?V3NcE$');LR'h:^Yqh#]sBp>RH;K5J7!g?(2)'mYK=OI1Q\V\C/aKa*l,UGZ-*F)%/@OmPjV7O_NW9r^/<'XS+%.8RWKh0%3d#XWN?Dd/]`gpRT?jX6n0;c56;CXTdtTnm;$NhGmc5^:UqdeR*-M.5V>&h'(E_UHE"iV1V%r6H>ia[#AMHWiW5jTsE#,G&3`b'^6k+AA6<j\Ub!Ojlps:Is58AFIoFL>9PtW!=Ar2rL!EepZ,=VeuF'W)qU^Km:8)iSIu&,rE%e]gfY/o9j;epo2[^dH_%@B-*q<\8T8d'5gPfUEY>t4(`I7h0kiFXWfoacRUGUfJY##AoHSDB#77m4A(K24c#eb]BF"lc<jY_WfW>FnAT0/#oD(BEOJq\IMZFFt&EpY<h/$WrSI6Dg(A7fb]u"cWAP-Q+m9&=T*-MJskcDi2Kt@d1Mtm"q6Pc_VQ3(#n5TnE^6.tRid0WFd[KWM-eZ-%46W-/lck/k.DFk-ca(6U`EA]E8nN*)AA31,9qXd&rd)/J.gH`a]ECe!Qb_oZ)k%N&E-PutI"#<3IkNM2aJF>Hh';^l<Q4gE@n1+Ki5X-%WDW;J,YoWM[`4_1T&J'<X+;!`noYYOY@V!Nh\LKL%Ru33[+;!b0U<j"^$fA71hYu1LclLlK*btGt`e.V$#R!0n132HaGL5"5OXB[FR3o?>AhPf32`)R#h#W'J.9>9M#oZs<c'a`T3#-*l#QgP<RE0RGBV_>5ZM]s=+8-qK;%tKGTT^T6fktR<%4ntuQ%+qVEc:\!pX)#0"?I,M!UVcZ;.4_Z2su6:Edt:(%cEk6U!Fe`!r[U0i:[g]:3N03QE)\Xr9Q]lcspdCgO2JXjZ/Po[8O;Ge"H^el,Iqgi'RQs#)ll4M\SinGP(14I+H7h%>MS$&.!A#ZItfSVi,BKEqM#IO)j$!;!RXr)WI=s!^-iFZ0jN[O>u$0P\(]uFK[OHZ!7M8SLGFjE;O??A9m'=G"i[O>3/1b1u`(&L@1:L1)C&pSNE74F^&EJ.!D[IBi<VGqU%_;"F>*!U>Ba^+TZdG5[PmU]aa[W&Ek+Tk^`PSR>A*6FS=k-]/FSG*B5$.=V(l2^^B2k(dPUm%nt/U/QFs*WH)Fu(,#4n"m#n!kS1n$]1[g1Oo6u:907sgoEBf;#+8j`:a;e8cGnR%b^#08_'%+2,U465lA'i$>Di2&)`5?kY^o'cP)O4e/!t<u@"H,C1jTa"=T\g'Sre#[K3RGSN7!Ug!ooDjI,hG#(5lTWoR[37(eTZ7RH;hY0r3r4']HeG?u_M:HOKZ@<j)cG+RNIDsT9m>J3n-O0Mc_pj8l%BUD";;i".Zgk2chn,QUBo!~>
+endstream
+endobj
+12 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 11 0 R
+/Annots 13 0 R
+>>
+endobj
+13 0 obj
+[
+14 0 R
+16 0 R
+18 0 R
+20 0 R
+22 0 R
+24 0 R
+26 0 R
+28 0 R
+30 0 R
+32 0 R
+34 0 R
+36 0 R
+38 0 R
+40 0 R
+42 0 R
+44 0 R
+46 0 R
+48 0 R
+50 0 R
+52 0 R
+54 0 R
+56 0 R
+58 0 R
+60 0 R
+62 0 R
+64 0 R
+66 0 R
+68 0 R
+70 0 R
+72 0 R
+74 0 R
+76 0 R
+78 0 R
+80 0 R
+82 0 R
+84 0 R
+86 0 R
+88 0 R
+90 0 R
+92 0 R
+94 0 R
+96 0 R
+98 0 R
+100 0 R
+102 0 R
+104 0 R
+106 0 R
+108 0 R
+110 0 R
+112 0 R
+114 0 R
+116 0 R
+118 0 R
+]
+endobj
+14 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 655.001 149.98 645.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 15 0 R
+/H /I
+>>
+endobj
+16 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 644.001 179.44 634.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 17 0 R
+/H /I
+>>
+endobj
+18 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 633.001 176.22 623.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 19 0 R
+/H /I
+>>
+endobj
+20 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 622.001 192.88 612.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 21 0 R
+/H /I
+>>
+endobj
+22 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 611.001 254.83 601.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 23 0 R
+/H /I
+>>
+endobj
+24 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 600.001 172.33 590.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 25 0 R
+/H /I
+>>
+endobj
+26 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 589.001 207.43 579.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 27 0 R
+/H /I
+>>
+endobj
+28 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 578.001 204.67 568.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 29 0 R
+/H /I
+>>
+endobj
+30 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 567.001 210.83 557.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 31 0 R
+/H /I
+>>
+endobj
+32 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 556.001 268.43 546.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 33 0 R
+/H /I
+>>
+endobj
+34 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 545.001 211.33 535.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 35 0 R
+/H /I
+>>
+endobj
+36 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 534.001 210.22 524.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 37 0 R
+/H /I
+>>
+endobj
+38 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 523.001 203.56 513.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 39 0 R
+/H /I
+>>
+endobj
+40 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 512.001 314.52 502.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 41 0 R
+/H /I
+>>
+endobj
+42 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 501.001 263.73 491.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 43 0 R
+/H /I
+>>
+endobj
+44 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 490.001 216.88 480.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 45 0 R
+/H /I
+>>
+endobj
+46 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 168.0 479.001 312.72 469.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 47 0 R
+/H /I
+>>
+endobj
+48 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 468.001 178.87 458.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 49 0 R
+/H /I
+>>
+endobj
+50 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 457.001 177.32 447.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 51 0 R
+/H /I
+>>
+endobj
+52 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 446.001 195.83 436.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 53 0 R
+/H /I
+>>
+endobj
+54 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 435.001 193.43 425.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 55 0 R
+/H /I
+>>
+endobj
+56 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 424.001 209.53 414.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 57 0 R
+/H /I
+>>
+endobj
+58 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 413.001 188.43 403.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 59 0 R
+/H /I
+>>
+endobj
+60 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 402.001 203.58 392.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 61 0 R
+/H /I
+>>
+endobj
+62 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 391.001 182.32 381.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 63 0 R
+/H /I
+>>
+endobj
+64 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 380.001 182.32 370.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 65 0 R
+/H /I
+>>
+endobj
+66 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 369.001 198.99 359.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 67 0 R
+/H /I
+>>
+endobj
+68 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 358.001 205.66 348.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 69 0 R
+/H /I
+>>
+endobj
+70 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 347.001 212.3 337.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 71 0 R
+/H /I
+>>
+endobj
+72 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 336.001 188.41 326.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 73 0 R
+/H /I
+>>
+endobj
+74 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 325.001 182.88 315.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 75 0 R
+/H /I
+>>
+endobj
+76 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 314.001 166.1 304.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 77 0 R
+/H /I
+>>
+endobj
+78 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 303.001 235.08 293.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 79 0 R
+/H /I
+>>
+endobj
+80 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 292.001 219.52 282.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 81 0 R
+/H /I
+>>
+endobj
+82 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 281.001 221.76 271.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 83 0 R
+/H /I
+>>
+endobj
+84 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 270.001 223.97 260.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 85 0 R
+/H /I
+>>
+endobj
+86 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 259.001 205.65 249.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 87 0 R
+/H /I
+>>
+endobj
+88 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 248.001 196.2 238.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 89 0 R
+/H /I
+>>
+endobj
+90 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 237.001 230.61 227.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 91 0 R
+/H /I
+>>
+endobj
+92 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 226.001 221.74 216.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 93 0 R
+/H /I
+>>
+endobj
+94 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 215.001 216.21 205.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 95 0 R
+/H /I
+>>
+endobj
+96 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 204.001 199.55 194.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 97 0 R
+/H /I
+>>
+endobj
+98 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 193.001 233.05 183.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 99 0 R
+/H /I
+>>
+endobj
+100 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 182.001 212.32 172.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 101 0 R
+/H /I
+>>
+endobj
+102 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 171.001 205.08 161.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 103 0 R
+/H /I
+>>
+endobj
+104 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 160.001 160.56 150.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 105 0 R
+/H /I
+>>
+endobj
+106 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 149.001 227.31 139.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 107 0 R
+/H /I
+>>
+endobj
+108 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 138.001 215.65 128.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 109 0 R
+/H /I
+>>
+endobj
+110 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 127.001 190.09 117.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 111 0 R
+/H /I
+>>
+endobj
+112 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 116.001 192.33 106.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 113 0 R
+/H /I
+>>
+endobj
+114 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 105.001 255.08 95.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 115 0 R
+/H /I
+>>
+endobj
+116 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 94.001 243.42 84.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 117 0 R
+/H /I
+>>
+endobj
+118 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 83.001 233.42 73.001 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 119 0 R
+/H /I
+>>
+endobj
+120 0 obj
+<< /Length 536 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gb"/i:JZTs(rl#lMOr%8J@25'i96md1V7>IMt)=%=\')JC`:(%/RZ[I-5ql2pkHsFDg=quGoh2Lk-6_#3$R"m-r(eA[LPT**s<0jMNUes8/+:]gW@^gRj+2>;kHJT@_Kt-U@(Z%4g)*f.]G177[]i7Q]/?n"9JWCM^W'>R@L!5'OUK]Ds@rKlh?B2h6aN!nM-A?Y8mlSkkDD-(sE=!@[e*XR;CZcXAlV[gq7q0^GM>jN-u4%5X5R'k'5P)1:2L*ZXV#%<.nc=!tZ$j8'\!Pc>L4<+Tgure)p:'\Ld#OP35F2Khj#-Xau"Q^6CYWnCIf02KR0dkJD<Hh2/I/fI]TD$?S[m"4_N./ZjW>;c"Zu0(V"C$P3lr%g3.Of%DPo*a,a*)?II35X7TlMjUq+o!saI7:+Pf]?B.h55)R=J:RV4]d4EZP3P/Q*nqblg)i'A0Lr3QXJo)GFY9514P3A**dY]TU>XMV<5?095]EPt<N0H0VKT^fZ-P=CG^Y0hro!A(0&U5Hf=CBQ2ucf@d4=jD!)r~>
+endstream
+endobj
+121 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 120 0 R
+/Annots 122 0 R
+>>
+endobj
+122 0 obj
+[
+123 0 R
+125 0 R
+127 0 R
+129 0 R
+131 0 R
+133 0 R
+135 0 R
+137 0 R
+]
+endobj
+123 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 719.0 223.88 709.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 124 0 R
+/H /I
+>>
+endobj
+125 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 708.0 193.43 698.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 126 0 R
+/H /I
+>>
+endobj
+127 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 697.0 223.42 687.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 128 0 R
+/H /I
+>>
+endobj
+129 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 686.0 222.31 676.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 130 0 R
+/H /I
+>>
+endobj
+131 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 675.0 177.22 665.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 132 0 R
+/H /I
+>>
+endobj
+133 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 664.0 210.93 654.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 134 0 R
+/H /I
+>>
+endobj
+135 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 144.0 653.0 177.33 643.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 136 0 R
+/H /I
+>>
+endobj
+137 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 642.0 155.55 632.0 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A 138 0 R
+/H /I
+>>
+endobj
+139 0 obj
+<< /Length 566 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat$u9lHOU&A@ZcHqY#iq(N#UOh+G;8gJG7H>pN,ee/A?2Oj^DcGFI8P:C:b`Uc314ruMoDj,+OK&hmAF[92rUngX=P2_gj.]4`SF[J0i8:)W.2\-+WODmjAOnL.X99Q.8K=i]^bKg1ON+Q(rP1kPs\)].p3SrP!">DO"K3Y*ff)*8<K9\p@5X9@Fi-r,/$VW;A]qI^$fn@jP]iE85<Eh.PlS:*eBt+!06%]>24n=t,IC_><<,#j52s!>!%ZCW>1S1gn)`A@/IKFT=n/BA%?4,Gc>o(/?<N;cAC"Y=;]u[1b+iZ\[-*'#-ni@9XM(2ZW:tBGB1etV$qgNqC6PmZ.+C'kMSH<buTnp/A1E<Ir[NM+^2uTds'4(6Y%*Wm!J<1DFeM$kJJXV??KDg\Gl[NF?rsOe"<>AH`YtN!>>7<5\0^SHSO3$oD=`:q!>n>Lps5G6O299@2<gVjr_\!*^38N6oUfPq$7r+H?\ot0njnVgO$tlkphu;X8]hNsZn(+4J<T64cCcSD<1-eh0R,#/T8)3%^T71^ZSmo-ei9jn.^Q\@OrrQ'q2g>~>
+endstream
+endobj
+140 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 139 0 R
+>>
+endobj
+141 0 obj
+<< /Length 1955 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm<968iG&AJ$Cn5a0k7ehH)<\&;?*@GjIng$"c%kn/Y(fLPFP#@iXh^&:8$]26\2T#oG_0p`6//Ga%>eI`V*'Y]_)E<Z*L$Pfn4NE0%EtY+T:7PoA%MNK[FoK%DDeRZTq8Tu9PD!JGS&N[L7r8$MfgrAao7i1oNUrLCpg)Ql8J8t4%9n;r&N<CKrju33U1T$WjEN<TK4I*ZA&NpkdO7pYM[cl+K@'9^kZg`g@Zm!:1TY`BQ\\nP3g]c,eUs:b`/GeK,`H3ed)4,Qq\NN/PCWH-Oj)&%V.NiWr/%S=:X+VPBNg96\6P*;k#0_%(#N$qgTn,Y$Kf5W04B90'SjGd@]S<K6IEu8UN<]rp56H.?0CdEf9N$J(a)E.o>JsP_'q6,(SfN-qP(a)tAk.J!<oQ<g3,X&4)U.^9:eP#'AEo[,pjp,"-E=,%#!GY<+)'_0ur-,]cXIRar'bl3'AshpC'ge-rgffncJu=$e*B)KfAh%C=+Ai![Ouo.8*Bmf]tlE21d5]@a@!LHA(!E,`$>$nBZ+=>d0:,e1Ht9D%\2HQaVBOP7]mKOfIi1u>U9hXLirD'-s-@D"P03Ou5b$O[m-[_?(b`r#Ue(ekMe^u)LFD-6<j6XcNPE]">;(`<2Y[D7F^lWikBbF7/&2CoD6+f!V2@i0A-eMB#1Cg*XCP&(AQkla$E_2otbm9-\\As"8CSEcVASA$H^3lSTCPmu'oK$&'m!oLco\Z/\j]T<h2cL["MRI]Qq1%><LA5*(,fu"NB?-T$SQk.qQd<5=gZc:?!+#RBhjJ)lsSdkRZ21*?)Nqng_6V1,(d9=6uIL,TrbJ#M+aFj89>@]C$<KF>>l^H]LFi*s:7m$p5V?^Kch#jFma1uB^Si7TUn`D3p?L4rbB0bK!6dp'i#]raScBc?3AB76gZ7ZUjG/V(;[Gn+0N[)t<4s0n1(S+*3,AEmT=O'u17iW1q4(QWFY-#8UV.u\fhd/DO-^*Q3f/PY%^4Vt`Le?hj'[o%bZ4n'_,A]i-3hMNim)IDJH+*-^/P,rS+.=]QVE$Di>6aGcaq;R[gZ3<S*Qo1Oc(Su![K'B($WTjEe;!CObedP(BsVib4Sic'%N?p[n\p:s'0N&cAipa<>h&XY.PiCZ`+33gq?[J$.IM'1@uXd/S@EP?a.f^/CsNd+Yc+]`1]bV29(K)JEV7=Z[2$Jcqb@;s_.JCbFc0Ykqjbd(%%s&#T'asoS.("&Gc<7rXietbCDQu._d?c!56Al7jk)4T_4XGkh\ojG1%EZNU-8F74`ZGDh`a6:^#`g`Wksa+m/$^P@6b&Q1Xs*g_il<QG!8K1'@;3d?'c$aQXP=)j\kH-r0P%cg(?S)S-Z[+7!g)LYSZ9u#l2O:$s0#,TB@:;n.L$2niPZu]m>O:E)+slQ>>9"2k0C:rYiBY41nM^SQLqTo[@p1U4j>5mtVa=P:;-V.TV#&U\'0<S5AKKUkq1<BC]q(mLaPGK1FOpTgh^Wqa8Io/',oHBU?58WAA;caRiCDgU>BJQr-,s`"k'Bn0eLNWk9*IH`,hjTbUL)2#h[tjnu[K_7eG@qMVr"M%)3]XEJn>'#8D4,+mej]]3gX[__^2^5##Pap('S:qUV44]MlWFq*<6pJ`eRcbZs;$n'mk%^YBY4FJtR&P3!Ib8YP=<N>Pj<H2>f8Hn_gB`B[?`9@!;E`UdgIe;`$ECJQ'59l$G6*EMO;4"^j57m&5MPA?)8C@9gfT/gG5["=[nrM"RFmm$iL3:\3fUg]2Altlpk1JX<79cr6^?+7,k7d6<H59A2Iauj\MTk_V,B0HH60%U&"r,]CA=@!P%8ioEC3,3iI>1s=(Cj=K$.ib<bcmOqB\+3AYar<k(Cg=1&'=U!6^"1:^)]8JTfbkNo#dMJlJ:k#r49E5><U.Z7?H+5oTe5LY)&*KcKaDMMsJ@PO)[^BdJnqA!ZbD(6np^7mWun4^Bp-%E<~>
+endstream
+endobj
+142 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 141 0 R
+>>
+endobj
+143 0 obj
+<< /Length 1080 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GasIgh/Ac:&:`#5_.+uI*oE&BG$:_;RaapqC"n7B-F"J*C7@WXYFiX]cRE^1V7JbVj*)S/qk;YiIZ1o^6XfBtou?_9S&"Xg?f5K=o"E7C:nB"?d<NFpSd"5-.SAd8pX^q0CYQc8I''8?B<r^#"DJpO/..>AE?t;82GAi9G8684^b!gt`EE&g=dGb+kBd$uq"XJIr6X',WG=gHLegZt're9Fhcj8MW*E:i\4D1B"Ie^UR4f5\X)]J:7Iql8'5a0Ve$$CcN]KbbiC6,=h">lt+;+/Xf;.Z,!f=<Qk`T%6ab:k63e>.ecn]u0=[mRObCrkkg9`6U&>nbe3Kn-i,a&+58IGANK%ZtKf?pTSeufKJA3+.42qV0>Unfk"JT@f)6iS`?B),@oF<^Z2/(%'++NfD,4:T?@!gkMfWTlt1^sMb,fl[=iYlMTM9^)@VR$rssSs^JL1r$897kP*]<RlY]MHfq1bEqnLG3T7"b!$Zc3!rKH\LH>Ob;b>U&A':TPEP;'pEo!)n1urb-f:V.C5a=t=B!CAVMM0j#t1X5L9AUcS;*4MXmFVQN&87&8mI$.nr@1-*;qB,A7HBF$4omhV$C^bYHJsHlcJUpZHS/4bT<7Z5%4^Vk[Df`A9D(>4L9"o\f6/iEJi0Jpr(E3-Pkbt8YC*V)6M#jOs\;bLUR+'E7:3*9Yr#<O1gtWZ'DWrQ9\CA/HP2la,;,`LVaBPWrO@ImamAZV7%6;NZbb/Yu1ZZgLQ(+]eB_k%)b_FVTmJY,g2/5hQH2j7%p6bED!25*64==^XMqeCNL/uD,'Uri4<F[Gd7?JPP'm_bQEAU1XjnqBu4C.aL43?1&f(eJl,!uCP>CpM[fM"qJ\,0dKmel-aL$"]qpedW*7Id$:F.L<fdDub8CPNXQ8_A(tJQeRe)7kg`Ck%S[oAY31:4nqVGQ_>YAAk]-[+P@De@'q:.jrC'VXL[<173F->!i#(*oq>fs0qT0P&(X$un!R<S&-(a)e4?kIH.WXi`IjcGbfa^$0'L)T::VQ:0AVHYJi'<;372fSsU/'l:M_*c#"AokX2P9I\l8)R%eir)-TQ1!C>;(2u~>
+endstream
+endobj
+144 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 143 0 R
+>>
+endobj
+145 0 obj
+<< /Length 2312 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gasar968lH%)2U?kZ2?9B(^W6Q=T8P3bd&$Ro@dg/9+a-oSO]5gg=Dd!(B_bNFS#^LlVZEJfshcIXSa&q(?XaOJQ[L*0++'F1Uo^=8mM@i\T2Cdu;7SiZ&m"n*;o4hG8NDiS=9$_Qq\9@cuHX[f"1mSVFdk7!l4$Id\UI^2X'k%_ol^/k^duc"bQA7Ec3>R.4J2f=^)0PY\#h[CsM<'Bf4%cO4_,KoKt_nIju^kEC-6MtA9ulC+?"m`g)XZURDU`&ou2Omg9A5Bar2EHbq)YujN][nj'8n#SCj!Z&?ZkhL:_(T5M%5MZ:^Moj!<ir-[5rLi4gB`kPrJr_6$OlNum(a)cE4,.j0d,k'Q%-U#H/U<aq,8dNfR)a3Frb/m:$5mtWMK.M[Dlbp+lu1=7-7+q/QM!<Acs(-fMYF-'_U:Ab7JLutacg6l@(=3o'1=<_8AD0?X=';]JT)W#SRe'4VNY]pU9$DuLYgBR66)@W^fc:FZ]lFFj3/]]WT\!(Jbd=:HCH"$u>HUR4c&%To='7maToB(i:,B]7[*1t6-2u@S$P;Orr"?,dPjBS$,H]I[#/[tiY:2ST:)FS3fFRqfdIRAF:+b([[B!IXD`Dh!OA,n'=A@ggV(@#iMQ%=FU`Ls7E==*f>4]0NWbG:os7ae,b]GHtY?6^]$9INF%>,hb?a*al[^k[g1V*UE"JaF+hq2eD-+:ot9`i0nJ+*`PBfkB3Tjp_@s3hGJnp?cPIk(%1C<oLUB?b@JK`@nJg-(JOLl<Mq'+#f;:FW4G@nVrMqMAfWi.#Ms_.(Z8l2;_)X\S;*WE&q?1MtYA&\Num_)0qGCVF0N2Zf/NAODYRf4"K!BXh;&`Ce598;93#<UUQ<*(_["u>!RgNp)?E,l9)3c%-\UGRFac3oeLn@ZTAZOWCnsLL$Gtg1Tu/`'K4UfOA(ts`nPM$DtcW`#&>XaHDr``_Ul=acuB)c].hI/2WnR/8HBsjD$Ie%Lk7++m!/XE,QVs"A1&IF\[19[6G.gM]YUs4aJ\QEd&4LfGL+^7+S8g4VgFsN?fXeLQ/BolMnmM<(a@9d//096j5oFN":rD*E0WY,,F.8u`,@EX`/CW1?Y<,u-=XH:=:c^L--"\DFbW,q0X)](a)=q`fK)2.KH%4t"Z-`mG/2%*^Q;gN>u;JS/j<hb-8HI8E;Ni#P=:d'+I[]s)dDR_Yk^mbB/88R\3nZkN6fGfB]o9)jp@>:<C:-2!qQC&fZZboK-+0'V!=`Z&Vc`&a/6"$1ede>j5ICV#9X^Uh=$\oAi/[T41k[S?:?,M`E@jR"iP_$"9Begm0phloOeX,ZY0T"%Hn?F-Tl',aUp[F;3TmOM<90*@$,sf7aNl7$0-7B#@2mW"hgsommqR1b3%rgP@<(oMn%$Jf'UA;f=l\s6%pWL8m7j`,BU<=pe:FRX3(`eht\QB!Pm]dEa%jXH"ckE1dgGMd5ZTJ[Z=_8r`Yl$%t;(j<q@X88Vbd,IDOo]B0!?f\G%J'[>KRr32?>LR.$-U!F6l:^MV7c>(#@JBuE9bN&jAPnm"HF;l;dT-/Y%a9R[TpP*jAR\:F`MMLSNGjXapD9>qBEE/]2*2!&'iZWSDt_G6e8FK$Q[H=;h1NHFKIYcnB:n9=9c.7ncTMA3!d)fTNHC,iWQ7J-JCm_4;gF*2X4%o/-:0ZUqN?21p\/SAcT6i$X;on-6soX:`/X-;j//_ch0\Peb=kkrdCuEX-]TD/39j?0t`mFTgE'$0e^HH4ETV.]Dnu_P(PSI_iABNP,IZY0p8AedmP'9C?pSQU.?^C+F0Y#0lgXaPIa;N#U4HL/aGo`J*UlILrgd.)1Z6^!t[l[XUUHP]f[*M%A5H8]j\a%_r*$<hp>]rR35>c,7i#pnN[J>/AjUQ^nL&U;e>$h&k'482If0[Lb2.4YC!!q8V7Y(U0])ol5^k`p,\cg.:M;B30%eql?UKA8KKlp3Wp;Rn:>*Ljli])eg>N!gj&X0VQ!r3+2P#f#On;n0O'M$($W)43XDml,A+0@>Sa[:L2*_M/mk4OJ0H`(nT0q!>aP=?2L0Qk$:.,_].>YD+)j.CKA0q&*0Gc=G9AHg!'EME,^f+?<*M4j5M["uXWZo_8G>MR,p5#'!Oll@NRe.&Ed^?WNpOeR&uIN-QbI=s:s&"STl4q=ndQVC08'>>LRL.$QE,mV!;pA['%t)ieqFF+L/1fN'$L"hb6Ed/:;QuQEC;\a-CVJ"^etnc`O7m=Y:^(W[o!p)F!L?aii$2o='sq$--NM<P,DTWH.@(LCZ*M.lHcN_L[@@KOb2D//!Y2+@?u:9s3i8J1]@o?X\%d~>
+endstream
+endobj
+146 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 145 0 R
+>>
+endobj
+147 0 obj
+<< /Length 365 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Garo>9i$Er&;KZOMVa"RCZu'G*]MK!#GVSanPGQ$@L=Lt'E>`L@2Eq*>UD7jpN`[-6fq\3V'r-mU.fnJQ!T9FM\(SY/4M'5M*tL+T)IFd['"9Rd+Ees5_*fA`u3dK!Uae`*:;7kDIU)C#6B-:g&75#0Tr:@a+-;\j=V.tD$O(obYmc018[2a$`B-\oc;U.=8sh1Z*hF$BHuXbjGT!!N^e/qYOm%fXiW^q`!M><7L9k)VR?1lR0!$#p._VL\cPgg7b+`sn2Bl%It)Wfku\38OdL1SZ4;uiT"Msc$1`0EMe*Yq,2E:<+sGo]qQXhZ:=XL;P`F#L`-uAOoTtDs+T*F&JT/b;>t.6+"E>4R!G(i*Y5~>
+endstream
+endobj
+148 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 147 0 R
+>>
+endobj
+149 0 obj
+<< /Length 462 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GarVKb>,r/&A70VHn802r.pR/8.-D6;2#]ZLdPjb_'4_gS[=Wba*kb7V93@^1:*2#lm.Xpmj/Q#bq_l]<Q%EGEPhXkM,9(%8Wo%[EMc95PF'*;/?6Q&SMlJ>,-N8A3&G#"Q-$2FY;m>^OX*]#b`[U$^';4#YkbUS_O22D-8'I0+p@";IOT4]Kqb(G$4@,c#>7IU_7J.^5hE[S?t&>$=(%.FD5V1JXd]q`h5lR;pZY!=S*<"f?3.VGhKR]i*(<!WXbEXQ[_j5hWOBi9S.3e)%R5AhT$Fu?ACA42\@ug>m2Rn)?oo(eH%Yca<C(=nfV`DK#\Meu)e2+f&37KS#70:h[G]j1(S!n2M(&FR#Dbuc^lC%nb8AO*(Ibadb=F%is%pA5nc*+hkGcsFKD_[_bG3D$/al'TSWq(iReb)-=[c-6,X3(l0pNPtQ`a=DkqsraEI(/WR/R3B9?mJ~>
+endstream
+endobj
+150 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 149 0 R
+>>
+endobj
+151 0 obj
+<< /Length 828 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GatU295iQ=%)1n+kdGRu3(]EHH+.m4JIYn8,2"Tl%]Ub_#3*[>GAI3Vj@:CSNpC.A/gAQ$r:ghgbOt5>NJE<#<2+Ll_ru)0&2lb)HjU^IJ:eOUXV:>:I]!g,JUX?dB7o3"?t3S0#6:I*6:_Ht7p<i37uM,S)q9K1qWiMrWGeU`*Q>!1X[:_$V^tEFeB2.X1:L0K'oli&0etonM*!J"<ENd%Lm)sG@ul0`U4o]BBr,-rQs^b#a;T[[&4'*5mSF#s@$K)<=P=I5+n.5"8ZJ;%i.9eFQc8!+U=6+kVXHmf#rD6J[lsQ!g-+'\*iIR)NZ3RDGV6Do^2nIT=P?60qrApT=kPcmdmp<u:V,H62itqqL?_&oagh\4>a,t[91;hjnQ^ih'YDiIE:#uK@8fl^4MN!(gWe"1/*s4Q+P8@kYVC&:9!Q8[c(#=@\*9rnoG/d/L'\';b;Rq:0#JmYX15lW',R,m!gp7qn:*'nPo`o([oRTZlEsM_#(c,>ROGRV'U8>8r?X4&1#da[JeiD*U69oe>bNr8Tdc<U$.-TPgpiiX]Ahe5.Md;0=O"J&r4S@ZecqV%bs`H6`4ai?%!V+?i4P0p^mWC)3OJm^/@33*DQ&N5iWOpVgk7ahBGWaq=lXkQ]BP-IK1s;^6-Yle%gtGTlJ@-)NZoKEjlA6sj,+hh]Je$6raUZDh<O^k?Du7^(c0ih0@[9NYPTjI@6^:kXW,bQ"F"#FL:AL:i(853l;0E45j`lk=)hf[MU>5OPF-Wk9F`LVY@kW(rtUNa?b]a"2.p`#KgsJVIWi7c2)K*k4)9&Qd+C.#/qA)$$QJUh>\j5F~>
+endstream
+endobj
+152 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 151 0 R
+>>
+endobj
+153 0 obj
+<< /Length 1187 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gau`T966RV&AJ$CE(i;M!K$P&kqn/jViN8e[67oZD)GG*4IkrV0*44=#pY2%R8,(b(a)aV+Pp=j.]Hl"GRm]h<_1C12sY8<M0=kJJZrn.LmJSAQMn,gcA"4r?Q`qQMe-/Ht;*ltao7)%R8YX6[GMN<*^>oQ"fpk-BZNp6A2iM"&oD7di<5*5>#ajXtmc+RoFQ>(?rB:Osk_6]6f3I'a&U\7.oL4O>EpKjP-S#Dehq6H`2P:KiI8`#Q<b1Tus.GH7Do-RCpkr'uSZmK@\*5J$!C1p=D-6)X^AK5R0k'0OZ$F3V5bB"u:j)1jWT\%U$D5$'kaLPp(j`fFG`4?C\>We20;c./DYYW]fA4+Sa*^!)?pjnP(SDS:Q?T^SA>X_piGfXu<aAO_h7Q68+VSR:AlV>fjiDqKc;Nc2"cVfQYq0rm^c\X??Ui&d/A4qGhcP8,X%1_Pn!teDJW\2$IKLX&V\4.#;1jV-Pnfj>5.^((`*R'cV,,3Vm-I\4_+of!6HN/IB%H"c8'?1@WRDMK#Oh;!SqDseDY?"/s-^O5G'al4[C0Qq1[Yt8?'#\J+aS*mt?)$VqF/_KZ&9E^b6G2q:YVrb4f%?D6)Btn6HTHH.Xp-%9,;2MIU,JT9'I&4CHH)m@\2%#6Y*LjRd7hgu,0C;%RI#J;7'!Im(Z=9E*3nY"]S2FFT!4/o&nb.L0?,>uI@esSU>1`AiS/F]J-_:P#uUQ--XeA8pjZjpk71`0,$O.u1>Uk6bYkQLES[04"kNA;&aF&t5U7MIXCtYFp)W%>GdoMB#nuqDmag1X6pa:U<L6\bE!C._L.K=(qUc0M]-$Z`F^DsDCui_5:CeO3C>TH6M=!RJZu=qEAP(\m4`Gk1!8<l6h6l[B$"2C5<AhR_^4q<7J)_(5M3"`2>SQ33Xga0,NF"6WAf/[a^XM;Bb:8,(dCNb#9ac-TAC0[?6pa:sJnC4k*0!W91$g=1WoB3ZkZ_hA;_5Q,@5-%k<3YoC"e<CaRO3!.X1(ZKn^+U5TH+dNN-;9&\@rBYj=VlEH]jO'd:rSb:+4u6lI!Zmon=Jc?'YkOYp#'j1^1Elr?CJsf0Q`u/ICr:>L'n-UQJ,`4S'F^oDTP_@;LQV?IFA'0q[+3Nu,S.hk.KIrDqg!T^(*5mueOR`Ri(7XD[YM'49O=%M;pTqshIDr'!AQGl.ZG4]Tl~>
+endstream
+endobj
+154 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 153 0 R
+>>
+endobj
+155 0 obj
+<< /Length 972 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gasao997d\&AI`dEiPG*\@1EW:2arAV6/I:Wf>_"l+mM/7%76kZO?fIc3l]?+UAC"SG>9'TBG0[J+iE5D'9^'B)0%V[%:pOK'J+B(B\>JcN/tcQ60=\mN-X)k13n_s/&VQKqM=?TGE&s\Nq);Y)R27<pUSfRM:o4Ec*J5;ek*i0m9sH+"#`/Md.on;nP[H/^*d\>&+,.I<3GVEtMfana-Plo(3>F8E^[o'0m/3+]#"(o&CVJ%F%^M@NYl2i_'tB8-B/o9P>N:<.$>IXMTAHdD6CO]nhl<`%ao+3>mh:35G(>qY4Y$I#(38/+Qs^GRbpTfOWa!J!FW(CS'/53Z%rcD:A+H9VJhS=C/Q34ZAPe/W>X,)e#hs6gab)>NFYfX,$m;6j/YGY@2o1,SRIWZqXEW\J0dJ]/5ShJddS-Yfop)6:q"_@1`^OO1i1DMlVL+]beeu)XoGb=Vp()Zf&*>reE!I?=p/HUr.,B`ZrM,LHHAb8'6)G_OjKpg)])#=#J24;=As'#p9]ZWb$>TH@5KO=e(/t!'.+bHkAf/LRAS"A?t<[nfO'Ml?u*ZN>Z[RMOHES9=YQH/\U7.b=$5]k&nt/L5:]OMI+o=,&,EeL*#)aUQ5Q3nq5HX[V!_pN6ad.B43&$19>MjeYm5Z&^lP$*^qI:e1+<&PDclPH`TP0]@cRD=-?5>d_pRg$iq/i[=Qkja&s[jj]1]69g!s\M7i7PfOc+6+kFO,m_'C?WO/8#k8.X;D%@1;@AGKc`Qcu@oVl[im=m`M1/8ZeSV8p;ne>t1B25RP3t]PCZ</gRJ.%itr](chJdn=eM0Lgg;C7!W)[Z#Vo8ml7!N,<''/et,=3%Ue;fl[=jtuH`.^-ORglH/i6[g0h!O$oEXH%jFWhEr!.?pjPeG_:Gjl;)(2KWBhci2Hja%FZ0*uT3T>>VGB@I7YkBD6j^OV2&/e2oSsBWHQ:!n%4s[)N&7D0<,~>
+endstream
+endobj
+156 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 155 0 R
+>>
+endobj
+157 0 obj
+<< /Length 738 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GauHIbDr&G']&?q?7(qVD;tkCQdMUe8falLeBOcs#>>=.9M3BJo(P#F@$2Y,;,q1;?f/a]pR-f`q>AbF=?tku0Q@ZV3>`n1_a"ch!"Tq=3<N\"?5?<l=%i#jK\m2q!K;ti!VHFdC'42:'HV-(YtEfI-rmk-DKXYPZqFNg[Fc$7L>/Iq;QUF]5n6DerX>.](a)tUKS.QiV%;kaDL53bOaQVgnU+]e6qa?9kjjt5ZiUau7i`WXmMgoiGg5g7>Lll@">.l\.)'!@^7],[BZS<_;8K.IQcIT>fr\^FKA<$>Yb0K".+n`]sNB#ct$e'cqQ1.!,FSh4fj&,6lK2&,Crb-sfOPum+IhH:#1<?J:?[!%*--#[qAoAXW.C*Xt3V93P_V,mKY_Ko$9VlWi[Ko@[ss2-jal3tfa`6</[GuTQt9_VOjkh0[I'LP9%&,\@b3iNa=:uIum>JJ@/T38jQA*=hfSrY&Z=4HB`b3<Ld5IikP<LH>E^.<CCb2M_\B5ugd1u9cFdL.8*6n#X!8@ie\gh+]'ZD+=>:L]fk82u?_hE_dfb0o*I<XbJ:-]>$Sh^m))dolE!KgF</cY9IMqdH$@.]NubI6n"A?n)+?I6pUd1YQ^;<MNBMf@opTYF*nkm$?a3U$pqtRDOdPr>DSHL1E3:ISMCLm)D5]1`RVTE;s+Y3coh[s2BtiW:r?Gbo)pJWBfJ@E#ukh8!=bXVI.[8+j\dYLU7FO(`<8S;-Mtc~>
+endstream
+endobj
+158 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 157 0 R
+>>
+endobj
+159 0 obj
+<< /Length 1111 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm:9lJcG&A@sB#e`&TLugS7!\KN%Aq;P^!(GCDl5ge1Fp-H\=-D%phj5$gOcjR\Md>O5;LFunDe@)dO=oDf73WuW:82jDJC.t[,%s.S#n14[,m+Hd;7_\"?/;QP^5fotkspA8&V=VI!?D1HgBF0V+:*"Diiq7YforGqrH/faAiEsH0c#5(lFNtn<;E6,WN=L4?Wrdr:I(K_^mnLk"q9q7gtb\D`eah-"F4&&K*FJ0>]NddOMD@t8S(oT6NT]3C(^k5iXYPK;Dd\%KKFu;('?9V*1tWb"!W!T'np.n"\hQ9:(ZmN)r3MjFjKC+R\"Y`0a=!ZmXUdAF4f`o799a;)58In`G.+,C=TJb]Q%sJMui&$N&PB)d?+_I2j8Me#33@0oL;p?2^guQ%?)UEa=7;rX<,Q*X&TbmqGqH"<i\>]9jWKgl_.7nT4(/o$p-1m,^d[IVIBfGJ;bVGMRerlPZ**7i\5lI3ihh"PF'8TSO+b,&6#bM@0EguC1$4+(%%>+F.G:Q\qO1\DQNai9S./]%)uQc":OmeN!KN;fT>9dNeF$6J2`iZ[6Zo1J#jU42csgd!k28,HEA]'A30?+)"70&D2V7o_2l<h<$osJq=/!UZhT1R;l+WI$YGZA%TVKN;^mHp"A&+Bl%/\tY@]Be,X\*64T7,a692hl`2O:CjcE&t`Ss:`:3:,lARokEkd#0!%@&8.(_=sk@tFr<";!I9kpWu2qQ9YCqHD,[/<L2D,TZ1DVm8lN<<peb@1qL.c`f6`XCG71l6YlbqI_*QIf/n9eG5ugX7gsG?Cu@m:^JQ:O5B0A+0[TZ\dmn+=Zl#MM467YNIs-ea/4`!>e3Y5eDmUk[Je,=(q93p"H<'JT"DJSRi"%CrGnA2c>107P'\4\%PQSW'(D^+s1_[RcJM8%Rm]h%4)G#ds1TESM![uoWGd'@Ful*j[R]Z3n0)0'5q?nim]cDBRs>K[H\6Uq7bsEMD`g28gsD4.c.Ym-7h>KYa-Tr@.'_K^Iq.)P;f-Aq'pRtV_,K*>l%co3%.<3`$76ofP+5F[9c*i>p:]90Ca0_CFpuWoda<C2H1<$uD_t6F3P2K0oZT[(a)\eYchk;\(Mj=eG.bl7~>
+endstream
+endobj
+160 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 159 0 R
+>>
+endobj
+161 0 obj
+<< /Length 288 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GarVI]5GM?%,CLj*1`d^W!=W0%?M!(M?;Lh%RDTa*ZV)8iLk[-3K@Mm#dg+HG<D&#+LVLab+SJI67!o,JjAHgTN$c2*O(l4H4-F#cf2(a)8;ll%.gq\hg/ebO$.)Ok%?8h9ViGJ*HKBsFWGpK-+s$"@X2">nDD@[LRU)^LP+/uN\;B["X,h7osd8,VjpR#":GLrEbF,<+SWN0(p[*j,3_/6[LP$>:fh[GR>Gb9C+`:%fPgVD*<Zs[cRAs=K=i^<(LUQ>rMVn2[(>#OK6UN+cZ6qcT*AL(co~>
+endstream
+endobj
+162 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 161 0 R
+>>
+endobj
+163 0 obj
+<< /Length 1740 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat<AbAQ>unF!IkZ9XPF0e:!1aI]]j'^,U(TNItU\d)E9*MJLXQ/k(,^-e"q8Qh4_$XGa0)9mM_jJUPf\)1nM(a)mlJf[9J=#IY!+_4rhKDKgCrDPXIW94U1pkIMIq7.ekr)I/trAi"-0EWFN_3+ejX_Qt"=FQ+NkDNfR8XP&RgU\L&T1ctBo4$X$\ekl79Hr1@@(](c?pB(R7"+?H/sb/d13H!-f324cQL`[D-&kFWs!b+?TBRI;fO:kU(<o'NPm`9W@N3,-?b"Q>.F4_D3CG\S'$)6aimBU2NJH?#:p_m[#C0E9-Q$e=f>J.'M7=Z9>em*?Th3Cc2k[A;Pl%k]E%2J@)h;N;X5Xk7shhr8TSELf!S]9ksE=@?F>B&X[;3Gr]re8LD;nmLG=5r9?T^TQBeBn=[%R+=78<ds5qF#poqXj0LsBQ/7<lc)9QcE>nD>B$Y.6n)4_MnBkZ_gj"61_uDa#M;SZ(3XEjB!eL+aei'T?:kUHK3T==pb#rgBO0!IO0XEO.$jo@7HmWQ`*P>;&9XQ4$b:C6G583Pc%<',B!$]%JF$B<+OrcBa.e]]7D(bDXZm7s2kk%,PuKY9(,Dd%V+KZN)4o(\(8mI'QOr6b8qP7!a=>l.RDEasAi-/(7q':4?fDq4-jI"ei\TrTkSneFkEgbbj//."O2cqZf>\8&`#m:%EPD^hHo@XaXI[InWF@uFU;X(3'(T3P?4+*j=0r0TH)7iIK26(7(P]r:ZGnk@2/(Y7[4t:AQ1!cF#jHB<gFF:iogJWFfUAtc@A9*6J.7Q*XP@)c&KRUL#_RXWFF%ON*SRB\a[JZ*8r9`-rcKP()$A"^6h?C$_HWA?UH:7M3I[D8FHcC]EkAZsY`I+rIJGFp@VWJ>*K)O'1e'FMcK>?f)Uf/9U'-`*NX&'X?I*m<ju)Akfl?Q@@a=YnZ%a7^m"p7i.De3pjI^"S<V_h:o$$?[`o(LH3l^M/Wcg!naFJO7pkPUMd?saEQok?,(s]9(q[EJ.n)WcJV:U&s-j!JP5"ZU`OuEmeK&J9THC/BaZT8&-Y\C0W0V)&C0JWGgY;(?XNKIu3LE46V2WE<1c9/re+2T]W2QM-lh%*crWV(?Ec&`AGo`3OQa2dm+E,ZBU!NW5\G-j>%2<[eWR%A[3>ROr$Gn'h>1AGi4c=A5Z(nta(1ReH:p48Dqj0@Odr_4CrYMD,%2^N+[$la*1n2%cUp/%*./i1".om\GAktd8I-`=kL9HNM*hLU'Mk;'OaYk6H#3JSt!V#qLB+_oi1%pG>Cc@#>T]P(n&EbK;WQ?RF1(^Mik2>R3OG^MQn\^%5X:Jup<G?nOef3`Un&t@)HlcU5UTpq%JcIQ(_X3o]H#t$7#,!LI_4El2\(kgYOXS<=C<<05+Y5RaI]1l&/4nYf&Z/9E)f)XRn@R"HjbTJ#Q(?jQ>m]_,jG.TeN%<MWn>WA4L?#L]<-T;6%5WU0$-;nkcQ<pL8p-E.R*4h0?Oe,ot:6-R3&^-*3-o6V+kU3.,<+#LeqJk'h`$5OX.&]XeIkKH>,<V9q58%ft)".b(FCF2T;=-V5d,`rig\&l.pUd!?R^ig>2@@@3@%hl.\XVis>,BnIljSF3n2\]U*hK]r-K&P.=EWBP+oO>;kPdGT(KP6_?@'>OKfh")mep#W$?cB;an?]&%\Da"H#mf"A`qbDe`+2iCi%)1l@CBlm5fo#-%k%5YJmEiOAJ[;;7b-oDMS>0iF$F0_Sh?3+#8f/1]~>
+endstream
+endobj
+164 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 163 0 R
+>>
+endobj
+165 0 obj
+<< /Length 167 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gas3+YmLOe&-U@/^LBee>^)B+0(jc2(4qWClqFMK7)Am^H?(nfgC-0]lSGZP!@fYAPlqn$83;O:f<Z.2g*$td0)!o%n.I,0*GmRfVYN&)irFF=C$Ar#ks0Zg3L:p;CVquUk>GAmHjmd3B^GbV?F4huZ(a)+k.?g.kjSh4X~>
+endstream
+endobj
+166 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 165 0 R
+>>
+endobj
+167 0 obj
+<< /Length 1056 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GatU2gQ'uA&:N^lo$f:WE.(<JADc$F.W)#b<.XmDqI"mWQ@_I;ZX*RENcVH=2GgA>6Cs%[bjh+kj^C%Br.TAD"?>sQklc=E$1abg+YUb6H8H*s6j%@Mn:'6-YQLMD^V&)uN=%cNo`P_=!=2a:)IX0i<$Sh6SX$37-#2_iE):tt>@SXVl\VN+o$TR$QQa)aJ.^1FqC*Jh0Z"Y/172Ft3>ENU^i4*=+T`6lE8Obqj;l1dXKNH1!CaAM/C.5![k$c1O\#X05SRQTf&.+P>aS<B5\Z*3UX5t7U#;cQAh&&6/T7p*JcGpn=9k?4]@2=(ASMm5+:aL:b9OJZqZk;>]Y)7lehYUKn0r@fN].TI6c@b<89mC8o$#g&c^aF'6C7+1mN=/U5L(&hRscF:-t=''(t/J<hVB\4"P[JBHK==piJ"]2e;d6YCMp0^U-pV,@%@[klj$HW295P]BueF-1L]"3YnA'W4+uD&:W3?<eXI;XK7On3qD.h#Znh7\cn2@So.8)bE6#:FgTaSO414!U-_8,GO%pS5)VP]-5XA@JH/`C5Lh!R9NDn%KqB,Sd0ZdF*g58,s81dLkFIT<'c(30NSd:Wb7n)3:_@?@a7+V!%lPdm5jiWE'S`kD*D<,kR4fa^`G'M5RZ^K,*!\uY.ll]<r7$0*ufs!>K=]'!H/JXJ+diESo]sDX<>(#T$nXeg$mob&iqq^4Q;L.Y)M$OAaT@nW;_lVp%HDO[K72OV29hF=O("^nNDsVGepbdf6F<lYCDK"NWs(6+Dq)l.+g6B!"mSA/(mj-f9oX`W&6#A<U[Oq#Zi571``XVU_$'jj[Z(?sZ+Ya9#/kFt+\S"@Ic;#W.*V'Jr#K8Ej;&<4&2[@s8PnRV3s/P(W\M]^_bBs!:,#*?WY+G<`**AOPNgbn*Z/A:b*\m\?EaaRmR[^e,glUOoS$tF/Dio]Q24FF?-("Xn([8CAp2SiW#rh%D3P]IrV,/OOm\H<dOOa`Sk`Wel2>LOm2pK">H?shM)+-P:\<ft):EEQSM:C,^b^8rm9rW&>I2>i//fa[Fj^2M+Ku*~>
+endstream
+endobj
+168 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 167 0 R
+>>
+endobj
+169 0 obj
+<< /Length 870 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm:9okbt&A@Zc\97NWf/=J`Tp;ouHDo>Yg7Vc(a)*XFKW.fu\)gSDTuk1^"E)ekRq4dsF():,t;PAe,6Cmg(\m$`B65]^id'<3-0.0e.@49AcCR/YM2q=#@Dfq\AdoY2dg0bI@p$If%e/e!bu!OYaXfJC(Zi`%O:JiHia"X\rL_ZjW)h7bZo3.#(:B*u61'f6QfER_1Je(rGcge!AcPdt1p9nZ7f64n0FS]KD*'PRs&.b:ehAHN/t'kD_aA8lE@hCsmmL4L0a#ERK;`ZdAB@laUfgYXJX#F:4hbDCANLpM>MK8Sb!^(a)pMq#Of!eb+9.GLdruj;XF!"94[jqPQHmg>J3G1leR%)+3ncc=hP!T(takFjZ2.Nc2b*8hZ&i26o*.-A?*%<.N%%j2nNXi,",_TWqpcVFbIah.E?8+Ol_/-&R/K4?5pN6*E.',OSe;1=N1O!C&G$1c'9[NUir"4nN(EE?6E<DUVcjgM^pNM0((R,T&3)`VoHVT/W#9fOo3/';"0\0Bel`fQKJ:)mCMdqaKfVK.f0kRC>mZ_BPd[!CE`?ASg@&51&n/dANeYq,n..qD)DNCVITUGH+5"h[]S9.m3eM\);Q^-mFVN^r4?''k:,sOpXM8`SmkEW7V',W'[$Tg=cAj/U2,E@9c#0+3lASHdT0V^(EKt5L2$6=g>j#M9b,p6<@o-agG<Ne#e#,XCP^NhGO(-iq2Y,9IMG:&PhBlF@l;4>f%]dV9jTPQfMXK^m-&!uL\3UMp+d^+(/INjM2PUA]Ok*Fc64\c3J`$Uf3IH(@@p>$klPh/4/B+ONBbt.ZI4dL.on)jEJEa(Ql-e!N$nYZ;,)X"lITp$[=$I2Ee%FCN^suW5Aj.q70~>
+endstream
+endobj
+170 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 169 0 R
+>>
+endobj
+171 0 obj
+<< /Length 835 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm:bDt:1']&?qhK;rY`_L?jMcO<:WRON\WL[]\V2GaAi$o8+R-F,7FWMe<M$Z]f)uJolgiFROL\kKQrj)tDK@gDp1ipHUL4H%K#VZZ-5WOBZ,p5aocb%4O&TdFL"CF$D!9@eu%6=M$/e-=NOL_;ZCkZ%,EMaNK9VtGCF0NHUoX\78bduO>TlMSg7F@O?mPk2:H'XD8QEe#*(6(DTr304W>ei68AkRk%kW;KohnjN-[1K*JrJJ-,UkmT`VdlaD[hcl:@JhU6K-?uA<jN!iS,jW,p`,m=r77iFVb0r0pS,8g;T,%4A6_%fg4t_0r1&hM!e_+U33,9JbdW?qUoN]2@uqAbl#*;dhYfHn%qYA"RF_<Z(dj@q7],lnXLX^Kjb8gpR5&#N0'"q(3&,T6%dG7hoq15W+q0KGp"[QA=ma.W@dE:SCLd,%_a_*?\Xi.X'J^IDK7=p7FHu)BWL[TfGXp"lYtJ5V%SRqIjiC_+?9>ilhal:7&&cpaM25Nfr$7/B0)%tMl/Z`)3JS+<C1+90`k""QKhQ"sSdi/W"`\BErGT/,W2YrF(M;M(%(j;^e2Y?5@8=VqSZl,e6C4ch?XB]Ujl;kKQE)<^+^V)?n.mAJf[s.JjfCQ*EemN&\Jir5dn\2o`EjF:GGV,V-GuDp([G@oQene=,]1c5$o]@U2kmcu+/2<-<A?LOQuY`2,@up=H:>6GLNVI5?nSK>U;,u#Nmht[LBt4jiZbOZ)WOb_etRIe@GD7h,h4%hmF/$Zl9jk66OF@?lqdR=WUaPqf'*EFSfN7%"c-dJBD96Q,P@]klIUos<WT<+'REL5LissA!Qne2KE~>
+endstream
+endobj
+172 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 171 0 R
+>>
+endobj
+173 0 obj
+<< /Length 680 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat=)9okbt&A@ZcI,#_$HMgKU=`&J`e<R&,?CF$%'9bjW9M1,Pq=f#^"A#cLY.3+r*qO!8hsd"$?bS5t$<)qI1a6TH!@%LDUaRQ\`WBp):pNI'+.ga&:='A@^3c)05^\(e>l[.9#?"L%(t=AL9rFj:b\=Z71KW:>Ju2M;_]G,.Wcn,Ie'-K4HXPRh*OO#qj/PN72GZDje)'(7FVUXR!,L"Zs'\qsIYDlieF*q.=G!UtMj#[9q\9e%VpSK_68;"LlqdchEegPrhr7q<a]+F=SYM^/&6QlN`m9OeEG&Q[[9b:%$fJaaDVa(I1>ChlSM7I_K7["F-0nG:?PgOs&[PNCVQM'oh`<E\rS)5<]Wg)/Kk(_#-I?es[4o\5Mb(F4#!%((OIOF/\$f0<O/g;J`uoIujiJQE7CFkUgl35;F23J"$S^q^IKcPsgJ.AZa1>&K2HW*rX<=[(R(o-HIbVE2!tMD)B,WJ;9XX!?P\LX"H7Edqh:JD`GcC(V\p?0OE\^7Qq-h\'DNV&<cXHE%[B&jPWYtuT6HX;url5m"_GkU6Ve.'s.YbAr(g^"5N;Wu8d&-6ogjLG$@ouZU;0?HN)f<$se;LCjRe-?"e#5Ks>2N8G-deR_VcUj:o418%=qeY#/4u\0d:729kWQrjj">VF*tWlp8BdR?6+&0A!AD*pq#~>
+endstream
+endobj
+174 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 173 0 R
+>>
+endobj
+175 0 obj
+<< /Length 1126 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm:?#Q2d'Re<25^cf,J;\9[0PQa!2Usj2?'h9[eZoFHQkV!#b`K4-pTq\DPCt7n;l%LdptRNpH[RQB_8Qkl+9<mpU1E1ao)Z3<nUhTC^p3ga"+foDdF.l>ISZ;HB`531Y6*fgck-KcVu]./2uEXVJmjY+1!UE$E_a)2b=8'cE'?^HB^(s3i_UCH]gX_e/[:tV9)>V%#QdM!rC1:g[h'dsDJ7Z+54iX3j#/FP>Dig^blj:L#6F%`"2QE/FS:g;6bCDd+hgmo=Dh269<5]rb;@Q%E<_UiQ(L6U%3)l\Z_R&;Sd2oieF4'BYEpdj$^l9,5j1L8?Grois-/D!pO]Mc_a=^>54/R.:E'r56:UhNPFSt$hG8rV*uq3oeep[6Jr,:ifK2j,)cKY+(gftlWP5rq>cm,$qsX-cK,PWaV-1q&N9cI4`Sr`-VV/W&;/NZ<SEi%F,u<469F/t2Vo64]VAF!&'hN6nlVQM#$#`!crg2UGAnHQ@a)UD#oMp_uGR;'VpA(-l0i(lkDPmgWLEUVugAlNJjpIjq[[A_E_]Ca\11>pDf-[oH(/.d#naNdHRfnJRQfC$9>V1m95L9W#fPh*mo.!F&,?/O,?KI>s>dpGplLi3mKlS'p!GZ!fW8Y*%(Tc,rWV@cn.E?_B@D&tjgfC7c(F"tV^"&f4qKt1Ab29?b/8GL.&9r).Dke5?2Nb*X$X5Z.YKZD%K;Q(Ok<>7F4,</-^9m?^^^jWGs2>nVj6arB&pt+L\,TXehqfAI&ILi92O>C(AJ0#<:i*nm97oW\"bOZWnpRk#@aWRcd0cHd``f,%C!o(W@BAX[l4%Jq&4-b+GK*4rD5i?6qDD75U>QGRq,.rnP"(?5S+HRC%d:U\7'F)q=pqO`FL,_UC)td?pd,MKO;$o4kXpHZnGuVS)M)L[fBqbt8SZ1d@7n:PUG)>kkV9@b^>Id;j%2c0SF,Nd:!4>?]H0kg2`9#IkW'%RmJ2!I;$0:Oalqu6$\H;/4B&$0@le+jO^jn,/2!!i$+`OORkt8lfEm99:lHF[rN,@im_&/hmbC^n%10g9Y]"\)%K=r=FENP`@7r^0E\/`UR?\20$ne=2K>%`__/o#1-`.S4X8'J1_88I,r!1RU^>f~>
+endstream
+endobj
+176 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 175 0 R
+>>
+endobj
+177 0 obj
+<< /Length 235 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gas3,\I-2=&-h'AT41DE1@FLkfsF's/-KrSYm@q'J7jh6Dsugb)j+i`k4iQR`FPis(mP21$42&F+Cc"f64#1p]$u<r_KqG2[c,Y6k>Q@;6_]r&ZXdINWg\:^p2=HnJ=f?\!m,[.aYu_iD59oMC[/UPq%Rd-ah>4Xn%1_@"tc2pbF%PpV-&VSs*2\#jNPV<LVu?c$[!k]U99F;D`0JOs/K7#SCnV$5Z7<@?HLY`@K~>
+endstream
+endobj
+178 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 177 0 R
+>>
+endobj
+179 0 obj
+<< /Length 901 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm:>Aoub'RnB3YV^'02W<?/2Ge+O;RLk=Zq=8l]o5*N@T"NS)4.K$pG:r@';4E[MA5m=rd;G$k@V@&pr*HiJ]%`HBSF6NK`R?$$lf<\i#[M'B4-&d5HjL-K33b5@/Eru(r/[KOJ!)68\MrG!Z`4=Ln0@'.ZLcV%4oB]j"$`57n^<8MGmC9NBf.l//Rj5J=aGRSrNmGI%32\%YcTNq0WRe4R4/FiBsAW$9@5XjPc>h_/k\-`bJbT"qcYO)4B<t0H/mU*T9oX@#H7@hqMBMV&#h.,eINJ4C\dTcY4HUjSS3bdS`*XEM1?+Ps.re"8PHK<2+VoCZA#V#c-66\]uQ)kN(a)Y\%UEj`.qOhTe0j9!(&onFr]FhH21m\$cE]>_#4!O8nX*_?4hPHj1'0'4O`Cd`EuP=mU'UAc=IT%B=+-<BL^<BuY>ni64L#>9lo"(rSqFp80bS2p<YS-[`K519`?-pn2V1Tiq1B%>+0]Og[]F2#q?I'PHjXnR^90nS4UpKi19.%I'rON`>t`:HO0K.4l!0SIfL-QA?iDNR%$DkDK2PgRVlf=U[g3G]4)O&C`eLUTTr1%RLb^`.lpYV'8QK#ElO)2jeYEsjZSB'mWZV,2"jY>EpVm6cCVk>@H]GY<I&o\Wbd0Gr^IW'e&JI]W5X\dT\PN<,ImI1or,lhaR^<nFDKs5lCqDik-l;KKX/6>-8O>N@=dLD+5&8Lahqot#Pk9V;GWU31SJ_"`]-rh!?L2#."mLB#nDtuNkc^bAE*3RandC#2G.qi.6STQ6O/GFdfVtG!%^#UZ]gT'r'QQdsH:";DA<74!5K%+JeGIEa_aKe/FiP3a[];X;LQT12eFODO[752%$P9GSYAUf3(M*u`-gu2(D)l4hYi1\PL(g@_rWacT2_+~>
+endstream
+endobj
+180 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 179 0 R
+>>
+endobj
+181 0 obj
+<< /Length 301 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GarnQb>,r/&A7ljp/iTmqJC;U6k<N6P&H//PAEif8\h`kpj8/^Q(n]IbO!O@Nd!C4Xg\Y57dh(FQ>tP3!IT7rUt;QH"7%u(HNW4/?<0kP44X.G"0W7WMpuIJc@V<&Kb1T_8EndSpT.Y=%1%uAZFS0c3Ai@SBXPE,\<CMK=#!Q$W6\c;BL1gjQqLH"IPJCj%s?+Ggm29@Q;XGhZ!\uiqC22\kk\!;YS`CKo8cnZpg]eL)P"![#jglIlKM8\$l[J?bX[m'>5$/uiEBp8m/PR@U/P<US?]$K3B/IFjY'=;CSU~>
+endstream
+endobj
+182 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 181 0 R
+>>
+endobj
+183 0 obj
+<< /Length 973 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gau0BheUt#&:Vr4@2Nee/=IhWQ;t@[au\`oKi,1CAIjYCV]L\c.EZ?#f2&gi>B]!eK+5RdkPLtAmaI_EU=$SK^5!Q@Tbf""kcI=qKB>NB_Z4u`V]ZDH(N$hRj*S%n'CU\mI5Y-U6dR4uUS@k,KcgXU?p:SA`-Rup6Ha)+/"*QGBtj?k@m0@ZQkmj)3QA/Rc)gcE&W*SlVqFh'/=)8@:E7VkBqm\7AQVbNT(O+q+V6tepb*glH#;POWLY3)J,fb<aho:Nii0BFVd[Ft%)`,LGT]N-$%aO2Hq_+XoO1tb-%I;ufD/IFGp_+%BU:p+(CipUM9?F]NV->Q_+[Zt!TgC<SuL7h,;WVkOtja$,"4AUXo12`hA=`1LK`5^@LPfc]28B=84hDWH?;,V1NeF<4g]3&F,+YACnMA/O/^%PX\e/oBW2sQ429lqKAG05_$0<OC;@1`faH]FQrT4R?k=5sNu`7#d`SaDBd9RqqGHIb`8[fk/iHd[QZPQ3AXk*H>eY'u7B6qUiefmY5Y8XjfniaBYEV"g&s0bjF,DC(S@3K`&a9RVNl<_IFm36]ZY9dJCYKBL)++U)a(-DR$`P,/Xn-B%cNr7e,RJ]/\82[SN'gp[E@45IAuu@,("2NX*:2@,D27n`B@3qEa@Ee!<Ees?E)I9]:5atB,QE2a*!LNr.pN."4^FYj9/G[b#Va1I^pd*KZX#Z;pWTike)V/PnF6f=+"q1\h.a8MqkBVk@aV:?,mLul1(`R]pSXd3[ESB'[@C#"NAD"7ID[a@#O[(7=FY8-U<aM8J.d/hem?$Kbe5&k*&_^RDAi/0/nJgQh'Rt=`bplUQuW`NqbXfK1HA\oCoC'bI?)Oo33k\4(PgtZYXg#9S%-Pt71^Pt&kckFe=ds^D;'W)%mr;-'C[,,4i2%mqGf[>90H=g+?WQ)Tiii/-)7Z=S#EA)&E'22X'\DpGFL#u!+LLhgk>S-3qS@8~>
+endstream
+endobj
+184 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 183 0 R
+>>
+endobj
+185 0 obj
+<< /Length 605 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat$ua_oie&A@B[GYATZ\W]'$LiXuk!_%cKg)apqE`?/8/(820pE_9-g60O20'$^&/8sD75"e(&;Lg&=$=lSW^b3G'q%!R!+9EbK:^IW;$N.F0W[i,uIY$jl7ra'AGOV8,!%,N)'S2G,(/Zp.X:!^LE`]I2k-rIg/Q`T+*,g9=,5^,iG<PZOb#Gf0pNQA5#LL53i2ZNuRqlZF]ud/lr#aTZ.D9/"6V['uQ$fbcM4m7A='p(+fF)4Thj?IITYR:U4Ip8c?S7^fSjp[ULd3N4#NU".0UbG'BGTRbR`.$BkE)UI"l(uI;e9\[fp*2I*&CAu]cGqDlhr9VlMXmidPrD3#s,9O%IGi,"l/cL3nU`]Ah[+qLWV;D=r>S5Wl&8L^c>Z\N%#5k=)FK=k*S*h_3MH8>Ri)CS?Nbg;>dARWVfQ4@8!*]a6goF0'sG+X[5\((!V)29:U1:0"5GgNHJ+n.*#mG0SWiG4tO.VJp"(q1e2Q(1hNi45g)Jt.PSe7r)[&oTjljCY?u;`8$2N\e5)o&7Ga@mVqrteS<pJ*P!A=A*;sDM9YfX*q,:cgOaKgiZ`0^-OM9u2^C3(QQ[l0\8najf+-han7f~>
+endstream
+endobj
+186 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 185 0 R
+>>
+endobj
+187 0 obj
+<< /Length 1273 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%#hf%7-&:X@\+lm'QJ;Fpg8tlB'5gj3S6ee<8gHEc-?t@F2.Z5?:,u+F9;C!Pd[N)a^&EHSKhKR$/IcPCSq"aYDJ/LTt=I"dmfIgPCW?2sf#XgtI-\/!aYhB?^/Dnl=]+4fL<duNu,_2"<TSs'WLjDK^&BJ<o/=n?%$VN*S[;A80n/j1AFV(:C5IarCPW@uH5nC(2jc2?Peho+ZXE`cI]_&qM5HQa1glYYfGh6bDD'/Q8H/:j'2[kY=BBMV-+<ZdUr=(=]+&0Bf:\,N8OM]M7]ROfErB/fpVf%<6'-R?SoKn<""Y`!J+c]<8=>(bq:nabK8c812Xfn;nK?]8gNH>pZNm[Cq^\mAu(!q@WR-[4^0f;OcJ0`Ib-+@@<m9(Yk6a@-]$,l,rbX7E]7p:,<I49X::^KGgVm3d97t7,[H$X;2nu8Ui/,E(hRRUB#aCFZ.X(jQN)ph%#3U<<t1-FH'!md7[;>OaqprI:Qp,+P&<kHL)f)la;Crq?/q4H?8H5U9YL-LY7.pe;3-QEFi*[esu(PcC8=3LELXK/AS*]9.JMLkh%VC3cR5L"PVG^aH1/lEVJ(r1flj1hk-&CnU=[0o\DpV.:]*a#<uL+tsY*P82QS^D2DCaZWbl(h(a)!Sb+;-m!5T$j_7Cs=^f3O.Cp`O3p"7n&'`1qiLFKpE/HlnO0@DfGkLolf@O#L#j9kRjXqEH>^Xsf,IurF9k@*C:Lto1&KJoP>^6QY8W-A>*&t]Q.Wr'2=BSZn`L>d(39?]oGC)BeeF**q%u5K1DsNj/"kQlo6=@Z"0GAf'',UP[.s>6C@<,7qrFBl1$;OX@gdo+PgGk*V#'8hsr\N@PC9Ph+N%"id-3+LU_cj<91"B!M/X&9Qb._"&Vd1tQd5-bd:Qu]q&rl6h=+BK&d!A&P^TeN.H`uRMJcm?DK[m&']U<,*7SL7c>PZ>4nqIK;]qK]"26AWFS$:Q@ZP4_MqYE#mN-cPEl(hk.;3el9021kfY:)^j@K$Lk^\8X]9VLP+JQIh>Jj%Z=p`o_GXAi%I5`/qP:"*&1k)frfQ@eSG1o['SHL-cX\N:)u\RP[SJpZ^a]ZA=oO4s`<C,IcLHE\IKo0c#LF_/0X<?!jL%IVD;4_oDLeKUA2g=hPQ/T9;'qLCS*n_(VE<r6=S`T6!S=^q=&W?Nbf0#&5)[@%GG=YN!4BK^A6^65%io?3gp<>mS8V\&8tMuV'%#5VTUDe<T."d/XSYb576>MQ?(a)&#L2^Zfg-)L&Lk2!c.s/fX^ne'^Z#Z~>
+endstream
+endobj
+188 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 187 0 R
+>>
+endobj
+189 0 obj
+<< /Length 841 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%!bDr&G']%q&fQCeWCE)"nV,ka;l(Vo_C4j*3]'t5AW5><;U.N,6jqSh%L8hJ`0DBJSnNAfA_<UD8a$MDoSe]0oB^JmBK'J+B(B\>*T)t'N.nHe7GE4j$pXUuJpoL3gKqNH_5skXhNIc?l\.7dJWoU@fo@T)p;C).`QKLSGYVBuWmrfP[qY"49]$)X@O9`Z^X4&Fnl?aT<F2TBV\#6PH7[CUuOnhkHNL1cZOoFUS#c3)@!=+tJh-7S)#^ETBr@8E%r"<J#4=8](J0EKtCsSO1c^,LK\r>7,JJ]Ma?_Y'VJDaE7#I8'$GSG3,.A[_ThsEb]jh=JY-<m3M(\e[V`Fp$HmQ^KODVjA2RZ9=a0d+].6SgN1lmcQE_FonZXsui,`/,mn[KVH)R$WDkC<WM7CZ]8L;E]"K,-XTTnL-ZPlQCWj<ELT%9_*!s6A2=W9Y*J@$O7=&5R?m&%E!.ILLFsE@bc<u(m[H;L8gN_aD$$ojNrRLV$Hg`QobVBVOi&H@m1'\jc_eu(*;dTdQc&).).$-0t(%:0DU'aX9mo$Bu]b.-kCpEk(U&B>i^*;RqJ<.7q:=ejP(Gk49Y/X;g2:E^2V,#4)s`SXAX3Rg!+U*mUmJXeE.pYch[QmN^iX.$irt,%H1$-[Ln0E!;iQUj^l&:DLkZ$12dX2KSu?]L]G1+br0:n=YH"6*38ATU4TVQ(,>'_l=6EBjgW0e-qa?l]l*.lnMY09YZ-rGcf"e(?.CT[GaP1$Zo`j]8#<\O<(fa7QWlsD"?uF[+`)b\TC*6(olHUFXsUY=6Zjl4'sG?R*eLAdil.>Ye,Lhp=i_#5^2Zhhaa`KGoA9~>
+endstream
+endobj
+190 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 189 0 R
+>>
+endobj
+191 0 obj
+<< /Length 618 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat$ub>-hH']%q&]IPPCp%:+DJ2E'j;5oga+u[e:QuUPR9JZ9O,l%6t%jhdS9L.:`NfVMsk<?'/i9MsBW.BXJ:'4+o!"!ci'$Yq>'hJ[r,k6UOSGbu:k+)>rnMc5d"KB#k5]6X5ommGfBT=ZR>NS@clp\3d>I3(TP7&`'94s<El$iBM<-qho^T0Srhi,?^lM^(9*>ohBl7%Q.+f([In&`_<#DhQ^cj)0gTkY`pY=4_h*&,d-->[?D"&s*RM%5JdKP"DId$6a[a6AEJo#gd&kg7)4(o<H>,MbPfYh=J8MQ3peCPX5CpJeC=m-g/$]f?s(laUI6K];$"N`8lV`<Rq`3VFr!4B`,,Bhb06?HkV226.'J+I-E^r8,"V\NX]cdFN%g?`u=kpS'H%0=$F\mpc4#)mo[ik"mH,.)T*,NS1FM^9-t3Qu-%N&1A2Dn<<g<q!1kpJ$a2CUI,M0UTP!r[2B\=1/2&3:F<+KPt)O!pbpUD_TW[7`LGm7]a]r=2T!r/4KY9,6@F_,)2+_'<6LVnBl]V(&#esfC7j#=o9$@5!_r>i_D2W#[DTbiVs?o>7'h&C&SjoUr!]agpD7,CnY>jTd=cXh-kICL;a'5lm>$'X~>
+endstream
+endobj
+192 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 191 0 R
+>>
+endobj
+193 0 obj
+<< /Length 1068 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%"?#Q2d'Re<2i%]Yq`AX?P2MnkAldU&_Ji6WP*aE.['7gS5des!qI+]'o1l;ueNR'c^?I$7XNBatf`sT0RZ5#ToBM(+4MT1*AYn57rdkQAi)N):1ISHHURU.GX(&nY/)%+mG"pSfC&FfqQ7_lmF7P&7K6ZnU3Bh@nH77@F<10l#5$1!V+Cg.h)6ECdhfUtONC`R#o+L&8.q'udBXFj%mp=$o?0VMW:k52M2D]QhXUp2Eg%0:.:d0(C:e./_(e;)[Na\-)X<L2`q6VgNgBFj&D57-sHP&0C9C^n8^L1AbQ2ikC_R[-t$/IONBe61VVA^C@l*>bUdX(uVr"EY;MM&hq>GlVdo^:%,lZVa_U=\e!*'ar^\*u^C%*MI4E0_`_=1fbLQSqs*6ejU9FDcUrsWj#iES4:C//EIMOC%X:0R3&uM)@<@h`a!4V?Y4+]?5hL7`UnRhn%k?j((,"]L:WBG2!d9i4'Dc4]IDkl4Zchhrf?[i32>Rn:Q'ED,-,CdMM'HY;0."TfO7,X3d"ui)d.(lWG=sM8X0fu,cD`dMePLNdEr?qA)&#KKd95*OHQW'nC0)6B$1F6=BtCR:bT>9;J1='3kg33U$R4fXIC%)-u')t6gY^.epsH<A=G]>i,GI:Q&8]r9Y9&(;&!O.=KQGi\I3J)]O'CXGeND2_fe'-pQ<KJeBTOqc[4.]/5KCtWSs5UOU_D.+a*Ngf&-aJjd0UU=JQhi@O3Y&k9so`0#[n8>o:&3dS;DmmYLApP?_Y"P9`i4,,qg%,b\),h*(nFp(3,EIC9m1NlYX04kMk%UlaGpdIJNZTWTD(&.iV(J;q1l+DDd;pUZs8Xgp#olfWp#=hSt@^A@cpiQ:h+4hhRLptE^K8i#kJR<N!_ea^_S,9lkof/:@7c.nZWZNN>U)M=JobWK4[hLY$I+d;D@2*o]'?"LDF9^+WpR/jMJgb.B>L\>WgYP[q(m%T)Rq\!4jFd\9Efbr0%0H`rJGoi=,<i;3Ec_(-;YH&D?`NM2m!MOI(j\uO6h^:A^E$K-k4M#G^--QjJG5RgpD[OUiXY'L$K9Da0~>
+endstream
+endobj
+194 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 193 0 R
+>>
+endobj
+195 0 obj
+<< /Length 173 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gas3+0aki`$jGQP^ETE_`oMHtCY+.J%YBd:grtUB><VoaGZq))8<ud&j6IE1gOR/ZW!O:o+NWXI`P%k**D&Zdn[R54K@(<-W&rW[go's)o:?$[GNP'o@=eT'3ccp^e<XArF(`[^<k%T[4=pMECJWJf[:1RjW6'Ncf6jDBC?7*W~>
+endstream
+endobj
+196 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 195 0 R
+>>
+endobj
+197 0 obj
+<< /Length 1092 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%">AqtE'RoMSLu>+nLl$&\+G$nV:'-8DBS@8FK9nW):n%S8L%X?`>N-o$)l@;6O6>PEqp'D5ZX1;X`?'s<MS4/@#e\spH@c!e(Ej?7@7!7";K%!QIOss?JR<[e^%H$;76ML/"&c*uJ4OO10`hrA7Y;NM;/eaJA4$=#[,L#eo+=tmQQ(T%-a!%"g2/[-XDnkob:OMmPCH$D\",n.1P[Y2!0a*Hn!"b-K"te#ifQu9k/G.)]Uj5GM\'t7U2sIp+G^,HrtguYZ;^"Q@os'U9aF+]EdoPWp2hI$(i(o.!\d"YMd`f>_=Lns1qo`4pr1_E;U-^/lb*6?;\TFAMIn*0PQI:A7f-BUNX&lI3os3A&djK>HEeL3hqA"-TQ<:6PBVlq+<d<bAcg?m$mV<ChE:M*0NES2<DK/cE8(!2eJ1mOm$&<us1LEE\%IFJ.)Z*HG>5f"'M"#.]"SI$F7gY!!Kb=``fIc-7:%is=j1me+V4d4fZ\L*NTE(cg=o6$E,/C>]"cXs]MQl0mQ@#pg<kIHi-B.5#Xj=Uh3o\o.%rcQdHEZ17cbPKboDX&hoQH-)1+b\No6V:-(nR2R,C-D/baNr9qm6t^tnaJg<36O?t)e(`"(>3f4Pc0UTNK/!2pnWS)p5#NWM-0bNcg3QGjpu)S[a"X;"p:afcXlR_^%k`EmDae2IjI.jqTT1^Q3aPpgiqI#oa__B],GF9g-OVp7)X/Dp!4rC>anNLqZGN'Wm*0^]?]K(CV7Q@@Vkdik0=b24&`kD]7`ZXL1?7'Z)d9?6f&Q4LKHQ"?iIB"Al%U*d,c5^-eUkL"o9QJpRQGHL9%+`XPHT!Jf)d@uu[KeWdfTGFpaf6kR2"4R!iF(B$85'/2?LI&t2'ed!"Sf#HIHHTeu(/C#+_?md<(cB*rU!.];9JA!pePp4Q#U]h]HnCG!kf1*dgJ=/\$VRdh6Zf!=T.3k+2go'+A&_+Go+H'&aU*j=F9]>WgmSVE7pR'TFs\*gK0P318.t*]m>?b0<`)W,#A5Be*OdV:<pR_Co?u0t,PBd[LgE`IH%LCrip5T94[(9l+J(^IV-Hc%3I`?)>Hjj?RJ[:CUT.`~>
+endstream
+endobj
+198 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 197 0 R
+>>
+endobj
+199 0 obj
+<< /Length 1023 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat=*gQ%aW&:Ml+=Sn>JMX*?#WKhYWXOKjJWS4^49cmJHZ;_-,6e^A2YAGlr6:+nM8;uU!S2iAh_sMd?qMkXD6P=olZ9Vg,^]<U(".qg]7*&dZ3*79<\)i$[OOrDP=F\h,*+5R$BW'D^'=/e_!e#rA&"/\Q-,'(&;I5elE[TBpn-CrlQQ&8=B<COOdOeEo;<=n#]l'[0M>h(kgidYR'0)4qaS[3Q2[7BX'I`]a3:\M=K=lt$m=C5%hKk_8m*>@O;<24(T]Z#F;69?6V,rR`*@QOAMq[:O-**d'$`W1%L-YrO5qZ-23<5gQ,1+F<q;Vu'=-j2*AF/p]SYeoMQCcbd3TlLi!a+V)[6#F?<a!"^>o8Ti@=1/@^IJ*qBq+_)e>..P+;8iPQ\f#a@dLEnX/CCcoK(F))T@=Uaes?S>_98CELOP9g$WcSNq9AhHYeoj_@E`FgS:8nj)f@A:X<$n#mN*plLWlU10/*dV0Ou"!K:HC#]"[S\_'&UD-<B77;4*XDWUD"8dEB&?-i]YBfO$iY6b77,G5"fKX4on$@NmPPW_Nl@c-M:M(<J#VHQP^/'j^H?<6L.D=j$VI65`\?W'm1Q$Z**A(a)fssZ;NQ*c).Q*C3+6`EJ%*jOp^#QW!c\*I##`]D8/r.+_TWNkqUQDZA%ojVp-<3n?tkd\E\%E2BqA%,tc<4_lfoK;l:;1q4q2^#sT0.:s;t%kY[0Uh0V]%EhH=2,ge$_fpb?N6,TACq>3:<o:86*"X7WWac29)LD";Rc!4L_$Kh@]>T>Li(hl&iQ<"s!r?1`"=reio5+ameWFOGW9d-i[h3o#_&;0)L0ZqjJ>)Sr6RbM:@79%H/]3`g@`qXC^VZ@r9Y;t11B4;/,bMD!09@?(Rkj*4Gn<)%N.J9`*<\"]?Ff5PZ1LHYLlAi7\FpY[&WK\DQD9g6@1@dqRZF@)(%cgH!qs'I.dpHB:1N"I[X7bIbrAA;!qduu5B&A`";\C(a)6c\pQNGb^iiFE4#N0YqAL$.q-d75!XCPfn_s~>
+endstream
+endobj
+200 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 199 0 R
+>>
+endobj
+201 0 obj
+<< /Length 698 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%!bAu&c']%q&ZtpPhkj%O=bd7os9^)sa_Zj5QNnbHa44qj*r&sTqYoP38Qu"&0*Z^em+27J^Da&2n)OM[s1o',CL4m,['$Yq>j[h-u&q<9_h`M)^HV8f#s-#fAK%'r`ciJZu4A^c`k#`id_/DD2G3egKS&S$.ZWf1tZ4+A@_3f+amkYms[bV0Y*cJj3KO^*lU;sGJ%jOk[aocegBjLp4R(f@e,8f.-4pPM^*[)QiqR1AE$<7O\g*]>Y3[+i(77.rc@Mb#>i(/XgN&einqlLlIj>]E;IHTBeZuUY#A<RY&PTW+pKC?+4h8Ud1?=m#Ln0A@-`+7QUIgaghRu]"t%@<$);#H981IW\1.H7K^UDeO4V,:n(r6'g`-SfPjIogX"lMS'TgbGbfbXOM6i<iR!gGa9r^*ouhn5j,q`%iXEO-jSeoF/eSa?X"^Z!JX"<MB'#j8B?5P/dtQ5[^ngKG&g`eDVKc*bOrNLsomT1^S^uRAb]0`6#2%3U!gVhS3I@?R&3\4ijS:6+b@M2N4E`0)P'D@1@8(kV[E/?J8`c/Y^>:Hp6d.pF&RR)#@re"Yj)k3j/=_U9X[RJ)3uM$4832J'fGB,F[#mGR\Li#f4)Br=g'[TKJiIcAW!slJWBlrp3GZFfaSE3W+]3f$5e/=VAunbjPGY5Zau`Cts"C]@qJ2Y!=hF**^R8+dfQm~>
+endstream
+endobj
+202 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 201 0 R
+>>
+endobj
+203 0 obj
+<< /Length 666 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%!bAQ&g&A7<ZGYAV$nkJAq!X\-5MDRR1[?n<,g85i*ZD:*5Oo0X,LTQn[V9hY9E&bJI)<j?UhL/jh.%gTu@Lo6)7hBhS6&G_51)(9jJYG=(EV$.'jqdn^d:\4ILg[^.JW9^sl[fNn-q7B.H:SZ5cYQdQ_U!._:IVt[jsR"*?U^inb'p>ef+-LNiiG+^&C*>0;?@?K/NeK/Gdu0Y%4R)>jKD;g##6:`Bi7AB^`DQqhA"WL16?T/-fZ>+C`uTXBr,1>N'i2O##cY-SencO&j.70c+nUI<P4Dh!Ui64jX"f/\#!Gq09.H6E.Y+`J@f97fUK7]?)8YXKY%Ue\"iWj>4;%90Wj8b;W*__LH4D6[[//qDWE!OGA1F*f"]J,RecC8JOpfJoV\9knYtT^EV$O$%pEUK@e>1":@o#37HBU6&OB([d?L-;k*=3>`Un.F!)l(N3%rM,DKIaLX`CDIl)l\lph^nUK<.9&EH!SC91`N3gttFTRBp?VJP;e`;*Vo_Og*#sh3sJ`<cRJD]3H&6Kc!3sr:jjf)i0nm9t?D$TeU&\Y@!W13<m@^J'elV(%4=TX-\f[gnKuEoolKf\um\^:4j)l<q@)-OnYdP9/QNF*HoAjGGc0*%#Va%hL.6:kkrZMmcuNqeBsGp4'"gtb't/&IU3~>
+endstream
+endobj
+204 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 203 0 R
+>>
+endobj
+205 0 obj
+<< /Length 432 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat$tbAMqd&A7TLHV>-Y[10S'R.PBsU.CR5WU575P9M;""`rnbQ\5nP8VnoLZe!FIGh+DikO-Fo.ZjlGV%/'96\3`/"j)jV#WW*(a)6aVKTaXZ/H.==DQ>dHCd;E*+$Q9a-^5QhLl7iTHA=50jHPbuOo`nfgG2QE-=_.EPk4*bI4g1kM6P3^Q7g779A$TTP#'RdOBlZ,!pOG*aMT5h/KKhic[4@]<m:J!8`V_Rp5]:DXmH$VX].N6lj.[)(2Rk31#A#0n<J2P:@81^!Z-s==b7P9o5A-9tF0^VI(Q'Io"`S))CAT:_M:KsZ@@1/i&dhBi$MrW+LTp\68WmKS4l^t6%[*hO0mocA)$."qN\bK6NSBqX9qg';.kI^PfN]WJq,7"7)8W=&\WUo+#U1'hddC\,aML)ZYJU21IC_T%Y9)\mq<SSG~>
+endstream
+endobj
+206 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 205 0 R
+>>
+endobj
+207 0 obj
+<< /Length 1572 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat=,=`<%a&:W67+S*n%&)*1>E_/<*!P+L((U947640LQ"%B=C-9Mt`ER\?f]uX=tZJ*/K1TR)4RtJ&]=\jLXZOP)FfJhCYM.o(J/Al"JQJl7_)C09a:L%D#)LkJJ@7m_^^Q%pT9Zf4DP?hQ_NIZ`Y!V%o8CeIC5`7893Kk3,'k&FGLil[WsQX?5"0_U%oZNuU<YT]+_I!5WEhZFn\3slrd26(%lRJR(kQ&eOKoL6B53`=Hsm[]9kZ]K+*a</9taBK5ci\%mPK8;sla<.=]$GWu(_9e,oba95M"J5pdQkJ=kX3*1&\o?U"F`$/T(MD(#9Vf3rF0%3h*/MiSn36oPo$lXD7cKj=lTbCNdU0nfVAI'i>o1&&-cP8fF.La\&k1l,-u^bn,rFA!plA["q&1k@PqL(t+nca*B?MBd\1]jt&h6]A2G^]#4iG`6YMM\EED-!$Y@S9_EifhY>Lc]bQu>4:W'^M.<mq,27CFk'W!ggVBs][u[Ef4!5A1#6<JNFsCRNf67:/+ho2g=$g;_-+#A*/"Sgd\XI0_muC;T7)iWe>-.X+ql2K+N<>.</^pg6123REAL\N@ls3%31nQ?-/N>HTX8^85C?`5a@QZ\r/o3s^q)*@\Mn7\dPhU/cVn4C`]D\pXX_)<I$.^UddT(QWO^b\tVF,*TD#)bGfMC>fY6R`%j:rUbPi1r&IF\+e)'B$:"f!`%cRpJj->ciM\,,K[EC+2AH%fPHd44@qlIigS(AG#oKcf%S=$O&S@o1=7(u8l7Fc(BM/9f[8ppa=NtF8*uV>HCcDS\]B8K#=mO[!_.ahE9u?9F_+fn3"?]ChCVju(2J*N(a)G`\5oPb.B]Ec$7[cU$coWcKP`]Lb!E25`r>UmMGA$RNmZO5>W]-d*PkdhI\TM^dO*TbtP3f?tKe=eGi0`VI[!,`U6Mn9k6K^JU[f*0Olb5CdLY#6lImk^V:qVXUbdauZ70Q23>]`GiAXPgsoWl$)BBu8hA:&:61OiGCDhoYD5=Z*SVC<`s%S2RddO^8l12YN5F"jI/Wdpo+h![GmSE!EZI(H;6[7]ot\gG*IkDS'kQnNYaiFNpZm?^A8Xg-/U(Z\g],g:(udk&.R.7MMDf6Qk@BeJph/WKVp7Fcjdc0iW+o:n<#>h;=7ikHWR[Bu<\Z-d3$8JM]#TqUn'YJ`Sk-Y4u@2]1]YWiZd@aW!AdUWmWra-?L[%nW+o,e`#O#j?h*[2+O,FQB-N'?aLMqcLR;3YZ_IG^',<0/9QKDK5U-dnZ[=el<,[YrHDK\O:hLC%DP`G'Ga-9+YBS&U?emkFWdPTZZ_rjHH**^OC`SCq:rTUTAAhQd#@94-H6in`<9TtR9a.<.4o\MZ-M^gG-W2.+7#Sn_14I$[Ks0ec/=PYN2<,Jl6F1\M^J`f$$%a+#qpT9pV[#N1VN3^)'[N&XK;<]n)(a)HT8AOLn4TK!fTP^;OMuB5AR.B6[AN>E$P^5eOo8HusLR&Z/o[IAn0'psQ>A8GqBK+iupP*8rlcBt=^BAQ$it"#U4*'%c<'cNBjMU%jh7lK#A<5S_bhDFJ_&a^%2-+Q!9R[4a!:-]~>
+endstream
+endobj
+208 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 207 0 R
+>>
+endobj
+209 0 obj
+<< /Length 241 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gas3,\IQJ1$jPWQ:Z8Pe20"X;XHgrDJ:u!u(ojT$-"mYh_;c1Wa+BD>?Tp[:?Atd#Lf$2%)^/W?#\5If<[`Nq7@.0H#?W:kXfD9FFD\Q16)p;l@`^m@Cr3#roZnaaK:bT]!m,[.aYu`TdE%hEehhXCY-%5:;L!1$hEUbe(pm\B=iPQ`@3ZO3pE*0cTeg]9+n=JrS$5Pdnf6)lCYDUWIbU8VrKl)uill"J?EgkFkmiNE7?d~>
+endstream
+endobj
+210 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 209 0 R
+>>
+endobj
+211 0 obj
+<< /Length 1395 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%#9on$e&A@sB#j@sg@*OQC77eqKfJG&(+t\o-kbTm5=f0b<D93COc+6@CHh\lr,tmP>^<DQ3L,4n.iTSO4n_K7'J.k?!?sPD%i,O=#;#P?p&/5="Mc%XV@!rI_>lL06q-EJkYl7e!iW+aKJHBro9XKAI"=4YgL`J-MA_h=q=KS1cjt9bu=>*iq#Y@:.b=b]P$&0EfGr]d."6de<BPL@J:X4lMb@rVEF-1AO*%[fcfnB]dU>A25a]t\L7VV'ArPaNQ+<I@H3[9M!Aest7V/#Vb*g9lJPF?>TJhSE*KK:dsYL"P'@ru8lE5b.:h<!^3a*Mqnn=(<6EK&m.Z2Pf5a7GEpXl2B6:_mQ@BWlR]rK$kqeqZ=/WoZ#`"Aos1U!D7.(a)q3H0hDE1WX.!`A;*BM;2]s2qCqZ)]?AMJnQbiNAcb1WQ!F":ni3s=-3`H7I:F4*!gIc^PHlVIc^NnZGS]dGBqQ_t8NMsZ1W9L>>7%$md#F6ql^)->CR]@$ufq>HP1d#^P%Lh)"aDI,BnrU>@7r/$7Zh`f:W<`I)5][Z]mBrmn-f,9&qJOTV'5po?0)^lE#Z50i';?'h;+Y(cd>B<2NbFAB:PR?:nT<^#_Gt&f,n^&b::XTZHEmZ6#>nRY4fJ&kSPk>7qArgh]]lW'n4kobHl:S\-50)"1]o)->2OJ#lmfk0<I7cLqsM.I,Zi%JrFq2IaoAKRbI4UIM%.$_Ks8qkY!Q7ug"Ma9UT4e7%kkR.Y(8X9/n`%mV&52Q`s,3NfY6[o/*tusN@,Un5c=K:i+u[A7d6I(IH)6@eIH'CjNV7W2hUhQ0SVli(e_cCfXZ4](ds)Um=+)fcD%Qq`7jQh\$A3SeTAc"$n1pV2h+I@jc,TVateY1e:QOt=Z#-6Dt2'Y-INDPTcL?V9d92aLLGB=61(`*ZZTc8BDT7W`I;JMnnMjjntCMuL+Ua"NkG'QO([2u+*fqO<fR#JhO:55?11:q5O"M]BJNRO:PDj`SlL`TS9_Uqq^_sFoc/^(T6-<j"D8M@mQ&ln>P]b*kVYmO5)\2Ep-UdCU^W<]^PT3HdWgpc-tEf@WYQq\D>k%oY<e,]+"(kF`>OO]K*J/a492?RIP*bGs,MM(WdR^odaP1'T!(&[J1*dD35D[\gEUd,b=nQS6V3X7(Kb"pog]t`$r.Jg,m]FB6$1GVCp+'mG9S@-*hS7=nn!,cS:r@8;oGV"5hR^5?$MKA4cRoCrJ%fEVAc!#9E9o!ZOfZS\L=^tFK-;6e_P<@s6:5Pl4YCb/iLmo=c-;WX'n]+b.kD[A?0=APk8:R!V]3kfQZ3r-D`,#4m(a4CkZ`oHJlF.ifj>p1m^DR?PNT!Ei>dg#Nas_ilue^OAQ]dY+'1h;2Fo'Vqqn"<5`2AYDnorq#~>
+endstream
+endobj
+212 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 211 0 R
+>>
+endobj
+213 0 obj
+<< /Length 571 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat$u9i'Ou&A@7.=IaPsG-F./LfZ&=8B[]^8enn%W`l_%2A.8HP,doQYFT2_6uc@+0(sPP]f0</cB=))6Pou!17(hC:Dff)@tZ$"7V+QTP%9X7gZ!+u3`iD,eu`1]k"S^<9<qGP"T-4q=&in._;F[H9CeWaT1;SS!bTTkQilL+8Vl<#&K(4:le476>o)ONKO5O,'+\%J>RuCHeZO>)@oT@GcIf$E&7d':Wj]m\>lEC-PAK]sIpZc6m]YdSGcL4<]SN6)]6Tm<p;]g)[s@S6hHO'pFeZb%%d&sYG^*1e!+W^./u>LUBa!q!;P,R3A;jti/O8;=^S8qXUhhb$,s^]TMhn_7k*olTU;PTXU',61O*YeuKPB@YfS;hm%["W(J;7F?/TtR(\CR7:$*r2CBCk9ILa%mQ2:X._oX,W1r1tkpS0f#C7&W<1WoL@r$2OOle%ApNb4nJOd:eV`keQ>)DP+egD]^=U[meb`KDfoWkQ_,Gc6[;4jLP<bFFMrQ;L61<9`:s!`$JcSlg0GJI1^lnZq,`WqIV5k6hV1IDZV.ph;j,(?r;tUrrCJ6/_0~>
+endstream
+endobj
+214 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 213 0 R
+>>
+endobj
+215 0 obj
+<< /Length 2102 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GauHM997gc&AIV:0_SBl=>P7f2Q%nc!\&^*D;A.H"4sDO6=eK?-p-k#mnfguTe%_K9<l9ao.B.IiQP-q@=@n<.9lufag,ljhVWU:QTK]U_2l>:ZBY-H^IU,@jB9,t*u9>YJ!Zn2?^`p3^D?.-mFF*<8X_2n+="Vhl`FMh9Un^u2LF=E,n&TTSl4&/q1/S[0-Eh#C9BdmSj!T'nMNh$&2-daSq;P[Wt:MnMrh[T\$G'PJg<kP1F=_ELA(09TK0d8*$cDYUYODtEQ1rmPUhL=Q62,dQHp;PH5dmSa-fJPECN8+iX":R`Yf`4/19]g0c-s91Q!@e:-BR#Gg?OD?g8Lt;4*QoO'FU'(U9PMMc%]t5_3Sf2J8LSQT4`A$=6f#flZa,0jPQc/5Zg;QU`OhJOq1"VR&^p]3+aE?LS&kqE,u<qc)<m_[jshjl'=H"03^gEmn^+bMbDc-FBu=Eft,rR_aBmBhLUuEcbAW&E-Lt&J7tX9IM5P-:sfl)2K`/$[aRrUPi5q/QU#K<I<_W?YYqifBSA2Q/KfYEFJ-qgI[\%4>f4$'QJ:q(#Mp2FtS_?Bu(J;8hR8)N[)Bf73"`WajH)"+Q9aYhc,D`=D_0C]20GUcb[,tG1&XHK4[hn]4Ts!asmdtqUMe(`fYg)SjBqE2sY*9&PG!_bPFLL+p=+35UK=>4OL0?A>XmGE2Z)8QuHl-m=&D+mb!!=?RHDPGb)Xpo)8fqApq8"fQO*bc'r^S_b:@IT\LiGnBJ89h'Fo5O!Y4'2n/R13%N>E5AFhR(p>2YSop:\\s$n-i)bgV3a@X:fZ12^11<l'$%jgXV!``uN+jgn7?TrK.<qu[MZlmUPSEu<K8$nL2="U5IC;PS7r'A[`u.dSCJ_5+>M7*pC!33[q">Q5"l"K3RCZq=_/2j#MQ%AWH6i.<KK5C)=P7/6K=S"U_Ob",f92n"8PVA\7BY]'Y@270.oko51i0@Ud-=SEKi2]l+6bV5hgV1E?-e=YQpd%m]U".-o"dZ$-lKg,A-;$*g(W#)?LT%L,RpTpcs?J2/K"n\`Qgo_/M(&O'2j3c#;.X]&6!)\oM+jr)hN4[2Tk+m,3kYl^3AfLDdB#J\pR^MpMERt(:`R9k6u">X0M##,\AHX#jWt5$h9>ue0Xcj5((E$6eb-JJN7FF0'ZtWAWs#(k*\@AVr6kkIpMHdebGcK(r[D>(]1Achc79sP&]9o?J2g),UHUaqS#u!7]Pl4DI,JTUF)s#ht(`/Yg)_jC.<'r5R?"[V/GTu;sQOS,</q4jsl+%I4T.ofaUsC%A>-Rfj$K&\>M.*LY#FEWtV3e@,GkTiPFQi]@dJ_h)#6Aqh1aFniXg`ODc0<=4-Gr\M#3YPB3dE>6s5!.Yt&bclgNiofT/eXD'0kYJ?^(a%6`iE#i[o9a^RCN`B$*4Vu>adXRYB7ggH_Y&jg3eI=1iS-6r-^Ut:'SaT<pFL+/e@;bC,q#,Q_WP8YM@N)d26lZ@pPrQS/0&%:*[:j5b+m>:AS%)bm"_6$T7QETu-gVkb9<T2G1^s#8rqu9kjNjOS9J#\.`(=:0X[`j[mpXX/nGNOI[*rX)m%%Z#AufOt9ZLNK<o#H3LM*9_$K6+ULOlYr"plYj=*&sO)(,1g4W!C@29:INPf8+,AMMF(\]nS1"J1Kjl.-#Pn:6f>9JcFHT(79=P!doK6I5:c`1tXX)Nk8hQEh0YVRnYQ5?-kF*/Od<$iSB$JFge2&Gl*0J:b6Fg/&u90<Ac[]-R[F5<qm\f0:o1-C]RYTE<tuOm&6P!-:^qmc4R?T8jJo;,`3W/iX7TL9A'[+1[L*\JfJP990'5@M>hPZl*kO`'qc2@GUgV58>>0I6Jf[4sA:u9LCAd\`nj,F;->#D)E@/344=0)7'[;q'p$'6B7)g/sEd%T:#O!-"6MiM+KD$/9&Y+*k]lXHp8osJ7^++I>9$sR^;I22%TIg8s3^s_K"b@>@U^sDO-GJ\i'!LSm][og)H?S0Eu-4jIs(GUM<$]ZmP8<#XWgq'iM'gc'D63Xk9e@C67lhVOuF`J*VRdFC(e`%/2jKefLmq>O:g-^&,#TDbM>f:@=VL/FE7$I2O8,Wa-#hX8ZIr'DGQ~>
+endstream
+endobj
+216 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 215 0 R
+>>
+endobj
+217 0 obj
+<< /Length 343 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GarWu9i&YL(^KOlT7Z*<!qOc+n[Lst?AqHoeq8-B0j?^O\$%HlA(A$H!Y=8a#G,c9DBBRg";=lT5[XsJ,[jM?3=A8I(mYk:#PbU(2eVG@;"O(FmFhsm6/oFODpZo)LSLJVj1<Mkp^4(B#q\Qt'oLtU8EaCWS%i(d6H"B2l*oL*G'^0cbW8t*W%t67$nIT(a)k$m5=[.D?A".A"[gNI90Yi-YN?RCRP6#oYE9)(-\hAN6aea)*WFlO:p\g9=JEjXu.pD*HAHc)R&o,JQ#+6FimS;%51K5KsdEU@>s=Xc$4^Ff$idn(a)JTGl,VJo=?SqbZFU.E^IZMBOuY_\=04#'ePKc~>
+endstream
+endobj
+218 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 217 0 R
+>>
+endobj
+219 0 obj
+<< /Length 726 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%!995Pr&AI`dI,$m'p"OG!V;4$m<,JIH;(lbsPaDS&J^g'1pYXS1#T,mA'e/^4k*p;G4N>4<pCq!A8I4<,5[Y[AJF!dK8K\'Yi\2&d`$b'AmW3DHpYZ:45?JU)(g-qKl2d8/$5!n!.<^NS/:K*d2OQ0nS$Xq30D>-J6[3*dpRMjU88k&92/&033Q%<VWnk_.3Y.AU_+W!m.;"EFLq8s<-)iLMOAU#q_GCF?((Tp-;OHP@Jr/VH@7u4Y`.Hbo:$2PP"W'9FOJ:UN"LZ1kD+b`35d0'ep(JC7Q*kZk'>I0ti']h`V8GFZI=5"Il^sCqigAEM'K]+iRN-*Ch9<4m#d\f2+haK1Q-jC-nN[VkiITIr*E1Ga*]-Pn6lM+r0=OGeWCG+W$(%?,s%ZRncHdgjMq't"(u(oB#9<+873"(9ljU7B58(R.8"*(3,@.o@^6?P++V[;[R30Uu2i+8N)"_P&6U&V(.\Fl+pmNroWpj#2V09T8cXCR0en(k]C0laLneG>.ol40r1:p]]XOJ`W(Y;.bTcsH;/lL<rb6^6UArsAT[4Z?'^\)<9[doeTh,VUAb$2SsQDrA5X.r0(<n&5iZ;CQdCtGLJ">,Q&p\s(a)!.P$?"aG'C2<au)ckjJ0<3E>H],tF$m.5uCtkgpIq/:s81GmN.apuO]"Xe"MmEkpBfZ7i=F(46E0j/J_[OC#?\Gq$VT+Vg)]X:,Q&If[4S]g_~>
+endstream
+endobj
+220 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 219 0 R
+>>
+endobj
+221 0 obj
+<< /Length 733 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gatm9bDt%*']%q&]UY+_n_;=jU_tQg"G9/WYlPW.e7g/h;3DWjIub8Tc)YPD6J^;^4nmaP\Ms86p\Fsq=@/`I&:4\!4UdGJ@3>kE5kl<K_*O06D`828VJj9]&:?;_%PTXB#'9oSdQ@e(TVU3aU*BW6bBd/)X/N&A,i@I1(#b/.c$)KbGC*sSX6q;#Nh;JLhqc;4lJa#/&]/V-E\:gXTgCBkcXBcgB1T3__m3)C"VqmEFNj(?jc&`-1dX&:6m*7U^+^%Xd>S1q'1e7,0ETL]EmkK;*9PLMB0W[V.2b2`fZ<Sf"ZR)*@;/#Ojn=f#gicIck]=sA0CmBGr\[@[]"4>CgCIoe</P#+o7H8]E!D]AlcOe=.Tk7k"XagDYqk"^W:+dOXLT6(UCo2EFno?F;46e:UrX?bLgb,2`[pWZ9ua88#Z6]3+miA;do_Gp',9d=K:T_Gku1.'^J[rZ9p:=1C0)D'9um.4]5q4lh>?M^;X^d,`/#9b4S7KTR#L5c0]o\JFBK_c0o2gtek!*oK6^V?Z&\*a;(YaTLlgB=?h0d.MQBm;,ho6.RF8=e@.gNIP?lU8=+&(6X4"=rd^4hI>5*t2SJC8V0/B=;SsDd6NZRVAkMpT/k*ZUdCEJF=0=)9[+VAUeY?rL0Na8"^W1T7L?q[aA!YG]I,,ZTc"7N/dBXW)IF3'?"R^3;=PT%KsUN[f=%>@[&7D#nQ&T3o9JBY8Rgen%O<t3&n~>
+endstream
+endobj
+222 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 221 0 R
+>>
+endobj
+223 0 obj
+<< /Length 666 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat$ua_oie&A@B[G]\J)j\G'-T['7pJg*N7D%DLt\LOtr,$i-:?W*%U/QUZD(C`Ngn'0&q5/b:l7gcJR,Qr*&+E.T?5k]ta,S0tgE>T#miY$XnHqI"R#C_3u]gZpkO\N'Q$NLia+@6,U`>p.<PhN"g1jO5R"'`WJ`o]?+dRT?Va%)sUlfRQoP?*#P4cfU,YD%TQ\Y_o,(nt?aa!>Ne!AZ-Q=uKqg@*q93cBUt-##)D"&Y[)b!jNm"$La)o/YIcR3HU9be&XP)4H^`K^,_]U<>k3#,:/:.Amgg%qap]C.8ELMVPi_s-Nl1jYNr_SpeK-PFT9LRed>k0LR<kQ"n.[NS,?sj]"2T9-7k[k%d<9?\j2C.`3nOiK>Cf@I&sa$T8V)g;A=8BR+??WOn7AnkXfG\@:Ui2XfF[d0j@R0/?g[Vg'q9A!'U;Db(&a2/`7qtb@@7$cu"j9Ro'XoF%S[_)TSF'f7%,B:>5Kar#BS:LKkpL1uIWSBN8UC0PEeH`)49Tq-Hch]#ujo)LZtt#XKM<Su0(s[u%)[m;_I=Q:=RbA2NU0>&%il9`,^/h2IHg&('_j<NWBe@RC$XRo@aqntlO&78P2=Pd$'uhq]7.k"5;6fP\<>gFLW!O9K!CLNoC=(o17)#*U7t2I&MuZSLMhrrOUFE5M~>
+endstream
+endobj
+224 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 223 0 R
+>>
+endobj
+225 0 obj
+<< /Length 1061 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%"995Pr&AI=/TU`;cj5Ll9]k,`re>cfRh5H[;#D\ZL/WUUimRC4VHOY_^&-uK[Ym5d=q.@X=ICGf]s+i8j!p!MME+W>O)745U6-D^4[N(n@c_8oNZ$n;H=Mf!X?e5([6r=?GEe+A$!/N+Wj!!>iW":VE3%T\KjAEM'Z'L2H.i'(W>Wo]WdTrQE9Fk)$&teeQa>jo]B,HkCE/r$\Mog[gZ^[>rZ67K=&;,@s3$uFlNe0Bb;Sc\c)#nUqa/^mP!mj5#e/K[?8"e@%!8@s)Zd:.Bm$arCDf2rDcSjOKr_E$WKZ\>Fb4-t=QO-GVSSm$_5(uC:4Pb/B5?M1]ibH\[<[gGPZ*A?*B0+B\.NT81d^:W$aYo':g9[U(1ZH2'$?,jeoQ\P4=p@Za+[4Cq]obqm@rV5V'h<mZ5LooMHM.ujnSmh=B5%s%45T&?XrN+7R]`b[Xu^6bUkr3C<D`1.QA#OB"4-dICH%i9D-!N'mD`>"?jr.cW<b`X,06OSLpD,#We`K!LFD)j%/!irH4d=D<L@EUnN0C9H!]!O%OI81>6no[WYAUQ6kllX<6-cV]]eI*<3qC=X))sB0R\g-U_fuo&n-&7Ggog<mpB4<N"(IYd*oQiR+QrAZk^P#&!p^m#-,,6%W3'R4Vp5/SnhQ7<2N8@lTNOBE@&%1gHb%5lZZ9a%G0guTN0`$]St/+)Z4Ht7@C%o[FQDqGf<=Ynf<oqBb419RfoAYBcrQgY=L,SCbmpJ?:Rn,-o9XNT2D2VQ2GFX1Wq#ONVPYQb&TXoq".!NU<j_r5'@f&[S/L;(OqDO0cuG2K)k-S":#u1/]Hsfe3VM(\c@MUanm**B4nnZLRH1Uo3cSFWOt8':o$I[c`:/KVg-:0gN4If9;@i4IMtF"#SPf0c*JYKn]oC,+,2lh`MB_(fbPWD]KB^RT0At>0MA^r'5:J8_n46HmFAg8m7XH?\Grt?jD0+@<JH%Ud`pdserPqA=_45&m`V@o]ZUTKf<aB"H!;qC.0\3FoiR*&Q#eIGI@K&pq[6t=nDLm$>AV4B=lTM1n0V7Uq%#V.X4R~>
+endstream
+endobj
+226 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 225 0 R
+>>
+endobj
+227 0 obj
+<< /Length 1000 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%">AqtE'RoMSa:m8QC2>9&P6[2X0r1Kt#o;G"GjnV/NC]W!\?PsZS0k3gCRS"HWDEG_lZ\B8AN"o,+Uenc3!lm"#(u"G"]54q5V[ci8RmjD369[eO0^pVk3'Ra+T&*7EIa^rTKrY[iDr2V$ttGX6sbed>cN&mlh.oh,qkTohC)Naj`rQ#E=4c'M(plcWt*Pp#r@'X'h7-I.YXl5,&bZed>*:$0Q\i_MEh7??p:i#epE4<2)f#R":-1ljF/TnHeMuXk@R95@NYl2i"L.^.me2C;k.;._Ht]tKG1kRrmbr$25c=iV-9:nfMpC+EOd\*;g^<LS9.!H-'+eWkhC=[IIE1kNkX-$nY-moAW-qGLj#-n\_O9sk_MMR87N@u$B'UZrl1rIDiWso=4g(,.7qCoGoC6R%^D).Qm=%=_4-a&K>sT+;dS+DCo&(l*ekB%1eeXaW0XM;gp?Q;-3-]K-]a7gh/c@pi(BV%[GV5C<6>rAc%K.GLZ5P@:D/4*8cGgD#ZXpNYScI^:1=3[X7#EAmHp#cKa<7^KB+O0=g!+p)HbR`PFU_b^,Ug#@;<002s_r:Cj=.]&1'[n+6pGs9Xqs6@S9enYO$"5,g8DT`AYTJD0rjg[ZmP4%oZ2C6<o;P,On26!>m+8i;8CYnL1s,Y<C:UF3G3Qa?$VqF&.1t36XRV(ahGSFlnG#;9D?KV&o_a%QaG5l%]<0+>9L^a#HU#FAe:]2Ge`-*e.kD7X[fNLhY;:J'XThQB/&I`T4TB7T@,c;$[$9eOGG6X2?*qX:"13p*CX_YSJ!dI8uGeVIDVV%'kfgX.(&$\Zie2kan&D?[Hi\_K>Du9`$]B>]AjD]IjP_X(F,632HVl@D/]FT/MX"$AKpRB8*rNnABG'C..]-,VQH\;Lh?RLg<7,I)c^t3Mu7<[:-1b3cL>KNl(G!$eO(u:U^Psma3uuZ0n@[^Lh.%Gu2^KcRq$R,)JR0nD:l&gW:/J"@TrR-o*.L",2c>7K~>
+endstream
+endobj
+228 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 227 0 R
+>>
+endobj
+229 0 obj
+<< /Length 652 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GauHIbDr&G']&?q?Ht+]qYaO';Pm/)<Mr_PBJs]DKU<0JJu:lfakt^#'4)i(2AHk10DD!sq_EA(nE(r!=@/`IQim\2!t:9<0TZD]+>ejGE"MHR\!o%uhV<])+T1:s*+7hI*9[O@UbW3ETVT(``&@L0no@U]7:L>%DR2c/k%V9;"Ui0tpRCW)aEI<l!>MX^C6tRAijmkSM+W+,jE65;GRd,:"X5[#a9Q`-`OS-!3Z76rM_Z]bBHRi+XGgK2(d4/sWkok[YopCKnh_1Xn8M)E7@n,l)JbPjd)3MEkPYXuY+CStT8>p0jb$L`4]42jA\L=o:"Ifp8uOa^Y#<rM[ss?[#?+k:\#p3bBp4K^%!UKq"LB7`H+gE>0H%8J;n-BUFYqVS<t*8RFPg'_(h8Y)eL5i"7@^:%ASSR)q-sQ>R^*.m5KE#!\2Sc(+$0s.p9<;YqmG[mji2C+rCP21.o"3KEgKWf_M[;7.sCm?`9!6uEC*,'o<k6[6ERX;lZ?W_*P4oV-X+_0L.]t+8o82>6'tNjrH5EIAP@SWf#N&=pLZh+7[CQ/1%@3[l6S?2k=*"SoKue'U<5YA3>!0E--&MXKu'tTT2YVYc67DNWRf.mEW_K_CN(("*<h)fU>JP/eq;$IA6tPk<q7oaDk/*~>
+endstream
+endobj
+230 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 229 0 R
+>>
+endobj
+231 0 obj
+<< /Length 901 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gau0B997OU&AIm?jFh\&C>u^T"B&;P#GadT)o2P7\>dr1:#dN1G0@)0H*ha`VL\j7`A=''*oDps\Hs(UhI@(:J:n`Y$fB\kT]_ddoJcod`rZSNUL(J%^0Z5P4*Bq=pVIFF76TiR!s:Ra+DMTa+M]_u&2MFN,V-9]FeR6#^+?</c*u<]'%+_ol5N(F8upg][&W[o7`pV.Ntp_@htVD7D'3dkQVXI$+V9*pm[]:DI=sSm$ou-,0ZZ;rrB@FGo+;Xp__BJGHitQZ1T^4DTKi"!+Zf9oVS<Yt(ri9N!nctD?9G1"@>4M/.s50eG\V:C?UW;@O#M"'a"a,3Upla?AVrj4c!58F@9:FVhPn/&gWheb-mY\%q.:b!Q<E$;`\^7m8#[Yg'0IK'grL[1:(^poN*?NO8343BC1&q>dRr9cg<h#=^9O]f);4]>9KngsO9fOK*HcJ(a8p$eU1+]7Cnb[8.@FC/SB7muT$f*nP-i8hMIi>Y<q36TNtiV>-AN$$!)Q:B8VIsq^k.RI^de3a.&V`uW7=NkmUYia3r^O%RZBMS.oePT3gL4,dhejUQ2<J5f8"5pUI5la=qZWi/3(=Q?*?h-9h%bi#<ltuk3O;!nl(]@M%p]g/DE3E>toBa5U1.00io%4?>3kL'Z$M:opmS-,(6OjS^5"e/_N>P-hBPb!=-T7g?E)8(aQ]<2WsOD>UYqnmM\dFZXDoe(fo(03,WuSrh6(O!Ys39kYi#`S7;ah&-Vr1P]"uYA)>51$!PV5!"7tPf=Ca9^^pS$5CojnN#HU"omSeM&crW_rZs*Nog70Cf!itfC*u\eK@'@,<Qdir?TGt-,ks?QgMl\hq\j5:3&U$B,OO/CVa>\!imZm64>gZfm#?(0a%9u`/7jA(;$jQPrr?E[2Tl~>
+endstream
+endobj
+232 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 231 0 R
+>>
+endobj
+233 0 obj
+<< /Length 197 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GarW2]aDVA&;9q/MQ%j:DYF&_D86ip,?uT3.Rm;Q1$\X_)FP:mAp/@Mq<C@ZA"YEoBTQC1*(`He-tq#0,euq/.QX@=ejXZKpUBSG?`0:U&Fr+:O(.[n0"]rD*P+U5D3,Mi:NRJ(CLKMJNZIIZ93/q2/ZksH^Hlekr6:LdK6l7>q9<\CA]&f%@:Ze);uZiMi\DS~>
+endstream
+endobj
+234 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 233 0 R
+>>
+endobj
+235 0 obj
+<< /Length 1416 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat%#95iiK&AJ$C#[<rmMO5-XGA^Q"$>csdTT.>l<>:BcfgKAm9@DMd^Fq$u+t:]Y$=,V9%YsZ#P93ka?[mt8QiWEVX*P?^Rfs3eq8"1@+:Q[B!I:+:X'P5hbnJrrgYe]3ot-G\!Z9&h;TK,/U_mg+5Sh1%@SQ-!I:t,s]Cn-bU."CY.1s]RoncWWAqX@u[S%hR7_RJ8]bpruW:bVY($e=$a$AOl-jD+o#Ee1Z/+ATsVDqS>pM*"t@#F*jdulCI&Of8T'lA:KQYAE]bVn6S5JNAVV0:\kco?@i&I6n8G&u3J,Y:7!A:q`([Q3\F.sd_l$ks#,V;c[cd=:-;TNlKnQ3$@U+V:Q6CWlO`aQ'8<K2`a8&P.Nn/m*%MTfZl<%HYI[\L/,oBm'(AM_22e'5O&3mKP6<\[H;=S5$P"j6>[n>]!U<L\#Rgknp*5',D64+LG61+l:DZU+#S?KLh;6.,XnA*C10J1d]Y+,?U&8c[7bLZs^E*%2K^YrSsf]r-,HS45$n23C>c3crP;V)e#YeVFMa%Hbu*?i5mem_5f7k+J:j_^"D&HqQltL-S;6J^,`e^PX]8oDhq!oXIR(WrR8fEfd3.G[qffH.Tl-j3<Xs]C<F&5Jfq\+kDb=,kWP==,gHc&&6eDtckTO;6^L^bPgfJD3BF68.3(a)clbYam$?TLCVK_0T)R.KA+V/%&SR'<&Y@,,:r"g6IR36a#j6WLftQTU*0%<je_*_gdb?"7/3/SEnK0L(*)+b7kHP6f,--,05RcX/<[2i?">`1>FJgGQ*D^2qKGeS:n9-!\K+,<Ao5m9E6\lA4Hnk^me$.$Mm3;Kn`,pb,7AR-B"M4Qsp9&#MnK&LW,<h=lu*a8<TIe^fnlf+)m_Zm/:&oS$^s/8m+5,<SkaXN`W?Y`NX\S9jCfN4;R*6A[S#]_Rb=4&AD:N9b8[P:YTQp<(qIr5/_D_q6$m9G"N&7nQpF>9'O`ntOem4n(:H0NSq9Q9umeT?"Y:\'L[,0oM3'3:0PK0'6$$(8/_nhno9"Nik#<:80YeWA!<Xd#:&\,!(]W"2Dqu?)p#a((O`a("I<YRi8cOeNkf[;?2o.d/AgjMUB*rF.O>jUF60eMN-Pj62Oo"GfT3g"D"_RPW\r\WhJuVK62T#)0c.LQUNo_.Hjq/_hNtaa+^Pm+/Wq4P]E!\[tNcrj^bSJDgnt0rB\^1S!L.BeJ>L^p,#hp25_ZZL*Z;6A4)jph:#EK$MJ\#jlDbD_0\,a4R&ns_BK(Y^D!2MJab#Ya1<U_\CfDZI%eKfaS"TUWGCB'Al,@/Rd2?N6a):?cN@0fY3A@^^$Pd_/Q.+.AE'L2I;Ir`e,2nY@;)nA\B!.Zg[JP:eRn*K,AX/[LN:@):bVfMHsBB)VQh[$F8KQRD@"e2.Jo#].*eskrr@BTR4n~>
+endstream
+endobj
+236 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 235 0 R
+>>
+endobj
+237 0 obj
+<< /Length 175 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gas3+0aki`$jGQP^ETE_`oNS(caBEuK-4\<-bU/uY?:)ipU!g7OXuR+a4D4\2]d[0d1S->5`j.qML.K*FsION%1fdNQQscFLpi#F_0qi71KF"En'!*N&JON)[>Arja9>q:@04b0/^bl9L23-*]<tQ0Q`X@^kA/M,WN35p"FO-$;#~>
+endstream
+endobj
+238 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 237 0 R
+>>
+endobj
+239 0 obj
+<< /Length 1757 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gat<A?#QMsn9oci8u4G.DB3Q-:MQ`]2()[p<bcR-Q_k9ER)B>i$&6Xj^TYHXO'1,;Wms_5Z"H2VT&IS)F8O(#E.gdKm#$eg4Dh=_arbdNJm9Zs!YgE@ZTC-r?iQE5k`,1pZhm0h"V,_;!D,*\@+$::R%VO<MPB0G^+FRsfi,:1ftL%Ij,LAk6%AJ%Oc[XL&+ZeU?tu!rJO*sEBG)Xq'.1REG-s#r\ghJ5Y9k`l\?3.$UC`3<lH?GIdr,moEdCYHguK*$6ZPq=blPF(/3Gk]ZRApIX23ZIclJAMre2C&FPqFGJmHdS2/cZ!4m<=l'kUOiP0n,"eepnCim4IrnL&QKQ;JeX=t^-`j9LfVE7[3p#?nNfA"s;U!VW@.X5&=,9$<6PEu%[A$p9,(ils'^)NcLS/?1dWYo!6B-V4qDV:nD-bf91mL?l3peujOf29f6C4J?YbB*V/`6R9uU'oNXHWXHIcS]+I5oJ";a9N?[qWbkOj0ad#j1_g#O'f>tQe0XLQ1eFM4O4On9e8N!F&W\jTSYb7<`<"Ri#"T23E'Jh]=]u_3Dq+0[%ap9!%_^[q:R+Hm\un\rld(7o\'Ib#Qo](0=\B\QSPpshSXiL<UrM!jqo7?&hR-uFF4S^>jiYsTSajV'RXUD:2/DH<Wom.jYKo)jprYi,0#/M]XE+Tm-%P+^eN;,C[\JQ0G[k<!TKV5$mRmPfHs)^oL1rXn[hhU.V?g3&aFn:%+DCRN3CVn/!S/i)K/5mg:iMCd*4=A&XasqM(=C8KPW$(sFN%7c:egd\VUNj*=Q`X5YKX0]Hgo[%="0fCEnZbhG\A)#Bp5t@b"hUcL!^Dt,N8DS>UYLGbto29A@Q_2M$hP-OO)Q-R7:pq.UYpe"Y#Wg*1NP$EKcl7>1_kUH)o<<[P0+1/c3X#J=feD39_9Wk2Z:KqV'&e"o^!+dQdFMYkVLGJ:'GVX-_`'9C@<MH?TqR<t%ZqP$^L)q:/Y/8f36RK+8t,l]<(]R'&]L)INP>_'),;ZGHu+A<?V,q,-^fB/EgJ4%tj!^]+'!iP/KBW3K:K3ULb9ltk'tlKLR$=@q5QZSSsj4#ubG))sVj0ti$jj^M"7k\9@;IV$/*jjBBEk&[S<r?D^q:A8@)/>!s<dgd8_b!oES%XZK4%oCs#U.h39S`pDC/Gmj$gNW&1R+NVa_Dnt1<(/aTlCqYti*A%X\%u#DTq<OMLsL15o,Z%fj0YY?Xt43%Wj^6h^"<_?m"I&C1?YCiIsLqI`<KQ'Na-;Z6%Y`.a;S)`F3WEP7V'[Sa1`af`iT@gXN)p#"PKmgY]qYASLiC(Pamh2AR<:NFjQ5M0_utifeoeuZl$<!CiEG9\?A<P5WRQ]ZsAn'3(G-Z=A14hH^VuF]K5]r-jN`V]UsD-<@kr`.V-=d28S<oG:%'(Im$5[=Z:FT!A'b3YcbGZo0'19,>sPck[LWU&>L(a)?PWA0HV0rRtc4.\J5Xc<=8MF3CQ*116Y5GH:]'Vn,.l[>)i@&$U9L`+6,/LJF3>hHG._uE8j&_*3o259t@'N&_-HLC$b4A!l&!,=Dg"#--oGUFrqE6>hP+fZ%:']n:7B>EuTL:0s(R>T'RYKeuU6(#G\V<C=.[EParG\(I$f4,DI$4">CpQaqj9"F&4tLoQX4k*P)Ff3u\JqoLp:S.)?IUUmrA8skfX$aKYa=Kq<j!l(Vr^e2qq^C7IGRlgK)c(\kN^[%>W("[2SX/om,eOae9Ho7bdX)@\Wsk8YGD\5F611+[\hX~>
+endstream
+endobj
+240 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 239 0 R
+>>
+endobj
+241 0 obj
+<< /Length 311 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gas2D]l(_1'SUb&if;=B>JU.r@j@g;\#O7E#J7t^&iD7aeFr9fj"u":.[J!2n6HMc6gc!F?lF;"VC*&fKE4f*J`]Kh;i.oF@,Bk=fRLZhO3**LnJ`mef!pu=5k43<;`"=2#%#,.-Dgo8e+JCl__F=oWog61[d`^?)'`e/YVCm"[pRGX]PDB8UH>:I[`a]sZ_!2XW-<)pim0)7ApkSdeuuqh\38/nVR%:LRdCR[>^kpB7gjk\`*(QbU4o1$Oe'&6k"6fSVI5BW0=>G%fnX6>POeRi>BhHuqNkMcQHl9mEFDM+8\^)jDMe~>
+endstream
+endobj
+242 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 241 0 R
+>>
+endobj
+243 0 obj
+<< /Length 1320 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gau`S?]Us?&:`$(5[15DPo9lHN8^R5g?\0!=&l<0)tg&l"%c0qM3sfap@@TdK>BGKE[RE"RtnuCq>6ZOGl3$(=M4hY,QPg?3a;C9@0&Murh)amn@^6d+HE\85'_Y8^SWCTi;M]<J!EpaK>(lX6Ce*EM@d`4O8u^%)<:U*<X?hXI$q=C8B'],>9^..ml(LaZ[.bHV-0\X;_'PTOf"*!'_JPj.G"h.Z*.G[WVN]+"n/9=(gI>u&4A3eV;<i;8jDu(ak0MH=Rm&S&XiefCOlCT7Gp[''jMrdY_i9)gcZ<m<u$>?`:'gV_>^:SS5p@>(.WL-.tL:LEB#`Oe'CM]S6!\"B]05L&<g/k;&nj7j].LF69p-2-o9'@cMF_$Y:[Ml+O[+t#7(G\E"JEg7c_TWO[i>'AL/0XQusS=i[QHo-Q>Z\27b;K2)+HsWfGR[[V9HXG]S>:Bm,/I<;/45&=R!t'"N^Z/bfcOl?p9mAO+,N[fCEo`!o6Wd;K&Bo%$^p+(`n6^G]1k(a)NotW`?\!_8.-&m%G(99"&r(F554@a0Z0#Ydo*cq!I-c@K:sZka9O7OY'GpM,rV?TB&JiDBU76F+<EGqDIEU`,^*UDrUAPMmPl>!OY41sjP\[pI)opt5dHTsqoo_?G68"n,k7Y/\Go[&RoO=75jMJ.>CcCuPM8.meoB[_otIJ\OB5+n<P59@HaMGiS5XPBV<Z&BihbsJ6JDao??Jp#'*Y5g!;+S"Sn"*M.r)f-J5QV]1+`OHJ4-PIo4\M%"OKDcIF0WVjY4*R%54_I&E)[n&?;E)`iU%Q[+kt2G35p+!E)>ua.]*Q\tP2g^eYSGqJ?P,V)952U(s1AD?oKjVIFc!\MN=3.#Rk?S2JITe!:?-eoh\44r7eP[OnABB>q#&_@jBN5A=+*?4L6Y89a/PD07+e0ql2FQ&6+5W7D(,A9I1cR*'C[_uQ!seaWJc<QApYj(Z,G^4f+m.5k+C"?gl+YdqN4`7(R\R.#&Bcg[LYm!%kU&&Ssr:i`3sSHs()WEL&"C=S-AUoaR$26Q4BXAk?dL@NiVBTssrPE*Qn#^u*]4+4fr0p[NqFe;Hb,``0?4&$BP^=)e7XmjG=4A4L?m7hIp'S.[Pj5L$Mhs[/nD<,%;YPO>(X+)m>]kV_@ErBV/+DD8L-cR+[;s-=5S7Q^\S/X[r?_L/2''k>+CV`61@%k4lUKG82*ud;kI>htq\*\o""6>C,b,ZS;W&lChg9e^RG>,cVWc!1$9c%@$d#Z3g4KfPCgIHY/7cY;9]s.>+jd2WH[eOA&IQ_5#64dD`1N-1D4RPHN2b(gJs,7Q?)#~>
+endstream
+endobj
+244 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 243 0 R
+>>
+endobj
+245 0 obj
+<< /Length 1048 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+Gasao;/b2K%"?O+d+btG_Uu.?fmW1t($K'ci6Z;XYjF`!j?tpso%?dDr;2[h4,Vg`1DECU;'Pgm'Ige$c5)HQ_D*<-KU2Eb5jMR/!qR3PL*8f=8V+ki/[sruc$`_%[?A:Bd2XqHBbI3Uh;!XDT2aY9U>V$\l5'=`b<NT]!O.Bg62U_95S,;KJG8o5$I)X"ZhT,Ta=&<'j]R%YI!dtX&JPGhoskNL'f67?+]2nB<UX,J1^/JKPRo@#)XZV9M:-*\,>OBbX%4)*&;7u_FbLh_0pmT<-7-ueo!NFFo1EpAP"k>Z6+flFMW+mIo=])7<_O'^W2V*b*TGg*C:E#8R\m`%/9Z:ki?a2ZV.CHlo`)`^o9.=U>5q@?2gdiO)q?T8*?B#+&n2;*>ok$7\WcKSh`l^F:M3<j9<AF^R3)=8laIAHk"Mr(A<dnAe[]n'S324die.;DrimOd52Q;s;*':8OI5f4Y&s9YM%(*,fiIid3'aTi<@2`lXT^-#/BUTb,I41QA6Ha6/%V]!CW6:qK$t.i[ifI'#2lnSe_!h0+I@dT9_pe);$9JUdp@mD51Y_G66YZ81.)'Rl5OrlFWiOdAS7Fq-k^mrLX49[V$dS5b!tNYQtj3o`PA]r1?uDd?b`U5[[-M$W>9h0%dgjD?%Ed(?KLmYccEUfYDm.'C;DUlR!^a0P%oDf`fbN!i8MMn)c<#fZ,E-.f$C#MC?:!4h@=JActGSDjgH_#':0r$),T<+.<kGsC>Q5F2N;@u<I:Ak.s(B+F`aWWX+j8iSs0U7S4:;]n+b%@5g49h7jBce[1i+\ceR\I_Tnl-r8!i9W2ARn]Fo!_2q@HCe2'JpTU>Rnp:QRdV<GN0K6cCiCkNFJ>M*8'm/,Ri"':ILrF!,*WStISl.Lh@`&.#+>fg5E6:beVg[nG/XUDeB`JDJ59NQ)7B,QKMqtD_h\eGlt>#-uZmIc67[g/Mjd])]h=7c=Ve5\?U+2o(#otthDDtertGqejg6VO(Tfh=5%$'`d8T"S?g2prP;Mu-7(K@%%g$m0d@EZtGbS0M4Q~>
+endstream
+endobj
+246 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 245 0 R
+/Annots 247 0 R
+>>
+endobj
+247 0 obj
+[
+248 0 R
+249 0 R
+250 0 R
+251 0 R
+252 0 R
+253 0 R
+254 0 R
+]
+endobj
+248 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 345.52 637.683 367.18 627.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://uffi.b9.com)
+/S /URI >>
+/H /I
+>>
+endobj
+249 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 373.595 637.683 444.155 627.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://uffi.b9.com)
+/S /URI >>
+/H /I
+>>
+endobj
+250 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 582.79 626.683 614.47 616.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://www.sourceforge.net/projects/cclan)
+/S /URI >>
+/H /I
+>>
+endobj
+251 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 626.66 626.683 641.1 616.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://www.sourceforge.net/projects/cclan)
+/S /URI >>
+/H /I
+>>
+endobj
+252 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 120.0 615.683 280.52 605.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://www.sourceforge.net/projects/cclan)
+/S /URI >>
+/H /I
+>>
+endobj
+253 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 156.67 604.683 172.22 594.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/asdf.lisp)
+/S /URI >>
+/H /I
+>>
+endobj
+254 0 obj
+<< /Type /Annot
+/Subtype /Link
+/Rect [ 178.05 604.683 440.79 594.683 ]
+/C [ 0 0 0 ]
+/Border [ 0 0 0 ]
+/A << /URI (http://cvs.sourceforge.net/cgi-bin/viewcvs.cgi/cclan/asdf/asdf.lisp)
+/S /URI >>
+/H /I
+>>
+endobj
+255 0 obj
+<< /Length 280 /Filter [ /ASCII85Decode /FlateDecode ]
+ >>
+stream
+GarVI]afWJ&Dm9u2p,Oq5;7s,UROh6F[-#*#uI``q">Jf5_uu4bMDo6GDSeiPQMRYME'f4&\&tk`#",h(a)0.p9YnA5D)GZ2rAY7;m]`Ycp5'X%08j(3'#8(NQ6V2iC(k5PbFbR@`!A#[Z]BLMf20j!(['ai+_Ne81r4HZkJku<mrAg7mQkK#CF_B$2mqtVhU".j/B-Z1_F'IP.em,6^\M(a)7Ln&E,lX[\B?X8;3M.Bs$'A)`V$TL;;7kW.$DaoCpd1H;(W-5@Rc0#\\'!Qe&Dm/~>
+endstream
+endobj
+256 0 obj
+<< /Type /Page
+/Parent 1 0 R
+/MediaBox [ 0 0 612 792 ]
+/Resources 3 0 R
+/Contents 255 0 R
+>>
+endobj
+259 0 obj
+<<
+ /Title (\376\377\0\125\0\106\0\106\0\111\0\40\0\122\0\145\0\146\0\145\0\162\0\145\0\156\0\143\0\145\0\40\0\107\0\165\0\151\0\144\0\145)
+ /Parent 257 0 R
+ /Next 261 0 R
+ /A 258 0 R
+>> endobj
+261 0 obj
+<<
+ /Title (\376\377\0\124\0\141\0\142\0\154\0\145\0\40\0\157\0\146\0\40\0\103\0\157\0\156\0\164\0\145\0\156\0\164\0\163)
+ /Parent 257 0 R
+ /Prev 259 0 R
+ /Next 262 0 R
+ /A 260 0 R
+>> endobj
+262 0 obj
+<<
+ /Title (\376\377\0\120\0\162\0\145\0\146\0\141\0\143\0\145)
+ /Parent 257 0 R
+ /Prev 261 0 R
+ /Next 263 0 R
+ /A 15 0 R
+>> endobj
+263 0 obj
+<<
+ /Title (\376\377\0\103\0\150\0\141\0\160\0\164\0\145\0\162\0\240\0\61\0\56\0\240\0\111\0\156\0\164\0\162\0\157\0\144\0\165\0\143\0\164\0\151\0\157\0\156)
+ /Parent 257 0 R
+ /First 264 0 R
+ /Last 267 0 R
+ /Prev 262 0 R
+ /Next 270 0 R
+ /Count -6
+ /A 17 0 R
+>> endobj
+264 0 obj
+<<
+ /Title (\376\377\0\120\0\165\0\162\0\160\0\157\0\163\0\145)
+ /Parent 263 0 R
+ /Next 265 0 R
+ /A 19 0 R
+>> endobj
+265 0 obj
+<<
+ /Title (\376\377\0\102\0\141\0\143\0\153\0\147\0\162\0\157\0\165\0\156\0\144)
+ /Parent 263 0 R
+ /Prev 264 0 R
+ /Next 266 0 R
+ /A 21 0 R
+>> endobj
+266 0 obj
+<<
+ /Title (\376\377\0\123\0\165\0\160\0\160\0\157\0\162\0\164\0\145\0\144\0\40\0\111\0\155\0\160\0\154\0\145\0\155\0\145\0\156\0\164\0\141\0\164\0\151\0\157\0\156\0\163)
+ /Parent 263 0 R
+ /Prev 265 0 R
+ /Next 267 0 R
+ /A 23 0 R
+>> endobj
+267 0 obj
+<<
+ /Title (\376\377\0\104\0\145\0\163\0\151\0\147\0\156)
+ /Parent 263 0 R
+ /First 268 0 R
+ /Last 269 0 R
+ /Prev 266 0 R
+ /Count -2
+ /A 25 0 R
+>> endobj
+268 0 obj
+<<
+ /Title (\376\377\0\117\0\166\0\145\0\162\0\166\0\151\0\145\0\167)
+ /Parent 267 0 R
+ /Next 269 0 R
+ /A 27 0 R
+>> endobj
+269 0 obj
+<<
+ /Title (\376\377\0\120\0\162\0\151\0\157\0\162\0\151\0\164\0\151\0\145\0\163)
+ /Parent 267 0 R
+ /Prev 268 0 R
+ /A 29 0 R
+>> endobj
+270 0 obj
+<<
+ /Title (\376\377\0\103\0\150\0\141\0\160\0\164\0\145\0\162\0\240\0\62\0\56\0\240\0\120\0\162\0\157\0\147\0\162\0\141\0\155\0\155\0\151\0\156\0\147\0\40\0\116\0\157\0\164\0\145\0\163)
+ /Parent 257 0 R
+ /First 271 0 R
+ /Last 276 0 R
+ /Prev 263 0 R
+ /Next 279 0 R
+ /Count -8
+ /A 31 0 R
+>> endobj
+271 0 obj
+<<
+ /Title (\376\377\0\111\0\155\0\160\0\154\0\145\0\155\0\145\0\156\0\164\0\141\0\164\0\151\0\157\0\156\0\40\0\123\0\160\0\145\0\143\0\151\0\146\0\151\0\143\0\40\0\116\0\157\0\164\0\145\0\163)
+ /Parent 270 0 R
+ /First 272 0 R
+ /Last 274 0 R
+ /Next 275 0 R
+ /Count -3
+ /A 33 0 R
+>> endobj
+272 0 obj
+<<
+ /Title (\376\377\0\101\0\154\0\154\0\145\0\147\0\162\0\157\0\103\0\114)
+ /Parent 271 0 R
+ /Next 273 0 R
+ /A 35 0 R
+>> endobj
+273 0 obj
+<<
+ /Title (\376\377\0\114\0\151\0\163\0\160\0\167\0\157\0\162\0\153\0\163)
+ /Parent 271 0 R
+ /Prev 272 0 R
+ /Next 274 0 R
+ /A 37 0 R
+>> endobj
+274 0 obj
+<<
+ /Title (\376\377\0\103\0\115\0\125\0\103\0\114)
+ /Parent 271 0 R
+ /Prev 273 0 R
+ /A 39 0 R
+>> endobj
+275 0 obj
+<<
+ /Title (\376\377\0\106\0\157\0\162\0\145\0\151\0\147\0\156\0\40\0\117\0\142\0\152\0\145\0\143\0\164\0\40\0\122\0\145\0\160\0\162\0\145\0\163\0\145\0\156\0\164\0\141\0\164\0\151\0\157\0\156\0\40\0\141\0\156\0\144\0\40\0\101\0\143\0\143\0\145\0\163\0\163)
+ /Parent 270 0 R
+ /Prev 271 0 R
+ /Next 276 0 R
+ /A 41 0 R
+>> endobj
+276 0 obj
+<<
+ /Title (\376\377\0\117\0\160\0\164\0\151\0\155\0\151\0\172\0\151\0\156\0\147\0\40\0\103\0\157\0\144\0\145\0\40\0\125\0\163\0\151\0\156\0\147\0\40\0\125\0\106\0\106\0\111)
+ /Parent 270 0 R
+ /First 277 0 R
+ /Last 278 0 R
+ /Prev 275 0 R
+ /Count -2
+ /A 43 0 R
+>> endobj
+277 0 obj
+<<
+ /Title (\376\377\0\102\0\141\0\143\0\153\0\147\0\162\0\157\0\165\0\156\0\144)
+ /Parent 276 0 R
+ /Next 278 0 R
+ /A 45 0 R
+>> endobj
+278 0 obj
+<<
+ /Title (\376\377\0\103\0\162\0\157\0\163\0\163\0\55\0\111\0\155\0\160\0\154\0\145\0\155\0\145\0\156\0\164\0\141\0\164\0\151\0\157\0\156\0\40\0\117\0\160\0\164\0\151\0\155\0\151\0\172\0\141\0\164\0\151\0\157\0\156)
+ /Parent 276 0 R
+ /Prev 277 0 R
+ /A 47 0 R
+>> endobj
+279 0 obj
+<<
+ /Title (\376\377\0\104\0\145\0\143\0\154\0\141\0\162\0\141\0\164\0\151\0\157\0\156\0\163)
+ /Parent 257 0 R
+ /First 281 0 R
+ /Last 282 0 R
+ /Prev 270 0 R
+ /Next 283 0 R
+ /Count -2
+ /A 49 0 R
+>> endobj
+281 0 obj
+<<
+ /Title (\376\377\0\117\0\166\0\145\0\162\0\166\0\151\0\145\0\167)
+ /Parent 279 0 R
+ /Next 282 0 R
+ /A 280 0 R
+>> endobj
+282 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\164\0\171\0\160\0\145)
+ /Parent 279 0 R
+ /Prev 281 0 R
+ /A 51 0 R
+>> endobj
+283 0 obj
+<<
+ /Title (\376\377\0\120\0\162\0\151\0\155\0\151\0\164\0\151\0\166\0\145\0\40\0\124\0\171\0\160\0\145\0\163)
+ /Parent 257 0 R
+ /First 284 0 R
+ /Last 286 0 R
+ /Prev 279 0 R
+ /Next 287 0 R
+ /Count -3
+ /A 53 0 R
+>> endobj
+284 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\143\0\157\0\156\0\163\0\164\0\141\0\156\0\164)
+ /Parent 283 0 R
+ /Next 285 0 R
+ /A 55 0 R
+>> endobj
+285 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\164\0\171\0\160\0\145)
+ /Parent 283 0 R
+ /Prev 284 0 R
+ /Next 286 0 R
+ /A 57 0 R
+>> endobj
+286 0 obj
+<<
+ /Title (\376\377\0\156\0\165\0\154\0\154\0\55\0\143\0\150\0\141\0\162\0\55\0\160)
+ /Parent 283 0 R
+ /Prev 285 0 R
+ /A 59 0 R
+>> endobj
+287 0 obj
+<<
+ /Title (\376\377\0\101\0\147\0\147\0\162\0\145\0\147\0\141\0\164\0\145\0\40\0\124\0\171\0\160\0\145\0\163)
+ /Parent 257 0 R
+ /First 288 0 R
+ /Last 294 0 R
+ /Prev 283 0 R
+ /Next 295 0 R
+ /Count -7
+ /A 61 0 R
+>> endobj
+288 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\145\0\156\0\165\0\155)
+ /Parent 287 0 R
+ /Next 289 0 R
+ /A 63 0 R
+>> endobj
+289 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\163\0\164\0\162\0\165\0\143\0\164)
+ /Parent 287 0 R
+ /Prev 288 0 R
+ /Next 290 0 R
+ /A 65 0 R
+>> endobj
+290 0 obj
+<<
+ /Title (\376\377\0\147\0\145\0\164\0\55\0\163\0\154\0\157\0\164\0\55\0\166\0\141\0\154\0\165\0\145)
+ /Parent 287 0 R
+ /Prev 289 0 R
+ /Next 291 0 R
+ /A 67 0 R
+>> endobj
+291 0 obj
+<<
+ /Title (\376\377\0\147\0\145\0\164\0\55\0\163\0\154\0\157\0\164\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162)
+ /Parent 287 0 R
+ /Prev 290 0 R
+ /Next 292 0 R
+ /A 69 0 R
+>> endobj
+292 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\141\0\162\0\162\0\141\0\171\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162)
+ /Parent 287 0 R
+ /Prev 291 0 R
+ /Next 293 0 R
+ /A 71 0 R
+>> endobj
+293 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\162\0\145\0\146\0\55\0\141\0\162\0\162\0\141\0\171)
+ /Parent 287 0 R
+ /Prev 292 0 R
+ /Next 294 0 R
+ /A 73 0 R
+>> endobj
+294 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\165\0\156\0\151\0\157\0\156)
+ /Parent 287 0 R
+ /Prev 293 0 R
+ /A 75 0 R
+>> endobj
+295 0 obj
+<<
+ /Title (\376\377\0\117\0\142\0\152\0\145\0\143\0\164\0\163)
+ /Parent 257 0 R
+ /First 296 0 R
+ /Last 308 0 R
+ /Prev 287 0 R
+ /Next 309 0 R
+ /Count -13
+ /A 77 0 R
+>> endobj
+296 0 obj
+<<
+ /Title (\376\377\0\141\0\154\0\154\0\157\0\143\0\141\0\164\0\145\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\157\0\142\0\152\0\145\0\143\0\164)
+ /Parent 295 0 R
+ /Next 297 0 R
+ /A 79 0 R
+>> endobj
+297 0 obj
+<<
+ /Title (\376\377\0\146\0\162\0\145\0\145\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\157\0\142\0\152\0\145\0\143\0\164)
+ /Parent 295 0 R
+ /Prev 296 0 R
+ /Next 298 0 R
+ /A 81 0 R
+>> endobj
+298 0 obj
+<<
+ /Title (\376\377\0\167\0\151\0\164\0\150\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\157\0\142\0\152\0\145\0\143\0\164)
+ /Parent 295 0 R
+ /Prev 297 0 R
+ /Next 299 0 R
+ /A 83 0 R
+>> endobj
+299 0 obj
+<<
+ /Title (\376\377\0\163\0\151\0\172\0\145\0\55\0\157\0\146\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\164\0\171\0\160\0\145)
+ /Parent 295 0 R
+ /Prev 298 0 R
+ /Next 300 0 R
+ /A 85 0 R
+>> endobj
+300 0 obj
+<<
+ /Title (\376\377\0\160\0\157\0\151\0\156\0\164\0\145\0\162\0\55\0\141\0\144\0\144\0\162\0\145\0\163\0\163)
+ /Parent 295 0 R
+ /Prev 299 0 R
+ /Next 301 0 R
+ /A 87 0 R
+>> endobj
+301 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\162\0\145\0\146\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162)
+ /Parent 295 0 R
+ /Prev 300 0 R
+ /Next 302 0 R
+ /A 89 0 R
+>> endobj
+302 0 obj
+<<
+ /Title (\376\377\0\145\0\156\0\163\0\165\0\162\0\145\0\55\0\143\0\150\0\141\0\162\0\55\0\143\0\150\0\141\0\162\0\141\0\143\0\164\0\145\0\162)
+ /Parent 295 0 R
+ /Prev 301 0 R
+ /Next 303 0 R
+ /A 91 0 R
+>> endobj
+303 0 obj
+<<
+ /Title (\376\377\0\145\0\156\0\163\0\165\0\162\0\145\0\55\0\143\0\150\0\141\0\162\0\55\0\151\0\156\0\164\0\145\0\147\0\145\0\162)
+ /Parent 295 0 R
+ /Prev 302 0 R
+ /Next 304 0 R
+ /A 93 0 R
+>> endobj
+304 0 obj
+<<
+ /Title (\376\377\0\155\0\141\0\153\0\145\0\55\0\156\0\165\0\154\0\154\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162)
+ /Parent 295 0 R
+ /Prev 303 0 R
+ /Next 305 0 R
+ /A 95 0 R
+>> endobj
+305 0 obj
+<<
+ /Title (\376\377\0\156\0\165\0\154\0\154\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162\0\55\0\160)
+ /Parent 295 0 R
+ /Prev 304 0 R
+ /Next 306 0 R
+ /A 97 0 R
+>> endobj
+306 0 obj
+<<
+ /Title (\376\377\0\53\0\156\0\165\0\154\0\154\0\55\0\143\0\163\0\164\0\162\0\151\0\156\0\147\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162\0\53)
+ /Parent 295 0 R
+ /Prev 305 0 R
+ /Next 307 0 R
+ /A 99 0 R
+>> endobj
+307 0 obj
+<<
+ /Title (\376\377\0\167\0\151\0\164\0\150\0\55\0\143\0\141\0\163\0\164\0\55\0\160\0\157\0\151\0\156\0\164\0\145\0\162)
+ /Parent 295 0 R
+ /Prev 306 0 R
+ /Next 308 0 R
+ /A 101 0 R
+>> endobj
+308 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\166\0\141\0\162)
+ /Parent 295 0 R
+ /Prev 307 0 R
+ /A 103 0 R
+>> endobj
+309 0 obj
+<<
+ /Title (\376\377\0\123\0\164\0\162\0\151\0\156\0\147\0\163)
+ /Parent 257 0 R
+ /First 310 0 R
+ /Last 316 0 R
+ /Prev 295 0 R
+ /Next 317 0 R
+ /Count -7
+ /A 105 0 R
+>> endobj
+310 0 obj
+<<
+ /Title (\376\377\0\143\0\157\0\156\0\166\0\145\0\162\0\164\0\55\0\146\0\162\0\157\0\155\0\55\0\143\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Next 311 0 R
+ /A 107 0 R
+>> endobj
+311 0 obj
+<<
+ /Title (\376\377\0\143\0\157\0\156\0\166\0\145\0\162\0\164\0\55\0\164\0\157\0\55\0\143\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Prev 310 0 R
+ /Next 312 0 R
+ /A 109 0 R
+>> endobj
+312 0 obj
+<<
+ /Title (\376\377\0\146\0\162\0\145\0\145\0\55\0\143\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Prev 311 0 R
+ /Next 313 0 R
+ /A 111 0 R
+>> endobj
+313 0 obj
+<<
+ /Title (\376\377\0\167\0\151\0\164\0\150\0\55\0\143\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Prev 312 0 R
+ /Next 314 0 R
+ /A 113 0 R
+>> endobj
+314 0 obj
+<<
+ /Title (\376\377\0\143\0\157\0\156\0\166\0\145\0\162\0\164\0\55\0\146\0\162\0\157\0\155\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Prev 313 0 R
+ /Next 315 0 R
+ /A 115 0 R
+>> endobj
+315 0 obj
+<<
+ /Title (\376\377\0\143\0\157\0\156\0\166\0\145\0\162\0\164\0\55\0\164\0\157\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Prev 314 0 R
+ /Next 316 0 R
+ /A 117 0 R
+>> endobj
+316 0 obj
+<<
+ /Title (\376\377\0\141\0\154\0\154\0\157\0\143\0\141\0\164\0\145\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\163\0\164\0\162\0\151\0\156\0\147)
+ /Parent 309 0 R
+ /Prev 315 0 R
+ /A 119 0 R
+>> endobj
+317 0 obj
+<<
+ /Title (\376\377\0\106\0\165\0\156\0\143\0\164\0\151\0\157\0\156\0\163\0\40\0\46\0\40\0\114\0\151\0\142\0\162\0\141\0\162\0\151\0\145\0\163)
+ /Parent 257 0 R
+ /First 318 0 R
+ /Last 320 0 R
+ /Prev 309 0 R
+ /Next 321 0 R
+ /Count -3
+ /A 124 0 R
+>> endobj
+318 0 obj
+<<
+ /Title (\376\377\0\144\0\145\0\146\0\55\0\146\0\165\0\156\0\143\0\164\0\151\0\157\0\156)
+ /Parent 317 0 R
+ /Next 319 0 R
+ /A 126 0 R
+>> endobj
+319 0 obj
+<<
+ /Title (\376\377\0\154\0\157\0\141\0\144\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\154\0\151\0\142\0\162\0\141\0\162\0\171)
+ /Parent 317 0 R
+ /Prev 318 0 R
+ /Next 320 0 R
+ /A 128 0 R
+>> endobj
+320 0 obj
+<<
+ /Title (\376\377\0\146\0\151\0\156\0\144\0\55\0\146\0\157\0\162\0\145\0\151\0\147\0\156\0\55\0\154\0\151\0\142\0\162\0\141\0\162\0\171)
+ /Parent 317 0 R
+ /Prev 319 0 R
+ /A 130 0 R
+>> endobj
+321 0 obj
+<<
+ /Title (\376\377\0\101\0\160\0\160\0\145\0\156\0\144\0\151\0\170\0\240\0\101\0\56\0\240\0\111\0\156\0\163\0\164\0\141\0\154\0\154\0\141\0\164\0\151\0\157\0\156)
+ /Parent 257 0 R
+ /First 322 0 R
+ /Last 323 0 R
+ /Prev 317 0 R
+ /Next 324 0 R
+ /Count -2
+ /A 132 0 R
+>> endobj
+322 0 obj
+<<
+ /Title (\376\377\0\104\0\157\0\167\0\156\0\154\0\157\0\141\0\144\0\40\0\125\0\106\0\106\0\111)
+ /Parent 321 0 R
+ /Next 323 0 R
+ /A 134 0 R
+>> endobj
+323 0 obj
+<<
+ /Title (\376\377\0\114\0\157\0\141\0\144\0\151\0\156\0\147)
+ /Parent 321 0 R
+ /Prev 322 0 R
+ /A 136 0 R
+>> endobj
+324 0 obj
+<<
+ /Title (\376\377\0\107\0\154\0\157\0\163\0\163\0\141\0\162\0\171)
+ /Parent 257 0 R
+ /Prev 321 0 R
+ /A 138 0 R
+>> endobj
+325 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F3
+/BaseFont /Helvetica-Bold
+/Encoding /WinAnsiEncoding >>
+endobj
+326 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F5
+/BaseFont /Times-Roman
+/Encoding /WinAnsiEncoding >>
+endobj
+327 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F10
+/BaseFont /Courier-Oblique
+/Encoding /WinAnsiEncoding >>
+endobj
+328 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F1
+/BaseFont /Helvetica
+/Encoding /WinAnsiEncoding >>
+endobj
+329 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F6
+/BaseFont /Times-Italic
+/Encoding /WinAnsiEncoding >>
+endobj
+330 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F4
+/BaseFont /Helvetica-BoldOblique
+/Encoding /WinAnsiEncoding >>
+endobj
+331 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F9
+/BaseFont /Courier
+/Encoding /WinAnsiEncoding >>
+endobj
+332 0 obj
+<< /Type /Font
+/Subtype /Type1
+/Name /F7
+/BaseFont /Times-Bold
+/Encoding /WinAnsiEncoding >>
+endobj
+1 0 obj
+<< /Type /Pages
+/Count 60
+/Kids [6 0 R 8 0 R 10 0 R 12 0 R 121 0 R 140 0 R 142 0 R 144 0 R 146 0 R 148 0 R 150 0 R 152 0 R 154 0 R 156 0 R 158 0 R 160 0 R 162 0 R 164 0 R 166 0 R 168 0 R 170 0 R 172 0 R 174 0 R 176 0 R 178 0 R 180 0 R 182 0 R 184 0 R 186 0 R 188 0 R 190 0 R 192 0 R 194 0 R 196 0 R 198 0 R 200 0 R 202 0 R 204 0 R 206 0 R 208 0 R 210 0 R 212 0 R 214 0 R 216 0 R 218 0 R 220 0 R 222 0 R 224 0 R 226 0 R 228 0 R 230 0 R 232 0 R 234 0 R 236 0 R 238 0 R 240 0 R 242 0 R 244 0 R 246 0 R 256 0 R ] >>
+endobj
+2 0 obj
+<< /Type /Catalog
+/Pages 1 0 R
+ /Outlines 257 0 R
+ /PageMode /UseOutlines
+ /Names << /Dests << /Names [ (preface) [ 140 0 R /XYZ 115.0 725.0 null ] (introduction) [ 142 0 R /XYZ 115.0 725.0 null ] (notes) [ 146 0 R /XYZ 115.0 725.0 null ] (ref_declarations) [ 150 0 R /XYZ 115.0 725.0 null ] (primitives) [ 154 0 R /XYZ 115.0 725.0 null ] (aggregates) [ 162 0 R /XYZ 115.0 725.0 null ] (objects) [ 182 0 R /XYZ 115.0 725.0 null ] (strings) [ 216 0 R /XYZ 115.0 725.0 null ] (func_libr) [ 234 0 R /XYZ 115.0 725.0 null ] (installation) [ 246 0 R /XYZ 115.0 725.0 null ] (glossary) [ 256 0 R /XYZ 115.0 725.0 null ] (id2452772) [ 10 0 R /XYZ 115.0 725.0 null ] ] >> >>
+ >>
+endobj
+3 0 obj
+<<
+/Font << /F3 325 0 R /F5 326 0 R /F10 327 0 R /F6 329 0 R /F1 328 0 R /F4 330 0 R /F9 331 0 R /F7 332 0 R >>
+/ProcSet [ /PDF /ImageC /Text ] >>
+endobj
+15 0 obj
+<<
+/S /GoTo
+/D [140 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+17 0 obj
+<<
+/S /GoTo
+/D [142 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+19 0 obj
+<<
+/S /GoTo
+/D [142 0 R /XYZ 115.0 687.009 null]
+>>
+endobj
+21 0 obj
+<<
+/S /GoTo
+/D [142 0 R /XYZ 115.0 621.683 null]
+>>
+endobj
+23 0 obj
+<<
+/S /GoTo
+/D [142 0 R /XYZ 115.0 459.357 null]
+>>
+endobj
+25 0 obj
+<<
+/S /GoTo
+/D [142 0 R /XYZ 115.0 197.031 null]
+>>
+endobj
+27 0 obj
+<<
+/S /GoTo
+/D [142 0 R /XYZ 115.0 163.705 null]
+>>
+endobj
+29 0 obj
+<<
+/S /GoTo
+/D [144 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+31 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+33 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 687.009 null]
+>>
+endobj
+35 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 643.683 null]
+>>
+endobj
+37 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 604.244 null]
+>>
+endobj
+39 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 564.805 null]
+>>
+endobj
+41 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 525.366 null]
+>>
+endobj
+43 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 405.04 null]
+>>
+endobj
+45 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 371.714 null]
+>>
+endobj
+47 0 obj
+<<
+/S /GoTo
+/D [146 0 R /XYZ 115.0 224.275 null]
+>>
+endobj
+49 0 obj
+<<
+/S /GoTo
+/D [150 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+51 0 obj
+<<
+/S /GoTo
+/D [152 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+53 0 obj
+<<
+/S /GoTo
+/D [154 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+55 0 obj
+<<
+/S /GoTo
+/D [156 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+57 0 obj
+<<
+/S /GoTo
+/D [158 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+59 0 obj
+<<
+/S /GoTo
+/D [160 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+61 0 obj
+<<
+/S /GoTo
+/D [162 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+63 0 obj
+<<
+/S /GoTo
+/D [164 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+65 0 obj
+<<
+/S /GoTo
+/D [168 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+67 0 obj
+<<
+/S /GoTo
+/D [170 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+69 0 obj
+<<
+/S /GoTo
+/D [172 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+71 0 obj
+<<
+/S /GoTo
+/D [174 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+73 0 obj
+<<
+/S /GoTo
+/D [176 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+75 0 obj
+<<
+/S /GoTo
+/D [180 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+77 0 obj
+<<
+/S /GoTo
+/D [182 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+79 0 obj
+<<
+/S /GoTo
+/D [184 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+81 0 obj
+<<
+/S /GoTo
+/D [186 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+83 0 obj
+<<
+/S /GoTo
+/D [188 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+85 0 obj
+<<
+/S /GoTo
+/D [190 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+87 0 obj
+<<
+/S /GoTo
+/D [192 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+89 0 obj
+<<
+/S /GoTo
+/D [194 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+91 0 obj
+<<
+/S /GoTo
+/D [198 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+93 0 obj
+<<
+/S /GoTo
+/D [200 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+95 0 obj
+<<
+/S /GoTo
+/D [202 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+97 0 obj
+<<
+/S /GoTo
+/D [204 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+99 0 obj
+<<
+/S /GoTo
+/D [206 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+101 0 obj
+<<
+/S /GoTo
+/D [208 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+103 0 obj
+<<
+/S /GoTo
+/D [212 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+105 0 obj
+<<
+/S /GoTo
+/D [216 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+107 0 obj
+<<
+/S /GoTo
+/D [220 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+109 0 obj
+<<
+/S /GoTo
+/D [222 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+111 0 obj
+<<
+/S /GoTo
+/D [224 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+113 0 obj
+<<
+/S /GoTo
+/D [226 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+115 0 obj
+<<
+/S /GoTo
+/D [228 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+117 0 obj
+<<
+/S /GoTo
+/D [230 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+119 0 obj
+<<
+/S /GoTo
+/D [232 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+124 0 obj
+<<
+/S /GoTo
+/D [234 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+126 0 obj
+<<
+/S /GoTo
+/D [236 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+128 0 obj
+<<
+/S /GoTo
+/D [240 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+130 0 obj
+<<
+/S /GoTo
+/D [244 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+132 0 obj
+<<
+/S /GoTo
+/D [246 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+134 0 obj
+<<
+/S /GoTo
+/D [246 0 R /XYZ 115.0 687.009 null]
+>>
+endobj
+136 0 obj
+<<
+/S /GoTo
+/D [246 0 R /XYZ 115.0 599.683 null]
+>>
+endobj
+138 0 obj
+<<
+/S /GoTo
+/D [256 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+257 0 obj
+<<
+ /First 259 0 R
+ /Last 324 0 R
+>> endobj
+258 0 obj
+<<
+/S /GoTo
+/D [10 0 R /XYZ 115.0 725.0 null]
+>>
+endobj
+260 0 obj
+<<
+/S /GoTo
+/D [12 0 R /XYZ 115.0 715.0 null]
+>>
+endobj
+280 0 obj
+<<
+/S /GoTo
+/D [150 0 R /XYZ 115.0 678.347 null]
+>>
+endobj
+xref
+0 333
+0000000000 65535 f
+0000087357 00000 n
+0000087884 00000 n
+0000088571 00000 n
+0000000015 00000 n
+0000000071 00000 n
+0000000363 00000 n
+0000000469 00000 n
+0000001525 00000 n
+0000001631 00000 n
+0000001792 00000 n
+0000001899 00000 n
+0000003924 00000 n
+0000004047 00000 n
+0000004448 00000 n
+0000088736 00000 n
+0000004584 00000 n
+0000088802 00000 n
+0000004720 00000 n
+0000088868 00000 n
+0000004856 00000 n
+0000088936 00000 n
+0000004992 00000 n
+0000089004 00000 n
+0000005128 00000 n
+0000089072 00000 n
+0000005264 00000 n
+0000089140 00000 n
+0000005400 00000 n
+0000089208 00000 n
+0000005536 00000 n
+0000089274 00000 n
+0000005672 00000 n
+0000089340 00000 n
+0000005808 00000 n
+0000089408 00000 n
+0000005944 00000 n
+0000089476 00000 n
+0000006080 00000 n
+0000089544 00000 n
+0000006216 00000 n
+0000089612 00000 n
+0000006352 00000 n
+0000089680 00000 n
+0000006488 00000 n
+0000089747 00000 n
+0000006624 00000 n
+0000089815 00000 n
+0000006760 00000 n
+0000089883 00000 n
+0000006896 00000 n
+0000089949 00000 n
+0000007032 00000 n
+0000090015 00000 n
+0000007168 00000 n
+0000090081 00000 n
+0000007304 00000 n
+0000090147 00000 n
+0000007440 00000 n
+0000090213 00000 n
+0000007576 00000 n
+0000090279 00000 n
+0000007712 00000 n
+0000090345 00000 n
+0000007848 00000 n
+0000090411 00000 n
+0000007984 00000 n
+0000090477 00000 n
+0000008120 00000 n
+0000090543 00000 n
+0000008256 00000 n
+0000090609 00000 n
+0000008391 00000 n
+0000090675 00000 n
+0000008527 00000 n
+0000090741 00000 n
+0000008663 00000 n
+0000090807 00000 n
+0000008798 00000 n
+0000090873 00000 n
+0000008934 00000 n
+0000090939 00000 n
+0000009070 00000 n
+0000091005 00000 n
+0000009206 00000 n
+0000091071 00000 n
+0000009342 00000 n
+0000091137 00000 n
+0000009478 00000 n
+0000091203 00000 n
+0000009613 00000 n
+0000091269 00000 n
+0000009749 00000 n
+0000091335 00000 n
+0000009885 00000 n
+0000091401 00000 n
+0000010021 00000 n
+0000091467 00000 n
+0000010157 00000 n
+0000091533 00000 n
+0000010293 00000 n
+0000091599 00000 n
+0000010431 00000 n
+0000091666 00000 n
+0000010569 00000 n
+0000091733 00000 n
+0000010707 00000 n
+0000091800 00000 n
+0000010845 00000 n
+0000091867 00000 n
+0000010983 00000 n
+0000091934 00000 n
+0000011121 00000 n
+0000092001 00000 n
+0000011259 00000 n
+0000092068 00000 n
+0000011396 00000 n
+0000092135 00000 n
+0000011532 00000 n
+0000092202 00000 n
+0000011668 00000 n
+0000012297 00000 n
+0000012423 00000 n
+0000012508 00000 n
+0000092269 00000 n
+0000012642 00000 n
+0000092336 00000 n
+0000012776 00000 n
+0000092403 00000 n
+0000012910 00000 n
+0000092470 00000 n
+0000013044 00000 n
+0000092537 00000 n
+0000013178 00000 n
+0000092604 00000 n
+0000013312 00000 n
+0000092673 00000 n
+0000013446 00000 n
+0000092742 00000 n
+0000013580 00000 n
+0000014239 00000 n
+0000014349 00000 n
+0000016398 00000 n
+0000016508 00000 n
+0000017682 00000 n
+0000017792 00000 n
+0000020198 00000 n
+0000020308 00000 n
+0000020766 00000 n
+0000020876 00000 n
+0000021431 00000 n
+0000021541 00000 n
+0000022462 00000 n
+0000022572 00000 n
+0000023853 00000 n
+0000023963 00000 n
+0000025028 00000 n
+0000025138 00000 n
+0000025969 00000 n
+0000026079 00000 n
+0000027284 00000 n
+0000027394 00000 n
+0000027775 00000 n
+0000027885 00000 n
+0000029719 00000 n
+0000029829 00000 n
+0000030089 00000 n
+0000030199 00000 n
+0000031349 00000 n
+0000031459 00000 n
+0000032422 00000 n
+0000032532 00000 n
+0000033460 00000 n
+0000033570 00000 n
+0000034343 00000 n
+0000034453 00000 n
+0000035673 00000 n
+0000035783 00000 n
+0000036111 00000 n
+0000036221 00000 n
+0000037215 00000 n
+0000037325 00000 n
+0000037719 00000 n
+0000037829 00000 n
+0000038895 00000 n
+0000039005 00000 n
+0000039703 00000 n
+0000039813 00000 n
+0000041180 00000 n
+0000041290 00000 n
+0000042224 00000 n
+0000042334 00000 n
+0000043045 00000 n
+0000043155 00000 n
+0000044317 00000 n
+0000044427 00000 n
+0000044693 00000 n
+0000044803 00000 n
+0000045989 00000 n
+0000046099 00000 n
+0000047216 00000 n
+0000047326 00000 n
+0000048117 00000 n
+0000048227 00000 n
+0000048986 00000 n
+0000049096 00000 n
+0000049621 00000 n
+0000049731 00000 n
+0000051397 00000 n
+0000051507 00000 n
+0000051841 00000 n
+0000051951 00000 n
+0000053440 00000 n
+0000053550 00000 n
+0000054214 00000 n
+0000054324 00000 n
+0000056520 00000 n
+0000056630 00000 n
+0000057066 00000 n
+0000057176 00000 n
+0000057995 00000 n
+0000058105 00000 n
+0000058931 00000 n
+0000059041 00000 n
+0000059800 00000 n
+0000059910 00000 n
+0000061065 00000 n
+0000061175 00000 n
+0000062269 00000 n
+0000062379 00000 n
+0000063124 00000 n
+0000063234 00000 n
+0000064228 00000 n
+0000064338 00000 n
+0000064628 00000 n
+0000064738 00000 n
+0000066248 00000 n
+0000066358 00000 n
+0000066626 00000 n
+0000066736 00000 n
+0000068587 00000 n
+0000068697 00000 n
+0000069101 00000 n
+0000069211 00000 n
+0000070625 00000 n
+0000070735 00000 n
+0000071877 00000 n
+0000072003 00000 n
+0000072080 00000 n
+0000072251 00000 n
+0000072424 00000 n
+0000072618 00000 n
+0000072811 00000 n
+0000073004 00000 n
+0000073224 00000 n
+0000073444 00000 n
+0000073817 00000 n
+0000092809 00000 n
+0000092863 00000 n
+0000073927 00000 n
+0000092929 00000 n
+0000074131 00000 n
+0000074332 00000 n
+0000074474 00000 n
+0000074752 00000 n
+0000074879 00000 n
+0000075039 00000 n
+0000075288 00000 n
+0000075451 00000 n
+0000075584 00000 n
+0000075729 00000 n
+0000076036 00000 n
+0000076335 00000 n
+0000076474 00000 n
+0000076628 00000 n
+0000076743 00000 n
+0000077079 00000 n
+0000077359 00000 n
+0000077504 00000 n
+0000077785 00000 n
+0000092995 00000 n
+0000077999 00000 n
+0000078133 00000 n
+0000078265 00000 n
+0000078496 00000 n
+0000078652 00000 n
+0000078846 00000 n
+0000078995 00000 n
+0000079226 00000 n
+0000079358 00000 n
+0000079517 00000 n
+0000079699 00000 n
+0000079893 00000 n
+0000080093 00000 n
+0000080258 00000 n
+0000080396 00000 n
+0000080581 00000 n
+0000080802 00000 n
+0000081014 00000 n
+0000081226 00000 n
+0000081443 00000 n
+0000081632 00000 n
+0000081809 00000 n
+0000082033 00000 n
+0000082245 00000 n
+0000082445 00000 n
+0000082627 00000 n
+0000082855 00000 n
+0000083056 00000 n
+0000083230 00000 n
+0000083415 00000 n
+0000083619 00000 n
+0000083826 00000 n
+0000083998 00000 n
+0000084170 00000 n
+0000084430 00000 n
+0000084678 00000 n
+0000084900 00000 n
+0000085166 00000 n
+0000085323 00000 n
+0000085542 00000 n
+0000085746 00000 n
+0000086032 00000 n
+0000086195 00000 n
+0000086323 00000 n
+0000086457 00000 n
+0000086571 00000 n
+0000086682 00000 n
+0000086798 00000 n
+0000086907 00000 n
+0000087019 00000 n
+0000087140 00000 n
+0000087247 00000 n
+trailer
+<<
+/Size 333
+/Root 2 0 R
+/Info 4 0 R
+>>
+startxref
+93064
+%%EOF
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/uffi.xml
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/uffi.xml Mon Feb 11 09:23:05 2008
@@ -0,0 +1,24 @@
+<?xml version="1.0" encoding="utf-8"?>
+<!DOCTYPE book PUBLIC "-//OASIS//DTD DocBook XML V4.2//EN"
+ "http://www.oasis-open.org/docbook/xml/4.2/docbookx.dtd" [
+<!ENTITY % myents SYSTEM "entities.inc">
+<!ENTITY % xinclude SYSTEM "xinclude.mod">
+%myents;
+%xinclude;
+]>
+
+
+<book lang="en">
+ <xi:include href="bookinfo.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="preface.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="intro.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="notes.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="ref_declare.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="ref_primitive.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="ref_aggregate.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="ref_object.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="ref_string.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="ref_func_libr.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="appendix.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+ <xi:include href="glossary.xml" xmlns:xi="http://www.w3.org/2001/XInclude" />
+</book>
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/xinclude.mod
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/doc/xinclude.mod Mon Feb 11 09:23:05 2008
@@ -0,0 +1,24 @@
+<!ELEMENT xi:include (xi:fallback?) >
+<!ATTLIST xi:include
+ xmlns:xi CDATA #FIXED "http://www.w3.org/2001/XInclude"
+ href CDATA #REQUIRED
+ parse (xml|text) "xml"
+ encoding CDATA #IMPLIED >
+
+<!ELEMENT xi:fallback ANY>
+<!ATTLIST xi:fallback
+ xmlns:xi CDATA #FIXED "http://www.w3.org/2001/XInclude" >
+
+<!ENTITY % local.book.class "| xi:include">
+
+<!-- inside book elements -->
+<!ENTITY % local.chapter.class "| xi:include">
+<!-- inside chapter or section elements -->
+<!ENTITY % local.divcomponent.mix "| xi:include">
+<!-- inside para, programlisting, literallayout, etc. -->
+<!ENTITY % local.para.char.mix "| xi:include">
+<!-- inside bookinfo, chapterinfo, etc. -->
+<!ENTITY % local.info.class "| xi:include">
+
+<!-- used for xml:base in docbook 4.2 and prior -->
+<!ENTITY % local.common.attrib "xml:base CDATA #IMPLIED">
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/Makefile
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/Makefile Mon Feb 11 09:23:05 2008
@@ -0,0 +1,45 @@
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for UFFI examples
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile 10614 2005-07-06 01:05:14Z kevin $
+#
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+#
+
+SUBDIRS:=
+
+include ../Makefile.common
+
+.PHONY: distclean
+distclean: clean
+
+
+base=c-test-fns
+source=$(base).c
+object=$(base).o
+shared_lib=$(base).so
+
+.PHONY: all
+all: $(shared_lib)
+
+linux: $(source) Makefile
+ gcc -fPIC -DPIC -c $(source) -o $(object)
+ gcc -shared $(object) -o $(shared_lib)
+ rm $(object)
+
+mac:
+ cc -dynamic -c $(source) -o $(object)
+ ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $(base).dylib $(object)
+ ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress /usr/lib/libz.dylib -o z.dylib
+
+solaris:
+ cc -KPIC -c $(source) -o $(object)
+ cc -G $(object) -o $(shared_lib)
+
+aix-acl:
+ gcc -c -D_BSD -D_NO_PROTO -D_NONSTD_TYPES -D_MBI=void $(source)
+ make_shared -o $(shared_lib) $(object)
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/Makefile.msvc
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/Makefile.msvc Mon Feb 11 09:23:05 2008
@@ -0,0 +1,27 @@
+# FILE IDENTIFICATION
+#
+# Name: Makefile.msvc
+# Purpose: Makefile for the CLSQL UFFI helper package (MSVC)
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile.msvc,v 1.1 2002/03/23 10:26:03 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+
+BASE=c-test-fns
+
+# Nothing to configure beyond here
+
+SRC=$(BASE).c
+OBJ=$(BASE).obj
+DLL=$(BASE).dll
+
+$(DLL): $(SRC)
+ cl /MD /LD -D_MT /DWIN32=1 $(SRC)
+ del $(OBJ) $(BASE).exp
+
+clean:
+ del /q $(DLL)
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/acl-compat-tester.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/acl-compat-tester.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,600 @@
+;; tester.cl
+;; A test harness for Allegro CL.
+;;
+;; copyright (c) 1985-1986 Franz Inc, Alameda, CA
+;; copyright (c) 1986-2001 Franz Inc, Berkeley, CA - All rights reserved.
+;;
+;; This code is free software; you can redistribute it and/or
+;; modify it under the terms of the version 2.1 of
+;; the GNU Lesser General Public License as published by
+;; the Free Software Foundation, as clarified by the Franz
+;; preamble to the LGPL found in
+;; http://opensource.franz.com/preamble.html.
+;;
+;; This code is distributed in the hope that it will be useful,
+;; but without any warranty; without even the implied warranty of
+;; merchantability or fitness for a particular purpose. See the GNU
+;; Lesser General Public License for more details.
+;;
+;; Version 2.1 of the GNU Lesser General Public License can be
+;; found at http://opensource.franz.com/license.html.
+;; If it is not present, you can access it from
+;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer
+;; version) or write to the Free Software Foundation, Inc., 59 Temple
+;; Place, Suite 330, Boston, MA 02111-1307 USA
+;;
+;;;; from the original ACL 6.1 sources:
+;; $Id: acl-compat-tester.lisp 7061 2003-09-07 06:34:45Z kevin $
+
+
+(defpackage :util.test
+ (:use :common-lisp)
+ (:shadow #:test)
+ (:export
+;;;; Control variables:
+ #:*break-on-test-failures*
+ #:*error-protect-tests*
+ #:*test-errors*
+ #:*test-successes*
+ #:*test-unexpected-failures*
+
+;;;; The test macros:
+ #:test
+ #:test-error
+ #:test-no-error
+ #:test-warning
+ #:test-no-warning
+
+ #:with-tests
+ ))
+
+(in-package :util.test)
+
+#+cmu
+(unless (find-class 'break nil)
+ (define-condition break (simple-condition) ()))
+
+(define-condition simple-break (error simple-condition) ())
+
+;; the if* macro used in Allegro:
+;;
+;; This is in the public domain... please feel free to put this definition
+;; in your code or distribute it with your version of lisp.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar if*-keyword-list '("then" "thenret" "else" "elseif")))
+
+(defmacro if* (&rest args)
+ (do ((xx (reverse args) (cdr xx))
+ (state :init)
+ (elseseen nil)
+ (totalcol nil)
+ (lookat nil nil)
+ (col nil))
+ ((null xx)
+ (cond ((eq state :compl)
+ `(cond ,@totalcol))
+ (t (error "if*: illegal form ~s" args))))
+ (cond ((and (symbolp (car xx))
+ (member (symbol-name (car xx))
+ if*-keyword-list
+ :test #'string-equal))
+ (setq lookat (symbol-name (car xx)))))
+
+ (cond ((eq state :init)
+ (cond (lookat (cond ((string-equal lookat "thenret")
+ (setq col nil
+ state :then))
+ (t (error
+ "if*: bad keyword ~a" lookat))))
+ (t (setq state :col
+ col nil)
+ (push (car xx) col))))
+ ((eq state :col)
+ (cond (lookat
+ (cond ((string-equal lookat "else")
+ (cond (elseseen
+ (error
+ "if*: multiples elses")))
+ (setq elseseen t)
+ (setq state :init)
+ (push `(t ,@col) totalcol))
+ ((string-equal lookat "then")
+ (setq state :then))
+ (t (error "if*: bad keyword ~s"
+ lookat))))
+ (t (push (car xx) col))))
+ ((eq state :then)
+ (cond (lookat
+ (error
+ "if*: keyword ~s at the wrong place " (car xx)))
+ (t (setq state :compl)
+ (push `(,(car xx) ,@col) totalcol))))
+ ((eq state :compl)
+ (cond ((not (string-equal lookat "elseif"))
+ (error "if*: missing elseif clause ")))
+ (setq state :init)))))
+
+
+
+
+(defvar *break-on-test-failures* nil
+ "When a test failure occurs, common-lisp:break is called, allowing
+interactive debugging of the failure.")
+
+(defvar *test-errors* 0
+ "The value is the number of test errors which have occurred.")
+(defvar *test-successes* 0
+ "The value is the number of test successes which have occurred.")
+(defvar *test-unexpected-failures* 0
+ "The value is the number of unexpected test failures which have occurred.")
+
+(defvar *error-protect-tests* nil
+ "Protect each test from errors. If an error occurs, then that will be
+taken as a test failure unless test-error is being used.")
+
+(defmacro test-values-errorset (form &optional announce catch-breaks)
+ ;; internal macro
+ (let ((g-announce (gensym))
+ (g-catch-breaks (gensym)))
+ `(let* ((,g-announce ,announce)
+ (,g-catch-breaks ,catch-breaks))
+ (handler-case (cons t (multiple-value-list ,form))
+ (condition (condition)
+ (if* (and (null ,g-catch-breaks)
+ (typep condition 'simple-break))
+ then (break condition)
+ elseif ,g-announce
+ then (format *error-output* "~&Condition type: ~a~%"
+ (class-of condition))
+ (format *error-output* "~&Message: ~a~%" condition))
+ condition)))))
+
+(defmacro test-values (form &optional announce catch-breaks)
+ ;; internal macro
+ (if* *error-protect-tests*
+ then `(test-values-errorset ,form ,announce ,catch-breaks)
+ else `(cons t (multiple-value-list ,form))))
+
+(defmacro test (expected-value test-form
+ &key (test #'eql test-given)
+ (multiple-values nil multiple-values-given)
+ (fail-info nil fail-info-given)
+ (known-failure nil known-failure-given)
+
+;;;;;;;;;; internal, undocumented keywords:
+;;;; Note about these keywords: if they were documented, we'd have a
+;;;; problem, since they break the left-to-right order of evaluation.
+;;;; Specifically, errorset breaks it, and I don't see any way around
+;;;; that. `errorset' is used by the old test.cl module (eg,
+;;;; test-equal-errorset).
+ errorset
+ reported-form
+ (wanted-message nil wanted-message-given)
+ (got-message nil got-message-given))
+ "Perform a single test. `expected-value' is the reference value for the
+test. `test-form' is a form that will produce the value to be compared to
+the expected-value. If the values are not the same, then an error is
+logged, otherwise a success is logged.
+
+Normally the comparison of values is done with `eql'. The `test' keyword
+argument can be used to specify other comparison functions, such as eq,
+equal,equalp, string=, string-equal, etc.
+
+Normally, only the first return value from the test-form is considered,
+however if `multiple-values' is t, then all values returned from test-form
+are considered.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure. This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+ `(test-check
+ :expected-result ,expected-value
+ :test-results
+ (,(if errorset 'test-values-errorset 'test-values) ,test-form t)
+ ,@(when test-given `(:predicate ,test))
+ ,@(when multiple-values-given `(:multiple-values ,multiple-values))
+ ,@(when fail-info-given `(:fail-info ,fail-info))
+ ,@(when known-failure-given `(:known-failure ,known-failure))
+ :test-form ',(if reported-form reported-form test-form)
+ ,@(when wanted-message-given `(:wanted-message ,wanted-message))
+ ,@(when got-message-given `(:got-message ,got-message))))
+
+(defmethod conditionp ((thing condition)) t)
+(defmethod conditionp ((thing t)) nil)
+
+(defmacro test-error (form &key announce
+ catch-breaks
+ (fail-info nil fail-info-given)
+ (known-failure nil known-failure-given)
+ (condition-type ''simple-error)
+ (include-subtypes nil include-subtypes-given)
+ (format-control nil format-control-given)
+ (format-arguments nil format-arguments-given))
+ "Test that `form' signals an error. The order of evaluation of the
+arguments is keywords first, then test form.
+
+If `announce' is non-nil, then cause the error message to be printed.
+
+The `catch-breaks' is non-nil then consider a call to common-lisp:break an
+`error'.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure. This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures.
+
+If `condition-type' is non-nil, it should be a symbol naming a condition
+type, which is used to check against the signalled condition type. The
+test will fail if they do not match.
+
+`include-subtypes', used with `condition-type', can be used to match a
+condition to an entire subclass of the condition type hierarchy.
+
+`format-control' and `format-arguments' can be used to check the error
+message itself."
+ (let ((g-announce (gensym))
+ (g-catch-breaks (gensym))
+ (g-fail-info (gensym))
+ (g-known-failure (gensym))
+ (g-condition-type (gensym))
+ (g-include-subtypes (gensym))
+ (g-format-control (gensym))
+ (g-format-arguments (gensym))
+ (g-c (gensym)))
+ `(let* ((,g-announce ,announce)
+ (,g-catch-breaks ,catch-breaks)
+ ,@(when fail-info-given `((,g-fail-info ,fail-info)))
+ ,@(when known-failure-given `((,g-known-failure ,known-failure)))
+ (,g-condition-type ,condition-type)
+ ,@(when include-subtypes-given
+ `((,g-include-subtypes ,include-subtypes)))
+ ,@(when format-control-given
+ `((,g-format-control ,format-control)))
+ ,@(when format-arguments-given
+ `((,g-format-arguments ,format-arguments)))
+ (,g-c (test-values-errorset ,form ,g-announce ,g-catch-breaks)))
+ (test-check
+ :predicate #'eq
+ :expected-result t
+ :test-results
+ (test-values (and (conditionp ,g-c)
+ ,@(if* include-subtypes-given
+ then `((if* ,g-include-subtypes
+ then (typep ,g-c ,g-condition-type)
+ else (eq (class-of ,g-c)
+ (find-class
+ ,g-condition-type))))
+ else `((eq (class-of ,g-c)
+ (find-class ,g-condition-type))))
+ ,@(when format-control-given
+ `((or
+ (null ,g-format-control)
+ (string=
+ (concatenate 'simple-string
+ "~1@<" ,g-format-control "~:@>")
+ (simple-condition-format-control ,g-c)))))
+ ,@(when format-arguments-given
+ `((or
+ (null ,g-format-arguments)
+ (equal
+ ,g-format-arguments
+ (simple-condition-format-arguments ,g-c))))))
+ t)
+ :test-form ',form
+ ,@(when fail-info-given `(:fail-info ,g-fail-info))
+ ,@(when known-failure-given `(:known-failure ,g-known-failure))
+ :condition-type ,g-condition-type
+ :condition ,g-c
+ ,@(when include-subtypes-given
+ `(:include-subtypes ,g-include-subtypes))
+ ,@(when format-control-given
+ `(:format-control ,g-format-control))
+ ,@(when format-arguments-given
+ `(:format-arguments ,g-format-arguments))))))
+
+(defmacro test-no-error (form &key announce
+ catch-breaks
+ (fail-info nil fail-info-given)
+ (known-failure nil known-failure-given))
+ "Test that `form' does not signal an error. The order of evaluation of
+the arguments is keywords first, then test form.
+
+If `announce' is non-nil, then cause the error message to be printed.
+
+The `catch-breaks' is non-nil then consider a call to common-lisp:break an
+`error'.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure. This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+ (let ((g-announce (gensym))
+ (g-catch-breaks (gensym))
+ (g-fail-info (gensym))
+ (g-known-failure (gensym))
+ (g-c (gensym)))
+ `(let* ((,g-announce ,announce)
+ (,g-catch-breaks ,catch-breaks)
+ ,@(when fail-info-given `((,g-fail-info ,fail-info)))
+ ,@(when known-failure-given `((,g-known-failure ,known-failure)))
+ (,g-c (test-values-errorset ,form ,g-announce ,g-catch-breaks)))
+ (test-check
+ :predicate #'eq
+ :expected-result t
+ :test-results (test-values (not (conditionp ,g-c)))
+ :test-form ',form
+ :condition ,g-c
+ ,@(when fail-info-given `(:fail-info ,g-fail-info))
+ ,@(when known-failure-given `(:known-failure ,g-known-failure))))))
+
+(defvar *warn-cookie* (cons nil nil))
+
+(defmacro test-warning (form &key fail-info known-failure)
+ "Test that `form' signals a warning. The order of evaluation of
+the arguments is keywords first, then test form.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure. This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+ (let ((g-fail-info (gensym))
+ (g-known-failure (gensym))
+ (g-value (gensym)))
+ `(let* ((,g-fail-info ,fail-info)
+ (,g-known-failure ,known-failure)
+ (,g-value (test-values-errorset ,form nil t)))
+ (test
+ *warn-cookie*
+ (if* (or (typep ,g-value 'simple-warning) (typep ,g-value 'warning))
+ then *warn-cookie*
+ else ;; test produced no warning
+ nil)
+ :test #'eq
+ :reported-form ,form ;; quoted by test macro
+ :wanted-message "a warning"
+ :got-message "no warning"
+ :fail-info ,g-fail-info
+ :known-failure ,g-known-failure))))
+
+(defmacro test-no-warning (form &key fail-info known-failure)
+ "Test that `form' does not signal a warning. The order of evaluation of
+the arguments is keywords first, then test form.
+
+`fail-info' allows more information to be printed with a test failure.
+
+`known-failure' marks the test as a known failure. This allows for
+programs that do regression analysis on the output from a test run to
+discriminate on new versus known failures."
+ (let ((g-fail-info (gensym))
+ (g-known-failure (gensym))
+ (g-value (gensym)))
+ `(let* ((,g-fail-info ,fail-info)
+ (,g-known-failure ,known-failure)
+ (,g-value (test-values-errorset ,form nil t)))
+ (test
+ *warn-cookie*
+ (if* (or (typep ,g-value 'simple-warning) (typep ,g-value 'warning))
+ then nil ;; test produced warning
+ else *warn-cookie*)
+ :test #'eq
+ :reported-form ',form
+ :wanted-message "no warning"
+ :got-message "a warning"
+ :fail-info ,g-fail-info
+ :known-failure ,g-known-failure))))
+
+(defvar *announce-test* nil) ;; if true announce each test that was done
+
+(defmacro errorset (form &optional announce catch-breaks)
+ ;; Evaluate FORM, and if there are no errors and FORM returns
+ ;; values v1,v2,...,vn, then return values t,v1,v2,...,vn. If an
+ ;; error occurs while evaluating FORM, then return nil immediately.
+ ;; If ANNOUNCE is t, then the error message will be printed out.
+ (if catch-breaks
+ `(handler-case (values-list (cons t (multiple-value-list ,form)))
+ (error (condition)
+ (declare (ignorable condition))
+ ,@(if announce `((format *error-output* "~&Error: ~a~%" condition)))
+ nil)
+ (simple-break (condition)
+ (declare (ignorable condition))
+ ,@(if announce `((format *error-output* "~&Warning: ~a~%" condition))
+)
+ nil))
+ `(handler-case (values-list (cons t (multiple-value-list ,form)))
+ (error (condition)
+ (declare (ignorable condition))
+ ,@(if announce `((format *error-output* "~&Error: ~a~%" condition)))
+ nil))))
+
+(defun test-check (&key (predicate #'eql)
+ expected-result test-results test-form
+ multiple-values fail-info known-failure
+ wanted-message got-message condition-type condition
+ include-subtypes format-control format-arguments
+ &aux fail predicate-failed got wanted)
+ ;; for debugging large/complex test sets:
+ (when *announce-test*
+ (format t "Just did test ~s~%" test-form)
+ (force-output))
+
+ ;; this is an internal function
+ (flet ((check (expected-result result)
+ (let* ((results
+ (multiple-value-list
+ (errorset (funcall predicate expected-result result) t)))
+ (failed (null (car results))))
+ (if* failed
+ then (setq predicate-failed t)
+ nil
+ else (cadr results)))))
+ (when (conditionp test-results)
+ (setq condition test-results)
+ (setq test-results nil))
+ (when (null (car test-results))
+ (setq fail t))
+ (if* (and (not fail) (not multiple-values))
+ then ;; should be a single result
+ ;; expected-result is the single result wanted
+ (when (not (and (cdr test-results)
+ (check expected-result (cadr test-results))))
+ (setq fail t))
+ (when (and (not fail) (cddr test-results))
+ (setq fail 'single-got-multiple))
+ else ;; multiple results wanted
+ ;; expected-result is a list of results, each of which
+ ;; should be checked against the corresponding test-results
+ ;; using the predicate
+ (do ((got (cdr test-results) (cdr got))
+ (want expected-result (cdr want)))
+ ((or (null got) (null want))
+ (when (not (and (null want) (null got)))
+ (setq fail t)))
+ (when (not (check (car got) (car want)))
+ (return (setq fail t)))))
+ (if* fail
+ then (when (not known-failure)
+ (format *error-output*
+ "~& * * * UNEXPECTED TEST FAILURE * * *~%")
+ (incf *test-unexpected-failures*))
+ (format *error-output* "~&Test failed: ~@[known failure: ~*~]~s~%"
+ known-failure test-form)
+ (if* (eq 'single-got-multiple fail)
+ then (format
+ *error-output*
+ "~
+Reason: additional value were returned from test form.~%")
+ elseif predicate-failed
+ then (format *error-output* "Reason: predicate error.~%")
+ elseif (null (car test-results))
+ then (format *error-output* "~
+Reason: an error~@[ (of type `~s')~] was detected.~%"
+ (when condition (class-of condition)))
+ elseif condition
+ then (if* (not (conditionp condition))
+ then (format *error-output* "~
+Reason: expected but did not detect an error of type `~s'.~%"
+ condition-type)
+ elseif (null condition-type)
+ then (format *error-output* "~
+Reason: detected an unexpected error of type `~s':
+ ~a.~%"
+ (class-of condition)
+ condition)
+ elseif (not (if* include-subtypes
+ then (typep condition condition-type)
+ else (eq (class-of condition)
+ (find-class condition-type))))
+ then (format *error-output* "~
+Reason: detected an incorrect condition type.~%")
+ (format *error-output*
+ " wanted: ~s~%" condition-type)
+ (format *error-output*
+ " got: ~s~%" (class-of condition))
+ elseif (and format-control
+ (not (string=
+ (setq got
+ (concatenate 'simple-string
+ "~1@<" format-control "~:@>"))
+ (setq wanted
+ (simple-condition-format-control
+ condition)))))
+ then ;; format control doesn't match
+ (format *error-output* "~
+Reason: the format-control was incorrect.~%")
+ (format *error-output* " wanted: ~s~%" wanted)
+ (format *error-output* " got: ~s~%" got)
+ elseif (and format-arguments
+ (not (equal
+ (setq got format-arguments)
+ (setq wanted
+ (simple-condition-format-arguments
+ condition)))))
+ then (format *error-output* "~
+Reason: the format-arguments were incorrect.~%")
+ (format *error-output* " wanted: ~s~%" wanted)
+ (format *error-output* " got: ~s~%" got)
+ else ;; what else????
+ (error "internal-error"))
+ else (let ((*print-length* 50)
+ (*print-level* 10))
+ (if* wanted-message
+ then (format *error-output*
+ " wanted: ~a~%" wanted-message)
+ else (if* (not multiple-values)
+ then (format *error-output*
+ " wanted: ~s~%"
+ expected-result)
+ else (format
+ *error-output*
+ " wanted values: ~{~s~^, ~}~%"
+ expected-result)))
+ (if* got-message
+ then (format *error-output*
+ " got: ~a~%" got-message)
+ else (if* (not multiple-values)
+ then (format *error-output* " got: ~s~%"
+ (second test-results))
+ else (format
+ *error-output*
+ " got values: ~{~s~^, ~}~%"
+ (cdr test-results))))))
+ (when fail-info
+ (format *error-output* "Additional info: ~a~%" fail-info))
+ (incf *test-errors*)
+ (when *break-on-test-failures*
+ (break "~a is non-nil." '*break-on-test-failures*))
+ else (when known-failure
+ (format *error-output*
+ "~&Expected test failure for ~s did not occur.~%"
+ test-form)
+ (when fail-info
+ (format *error-output* "Additional info: ~a~%" fail-info))
+ (setq fail t))
+ (incf *test-successes*))
+ (not fail)))
+
+(defmacro with-tests ((&key (name "unnamed")) &body body)
+ (let ((g-name (gensym)))
+ `(flet ((doit () ,@body))
+ (let ((,g-name ,name)
+ (*test-errors* 0)
+ (*test-successes* 0)
+ (*test-unexpected-failures* 0))
+ (format *error-output* "Begin ~a test~%" ,g-name)
+ (if* *break-on-test-failures*
+ then (doit)
+ else (handler-case (doit)
+ (error (c)
+ (format
+ *error-output*
+ "~
+~&Test ~a aborted by signalling an uncaught error:~%~a~%"
+ ,g-name c))))
+ #+allegro
+ (let ((state (sys:gsgc-switch :print)))
+ (setf (sys:gsgc-switch :print) nil)
+ (format t "~&**********************************~%" ,g-name)
+ (format t "End ~a test~%" ,g-name)
+ (format t "Errors detected in this test: ~s " *test-errors*)
+ (unless (zerop *test-unexpected-failures*)
+ (format t "UNEXPECTED: ~s" *test-unexpected-failures*))
+ (format t "~%Successes this test:~s~%" *test-successes*)
+ (setf (sys:gsgc-switch :print) state))
+ #-allegro
+ (progn
+ (format t "~&**********************************~%" ,g-name)
+ (format t "End ~a test~%" ,g-name)
+ (format t "Errors detected in this test: ~s " *test-errors*)
+ (unless (zerop *test-unexpected-failures*)
+ (format t "UNEXPECTED: ~s" *test-unexpected-failures*))
+ (format t "~%Successes this test:~s~%" *test-successes*))
+ ))))
+
+(provide :tester #+module-versions 1.1)
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/arrays.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/arrays.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,63 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: arrays.cl
+;;;; Purpose: UFFI Example file to test arrays
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: arrays.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-constant +column-length+ 10)
+(uffi:def-constant +row-length+ 10)
+
+(uffi:def-foreign-type long-ptr (* :long))
+
+(defun test-array-1d ()
+ "Tests vector"
+ (let ((a (uffi:allocate-foreign-object :long +column-length+)))
+ (dotimes (i +column-length+)
+ (setf (uffi:deref-array a '(:array :long) i) (* i i)))
+ (dotimes (i +column-length+)
+ (format t "~&~D => ~D" i (uffi:deref-array a '(:array :long) i)))
+ (uffi:free-foreign-object a))
+ (values))
+
+(defun test-array-2d ()
+ "Tests 2d array"
+ (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+)))
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (setf (uffi:deref-array a '(:array (* :long)) r)
+ (uffi:allocate-foreign-object :long +column-length+))
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c)))))
+
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (format t "~&Row ~D: " r)
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (let ((result (uffi:deref-array col '(:array :long) c)))
+ (format t "~d " result)))))
+
+ (uffi:free-foreign-object a))
+ (values))
+
+#+examples-uffi
+(test-array-1d)
+
+#+examples-uffi
+(test-array-2d)
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/atoifl.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/atoifl.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,56 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: atoifl.cl
+;;;; Purpose: UFFI Example file to atoi/atof/atol
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: atoifl.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-function ("atoi" c-atoi)
+ ((str :cstring))
+ :returning :int)
+
+(uffi:def-function ("atol" c-atol)
+ ((str :cstring))
+ :returning :long)
+
+(uffi:def-function ("atof" c-atof)
+ ((str :cstring))
+ :returning :double)
+
+(defun atoi (str)
+ "Returns a int from a string."
+ (uffi:with-cstring (str-cstring str)
+ (c-atoi str-cstring)))
+
+(defun atof (str)
+ "Returns a double float from a string."
+ (uffi:with-cstring (str-cstring str)
+ (c-atof str-cstring)))
+
+#+examples-uffi
+(progn
+ (flet ((print-results (str)
+ (format t "~&(atoi ~S) => ~S" str (atoi str))))
+ (print-results "55")))
+
+
+#+test-uffi
+(progn
+ (util.test:test (atoi "123") 123 :test #'eql
+ :fail-info "Error with atoi")
+ (util.test:test (atoi "") 0 :test #'eql
+ :fail-info "Error with atoi")
+ (util.test:test (atof "2.23") 2.23d0 :test #'eql
+ :fail-info "Error with atof")
+ )
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/c-test-fns.c
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/c-test-fns.c Mon Feb 11 09:23:05 2008
@@ -0,0 +1,91 @@
+/***************************************************************************
+ * FILE IDENTIFICATION
+ *
+ * Name: c-test-fns.c
+ * Purpose: Test functions in C for UFFI library
+ * Programer: Kevin M. Rosenberg
+ * Date Started: Mar 2002
+ *
+ * CVS Id: $Id: c-test-fns.c 10614 2005-07-06 01:05:14Z kevin $
+ *
+ * This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+ *
+ * These variables are correct for GCC
+ * you'll need to modify these for other compilers
+ ***************************************************************************/
+
+#ifdef WIN32
+#include <windows.h>
+
+BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll,
+ DWORD fdwReason,
+ LPVOID lpvReserved)
+{
+ return 1;
+}
+
+#define DLLEXPORT __declspec(dllexport)
+
+#else
+#define DLLEXPORT
+#endif
+
+#include <ctype.h>
+#include <stdlib.h>
+#include <math.h>
+
+
+/* Test of constant input string */
+DLLEXPORT
+int
+cs_count_upper (char* psz)
+{
+ int count = 0;
+
+ if (psz) {
+ while (*psz) {
+ if (isupper (*psz))
+ ++count;
+ ++psz;
+ }
+ return count;
+ } else
+ return -1;
+}
+
+/* Test of input and output of a string */
+DLLEXPORT
+void
+cs_to_upper (char* psz)
+{
+ if (psz) {
+ while (*psz) {
+ *psz = toupper (*psz);
+ ++psz;
+ }
+ }
+}
+
+/* Test of an output only string */
+DLLEXPORT
+void
+cs_make_random (int size, char* buffer)
+{
+ int i;
+ for (i = 0; i < size; i++)
+ buffer[i] = 'A' + (rand() % 26);
+}
+
+
+/* Test of input/output vector */
+DLLEXPORT
+void
+half_double_vector (int size, double* vec)
+{
+ int i;
+ for (i = 0; i < size; i++)
+ vec[i] /= 2.;
+}
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/c-test-fns.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/c-test-fns.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,118 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: c-test-fns.cl
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: c-test-fns.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(unless (uffi:load-foreign-library
+ (uffi:find-foreign-library "c-test-fns"
+ (list *load-truename* "/home/kevin/debian/src/uffi/examples/"))
+ :supporting-libraries '("c"))
+ (warn "Unable to load c-test-fns library"))
+
+(uffi:def-function ("cs_to_upper" cs-to-upper)
+ ((input (* :unsigned-char)))
+ :returning :void
+ )
+
+(defun string-to-upper (str)
+ (uffi:with-foreign-string (str-foreign str)
+ (cs-to-upper str-foreign)
+ (uffi:convert-from-foreign-string str-foreign)))
+
+(uffi:def-function ("cs_count_upper" cs-count-upper)
+ ((input :cstring))
+ :returning :int
+ )
+
+(defun string-count-upper (str)
+ (uffi:with-cstring (str-cstring str)
+ (cs-count-upper str-cstring)))
+
+(uffi:def-function ("half_double_vector" half-double-vector)
+ ((size :int)
+ (vec (* :double)))
+ :returning :void)
+
+(uffi:def-constant +double-vec-length+ 10)
+(defun test-half-double-vector ()
+ (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
+ results)
+ (dotimes (i +double-vec-length+)
+ (setf (uffi:deref-array vec '(:array :double) i)
+ (coerce i 'double-float)))
+ (half-double-vector +double-vec-length+ vec)
+ (dotimes (i +double-vec-length+)
+ (push (uffi:deref-array vec '(:array :double) i) results))
+ (uffi:free-foreign-object vec)
+ (nreverse results)))
+
+(defun t2 ()
+ (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+ (dotimes (i +double-vec-length+)
+ (setf (aref vec i) (coerce i 'double-float)))
+ (half-double-vector +double-vec-length+ vec)
+ vec))
+
+#+(or cmu scl)
+(defun t3 ()
+ (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+ (dotimes (i +double-vec-length+)
+ (setf (aref vec i) (coerce i 'double-float)))
+ (system:without-gcing
+ (half-double-vector +double-vec-length+ (system:vector-sap vec)))
+ vec))
+
+#+examples-uffi
+(format t "~&(string-to-upper \"this is a test\") => ~A"
+ (string-to-upper "this is a test"))
+
+#+examples-uffi
+(format t "~&(string-to-upper nil) => ~A"
+ (string-to-upper nil))
+
+#+examples-uffi
+(format t "~&(string-count-upper \"This is a Test\") => ~A"
+ (string-count-upper "This is a Test"))
+
+#+examples-uffi
+(format t "~&(string-count-upper nil) => ~A"
+ (string-count-upper nil))
+
+#+examples-uffi
+(format t "~&Half vector: ~S" (test-half-double-vector))
+
+
+
+#+test-uffi
+(progn
+ (util.test:test (string= (string-to-upper "this is a test") "THIS IS A TEST")
+ t
+ :test #'eql
+ :fail-info "Error with string-to-upper")
+ (util.test:test (string-to-upper nil) nil
+ :fail-info "string-to-upper with nil failed")
+ (util.test:test (string-count-upper "This is a Test")
+ 2
+ :test #'eql
+ :fail-info "Error with string-count-upper")
+ (util.test:test (string-count-upper nil) -1
+ :test #'eql
+ :fail-info "string-count-upper with nil failed")
+
+ (util.test:test (test-half-double-vector)
+ '(0.0d0 0.5d0 1.0d0 1.5d0 2.0d0 2.5d0 3.0d0 3.5d0 4.0d0 4.5d0)
+ :test #'equal
+ :fail-info "Error comparing half-double-vector")
+ )
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/compress.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/compress.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,116 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.cl
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: compress.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(eval-when (:load-toplevel :execute)
+ (unless (uffi:load-foreign-library
+ #-(or macosx darwin)
+ (uffi:find-foreign-library
+ "libz"
+ '("/usr/local/lib/" "/usr/lib/" "/zlib/")
+ :types '("so" "a"))
+ #+(or macosx darwin)
+ (uffi:find-foreign-library "z"
+ `(,(pathname-directory *load-pathname*)))
+ :module "zlib"
+ :supporting-libraries '("c"))
+ (warn "Unable to load zlib")))
+
+(uffi:def-function ("compress" c-compress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun compress (source)
+ "Returns two values: array of bytes containing the compressed data
+ and the numbe of compressed bytes"
+ (let* ((sourcelen (length source))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-compress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(uffi:def-function ("uncompress" c-uncompress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun uncompress (source)
+ (let* ((sourcelen (length source))
+ (destsize 200000) ;adjust as needed
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-uncompress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+#+examples-uffi
+(progn
+ (flet ((print-results (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (let ((*print-length* nil))
+ (format t "~&(compress ~S) => " str)
+ (format t "~S~%" (map 'list #'char-code compressed))))))
+ (print-results "")
+ (print-results "test")
+ (print-results "test2")))
+
+#+test-uffi
+(progn
+ (flet ((test-compress (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (multiple-value-bind (uncompressed len2) (uncompress compressed)
+ (util.test:test str uncompressed :test #'string=
+ :fail-info "Error uncompressing a compressed string")))))
+ (test-compress "")
+ (test-compress "test")
+ (test-compress "test2")))
+
+;; Results of the above on my system:
+;; (compress "") => 789c300001,8
+;; (compress "test") => 789c2b492d2e1045d1c1,12
+;; (compress "test2") => 789c2b492d2e31206501f3,13
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/file-socket.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/file-socket.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,39 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: file-socket.cl
+;;;; Purpose: UFFI Example file to get a socket on a file
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Jul 2002
+;;;;
+;;;; $Id: file-socket.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+;; Values for linux
+(uffi:def-constant PF_UNIX 1)
+(uffi:def-constant SOCK_STREAM 1)
+
+(uffi:def-function ("socket" c-socket)
+ ((family :int)
+ (type :int)
+ (protocol :int))
+ :returning :int)
+
+(uffi:def-function ("connect" c-connect)
+ ((sockfd :int)
+ (serv-addr :void-pointer)
+ (addr-len :int))
+ :returning :int)
+
+(defun connect-to-file-socket (filename)
+ (let ((socket (c-socket PF_UNIX SOCK_STREAM 0)))
+ (if (plusp socket)
+ (let ((stream (c-connect socket filename (length filename))))
+ stream)
+ (error "Unable to create socket"))))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/getenv.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/getenv.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,44 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.cl
+;;;; Purpose: UFFI Example file to get environment variable
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: getenv.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+(uffi:def-function ("getenv" c-getenv)
+ ((name :cstring))
+ :returning :cstring)
+
+(defun my-getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-cstring (key-native key)
+ (uffi:convert-from-cstring (c-getenv key-native))))
+
+#+examples-uffi
+(progn
+ (flet ((print-results (str)
+ (format t "~&(getenv ~S) => ~S" str (my-getenv str))))
+ (print-results "USER")
+ (print-results "_FOO_")))
+
+
+#+test-uffi
+(progn
+ (util.test:test (my-getenv "_FOO_") nil :fail-info "Error retrieving non-existent getenv")
+ (util.test:test (and (stringp (my-getenv "USER"))
+ (< 0 (length (my-getenv "USER"))))
+ t :fail-info "Error retrieving getenv")
+)
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/gethostname.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/gethostname.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,63 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: gethostname.cl
+;;;; Purpose: UFFI Example file to get hostname of system
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: gethostname.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+;;; This example is inspired by the example on the CL-Cookbook web site
+
+(uffi:def-function ("gethostname" c-gethostname)
+ ((name (* :unsigned-char))
+ (len :int))
+ :returning :int)
+
+(defun gethostname ()
+ "Returns the hostname"
+ (let* ((name (uffi:allocate-foreign-string 256))
+ (result-code (c-gethostname name 256))
+ (hostname (when (zerop result-code)
+ (uffi:convert-from-foreign-string name))))
+ (uffi:free-foreign-object name)
+ (unless (zerop result-code)
+ (error "gethostname() failed."))
+ hostname))
+
+(defun gethostname2 ()
+ "Returns the hostname"
+ (uffi:with-foreign-object (name '(:array :unsigned-char 256))
+ (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
+ (uffi:convert-from-foreign-string name)
+ (error "gethostname() failed."))))
+
+#+examples-uffi
+(progn
+ (format t "~&Hostname (technique 1): ~A" (gethostname))
+ (format t "~&Hostname (technique 2): ~A" (gethostname2)))
+
+#+test-uffi
+(progn
+ (let ((hostname1 (gethostname))
+ (hostname2 (gethostname2)))
+
+ (util.test:test (and (stringp hostname1) (stringp hostname2)) t
+ :fail-info "gethostname not string")
+ (util.test:test (and (not (zerop (length hostname1)))
+ (not (zerop (length hostname2)))) t
+ :fail-info "gethostname length 0")
+ (util.test:test (string= hostname1 hostname1) t
+ :fail-info "gethostname techniques don't match"))
+ )
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/getshells.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/getshells.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,44 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getshells.cl
+;;;; Purpose: UFFI Example file to get lisp of legal shells
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: getshells.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+
+(uffi:def-function "setusershell"
+ nil
+ :returning :void)
+
+(uffi:def-function "endusershell"
+ nil
+ :returning :void)
+
+(uffi:def-function "getusershell"
+ nil
+ :returning :cstring)
+
+(defun getshells ()
+ "Returns list of valid shells"
+ (setusershell)
+ (let (shells)
+ (do ((shell (uffi:convert-from-cstring (getusershell))
+ (uffi:convert-from-cstring (getusershell))))
+ ((null shell))
+ (push shell shells))
+ (endusershell)
+ (nreverse shells)))
+
+#+examples-uffi
+(format t "~&Shells: ~S" (getshells))
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/gettime.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/gettime.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,73 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: gettime
+;;;; Purpose: UFFI Example file to get time, use C structures
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: gettime.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-foreign-type time-t :unsigned-long)
+
+(uffi:def-struct tm
+ (sec :int)
+ (min :int)
+ (hour :int)
+ (mday :int)
+ (mon :int)
+ (year :int)
+ (wday :int)
+ (yday :int)
+ (isdst :int))
+
+(uffi:def-function ("time" c-time)
+ ((time (* time-t)))
+ :returning time-t)
+
+(uffi:def-function ("localtime" c-localtime)
+ ((time (* time-t)))
+ :returning (* tm))
+
+(uffi:def-type time-t :unsigned-long)
+(uffi:def-type tm-pointer (* tm))
+
+(defun gettime ()
+ "Returns the local time"
+ (uffi:with-foreign-object (time 'time-t)
+;; (declare (type time-t time))
+ (c-time time)
+ (let ((tm-ptr (the tm-pointer (c-localtime time))))
+ (declare (type tm-pointer tm-ptr))
+ (let ((time-string (format nil "~2d/~2,'0d/~d ~2d:~2,'0d:~2,'0d"
+ (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
+ (uffi:get-slot-value tm-ptr 'tm 'mday)
+ (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
+ (uffi:get-slot-value tm-ptr 'tm 'hour)
+ (uffi:get-slot-value tm-ptr 'tm 'min)
+ (uffi:get-slot-value tm-ptr 'tm 'sec)
+ )))
+ time-string))))
+
+
+
+
+#+examples-uffi
+(format t "~&~A" (gettime))
+
+#+test-uffi
+(progn
+ (let ((time (gettime)))
+ (util.test:test (stringp time) t :fail-info "Time is not a string")
+ (util.test:test (plusp (parse-integer time :junk-allowed t))
+ t
+ :fail-info "time string does not start with a number")))
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/run-examples.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/run-examples.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,36 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: run-examples.cl
+;;;; Purpose: Load and execute all examples for UFFI
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: run-examples.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+#-uffi (asdf:oos 'asdf:load-op :uffi)
+
+(pushnew :examples-uffi cl:*features*)
+
+(flet ((load-test (name)
+ (load (make-pathname :defaults *load-truename* :name name))))
+ (load-test "c-test-fns")
+ (load-test "arrays")
+ (load-test "union")
+ (load-test "strtol")
+ (load-test "atoifl")
+ (load-test "gettime")
+ (load-test "getenv")
+ (load-test "gethostname")
+ (load-test "getshells")
+ (load-test "compress"))
+
+(setq cl:*features* (remove :examples-uffi cl:*features*))
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/strtol.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/strtol.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,80 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: strtol.cl
+;;;; Purpose: UFFI Example file to strtol, uses pointer arithmetic
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: strtol.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-foreign-type char-ptr (* :unsigned-char))
+
+;; This example does not use :cstring to pass the input string since
+;; the routine needs to do pointer arithmetic to see how many characters
+;; were parsed
+
+(uffi:def-function ("strtol" c-strtol)
+ ((nptr char-ptr)
+ (endptr (* char-ptr))
+ (base :int))
+ :returning :long)
+
+(defun strtol (str &optional (base 10))
+ "Returns a long int from a string. Returns number and condition flag.
+Condition flag is T if all of string parses as a long, NIL if
+their was no string at all, or an integer indicating position in string
+of first non-valid character"
+ (let* ((str-native (uffi:convert-to-foreign-string str))
+ (endptr (uffi:allocate-foreign-object 'char-ptr))
+ (value (c-strtol str-native endptr base))
+ (endptr-value (uffi:deref-pointer endptr 'char-ptr)))
+
+ (unwind-protect
+ (if (uffi:null-pointer-p endptr-value)
+ (values value t)
+ (let ((next-char-value (uffi:deref-pointer endptr-value :unsigned-char))
+ (chars-parsed (- (uffi:pointer-address endptr-value)
+ (uffi:pointer-address str-native))))
+ (cond
+ ((zerop chars-parsed)
+ (values nil nil))
+ ((uffi:null-char-p next-char-value)
+ (values value t))
+ (t
+ (values value chars-parsed)))))
+ (progn
+ (uffi:free-foreign-object str-native)
+ (uffi:free-foreign-object endptr)))))
+
+
+
+#+examples-uffi
+(progn
+ (flet ((print-results (str)
+ (multiple-value-bind (result flag) (strtol str)
+ (format t "~&(strtol ~S) => ~S,~S" str result flag))))
+ (print-results "55")
+ (print-results "55.3")
+ (print-results "a")))
+
+#+test-uffi
+(progn
+ (flet ((test-strtol (str results)
+ (util.test:test (multiple-value-list (strtol str)) results
+ :test #'equal
+ :fail-info "Error testing strtol")))
+ (test-strtol "123" '(123 t))
+ (test-strtol "0" '(0 t))
+ (test-strtol "55a" '(55 2))
+ (test-strtol "a" '(nil nil))))
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/test-examples.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/test-examples.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,40 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: test-examples.cl
+;;;; Purpose: Load and execute all examples for UFFI
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: test-examples.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+#-uffi (asdf:oos 'asdf:load-op :uffi)
+
+(unless (ignore-errors (find-package :util.test))
+ (load (make-pathname :name "acl-compat-tester" :defaults *load-truename*)))
+
+(defun do-tests ()
+ (pushnew :test-uffi cl:*features*)
+ (util.test:with-tests (:name "UFFI-Tests")
+ (setq util.test:*break-on-test-failures* nil)
+ (flet ((load-test (name)
+ (load (make-pathname :name name :defaults *load-truename*))))
+ (load-test "c-test-fns")
+ (load-test "arrays")
+ (load-test "union")
+ (load-test "strtol")
+ (load-test "atoifl")
+ (load-test "gettime")
+ (load-test "getenv")
+ (load-test "gethostname")
+ (load-test "getshells")
+ (load-test "compress"))
+ (setq cl:*features* (remove :test-uffi cl:*features*))))
+
+(do-tests)
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/union.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/examples/union.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,86 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: union.cl
+;;;; Purpose: UFFI Example file to test unions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: union.lisp 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(uffi:def-union tunion1
+ (char :char)
+ (int :int)
+ (uint :unsigned-int)
+ (sf :float)
+ (df :double))
+
+(defun run-union-1 ()
+ (let ((u (uffi:allocate-foreign-object 'tunion1)))
+ (setf (uffi:get-slot-value u 'tunion1 'uint)
+ ;; little endian
+ #-(or sparc sparc-v9 powerpc ppc big-endian)
+ (+ (* 1 (char-code #\A))
+ (* 256 (char-code #\B))
+ (* 65536 (char-code #\C))
+ (* 16777216 255))
+ ;; big endian
+ #+(or sparc sparc-v9 powerpc ppc big-endian)
+ (+ (* 16777216 (char-code #\A))
+ (* 65536 (char-code #\B))
+ (* 256 (char-code #\C))
+ (* 1 255)))
+ (format *standard-output* "~&Should be #\A: ~S"
+ (uffi:ensure-char-character
+ (uffi:get-slot-value u 'tunion1 'char)))
+;; (format *standard-output* "~&Should be negative number: ~D"
+;; (uffi:get-slot-value u 'tunion1 'int))
+ (format *standard-output* "~&Should be positive number: ~D"
+ (uffi:get-slot-value u 'tunion1 'uint))
+ (uffi:free-foreign-object u))
+ (values))
+
+#+test-uffi
+(defun test-union-1 ()
+ (let ((u (uffi:allocate-foreign-object 'tunion1)))
+ (setf (uffi:get-slot-value u 'tunion1 'uint)
+ #-(or sparc sparc-v9 powerpc ppc)
+ (+ (* 1 (char-code #\A))
+ (* 256 (char-code #\B))
+ (* 65536 (char-code #\C))
+ (* 16777216 128))
+ #+(or sparc sparc-v9 powerpc ppc)
+ (+ (* 16777216 (char-code #\A))
+ (* 65536 (char-code #\B))
+ (* 256 (char-code #\C))
+ (* 1 128))) ;set signed bit
+ (util.test:test (uffi:ensure-char-character
+ (uffi:get-slot-value u 'tunion1 'char))
+ #\A
+ :test #'eql
+ :fail-info "Error with union character")
+ #-(or sparc sparc-v9 openmcl digitool)
+;; (util.test:test (> 0 (uffi:get-slot-value u 'tunion1 'int))
+;; t
+;; :fail-info
+;; "Error with negative int in union")
+ (util.test:test (plusp (uffi:get-slot-value u 'tunion1 'uint))
+ t
+ :fail-info
+ "Error with unsigned int in union")
+ (uffi:free-foreign-object u))
+ (values))
+
+#+examples-uffi
+(run-union-1)
+
+
+#+test-uffi
+(test-union-1)
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/Makefile
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/Makefile Mon Feb 11 09:23:05 2008
@@ -0,0 +1,6 @@
+SUBDIRS :=
+
+include ../Makefile.common
+
+.PHONY: distclean
+distclean: clean
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,262 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: aggregates.lisp
+;;;; Purpose: UFFI source to handle aggregate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: aggregates.lisp 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+(defmacro def-enum (enum-name args &key (separator-string "#"))
+ "Creates a constants for a C type enum list, symbols are created
+in the created in the current package. The symbol is the concatenation
+of the enum-name name, separator-string, and field-name"
+ (let ((counter 0)
+ (cmds nil)
+ (constants nil))
+ (declare (fixnum counter))
+ (dolist (arg args)
+ (let ((name (if (listp arg) (car arg) arg))
+ (value (if (listp arg)
+ (prog1
+ (setq counter (cadr arg))
+ (incf counter))
+ (prog1
+ counter
+ (incf counter)))))
+ (setq name (intern (concatenate 'string
+ (symbol-name enum-name)
+ separator-string
+ (symbol-name name))))
+ (push `(uffi:def-constant ,name ,value) constants)))
+ (setf cmds (append '(progn)
+ #+allegro `((ff:def-foreign-type ,enum-name :int))
+ #+lispworks `((fli:define-c-typedef ,enum-name :int))
+ #+(or cmu scl) `((alien:def-alien-type ,enum-name alien:signed))
+ #+sbcl `((sb-alien:define-alien-type ,enum-name sb-alien:signed))
+ #+digitool `((def-mcl-type ,enum-name :integer))
+ #+openmcl `((ccl::def-foreign-type ,enum-name :int))
+ (nreverse constants)))
+ cmds))
+
+
+(defmacro def-array-pointer (name-array type)
+ #+allegro
+ `(ff:def-foreign-type ,name-array
+ (:array ,(convert-from-uffi-type type :array)))
+ #+lispworks
+ `(fli:define-c-typedef ,name-array
+ (:c-array ,(convert-from-uffi-type type :array)))
+ #+(or cmu scl)
+ `(alien:def-alien-type ,name-array
+ (* ,(convert-from-uffi-type type :array)))
+ #+sbcl
+ `(sb-alien:define-alien-type ,name-array
+ (* ,(convert-from-uffi-type type :array)))
+ #+digitool
+ `(def-mcl-type ,name-array '(:array ,type))
+ #+openmcl
+ `(ccl::def-foreign-type ,name-array (:array ,(convert-from-uffi-type type :array)))
+ )
+
+(defun process-struct-fields (name fields &optional (variant nil))
+ (let (processed)
+ (dolist (field fields)
+ (let* ((field-name (car field))
+ (type (cadr field))
+ (def (append (list field-name)
+ (if (eq type :pointer-self)
+ #+(or cmu scl) `((* (alien:struct ,name)))
+ #+sbcl `((* (sb-alien:struct ,name)))
+ #+(or openmcl digitool) `((:* (:struct ,name)))
+ #+lispworks `((:pointer ,name))
+ #-(or cmu sbcl scl openmcl digitool lispworks) `((* ,name))
+ `(,(convert-from-uffi-type type :struct))))))
+ (if variant
+ (push (list def) processed)
+ (push def processed))))
+ (nreverse processed)))
+
+
+(defmacro def-struct (name &rest fields)
+ #+(or cmu scl)
+ `(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields)))
+ #+sbcl
+ `(sb-alien:define-alien-type ,name (sb-alien:struct ,name ,@(process-struct-fields name fields)))
+ #+allegro
+ `(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))
+ #+lispworks
+ `(fli:define-c-struct ,name ,@(process-struct-fields name fields))
+ #+digitool
+ `(ccl:defrecord ,name ,@(process-struct-fields name fields))
+ #+openmcl
+ `(ccl::def-foreign-type
+ nil
+ (:struct ,name ,@(process-struct-fields name fields)))
+ )
+
+
+(defmacro get-slot-value (obj type slot)
+ #+(or lispworks cmu sbcl scl) (declare (ignore type))
+ #+allegro
+ `(ff:fslot-value-typed ,type :c ,obj ,slot)
+ #+lispworks
+ `(fli:foreign-slot-value ,obj ,slot)
+ #+(or cmu scl)
+ `(alien:slot ,obj ,slot)
+ #+sbcl
+ `(sb-alien:slot ,obj ,slot)
+ #+(or openmcl digitool)
+ `(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
+ )
+
+#+(or openmcl digitool)
+(defmacro set-slot-value (obj type slot value) ;use setf to set values
+ `(setf (ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot)))) ,value))
+
+#+(or openmcl digitool)
+(defsetf get-slot-value set-slot-value)
+
+
+(defmacro get-slot-pointer (obj type slot)
+ #+(or lispworks cmu sbcl scl) (declare (ignore type))
+ #+allegro
+ `(ff:fslot-value-typed ,type :c ,obj ,slot)
+ #+lispworks
+ `(fli:foreign-slot-pointer ,obj ,slot)
+ #+(or cmu scl)
+ `(alien:slot ,obj ,slot)
+ #+sbcl
+ `(sb-alien:slot ,obj ,slot)
+ #+digitool
+ `(ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl:field-info ,type ,slot))))
+ #+openmcl
+ `(let ((field (ccl::%find-foreign-record-type-field ,type ,slot)))
+ (ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl::foreign-record-field-offset field)))))
+)
+
+;; necessary to eval at compile time for openmcl to compile convert-from-foreign-usb8
+;; below
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; so we could allow '(:array :long) or deref with other type like :long only
+ #+(or openmcl digitool)
+ (defun array-type (type)
+ (let ((result type))
+ (when (listp type)
+ (let ((type-list (if (eq (car type) 'quote) (nth 1 type) type)))
+ (when (and (listp type-list) (eq (car type-list) :array))
+ (setf result (cadr type-list)))))
+ result))
+
+
+ (defmacro deref-array (obj type i)
+ "Returns a field from a row"
+ #+(or lispworks cmu sbcl scl) (declare (ignore type))
+ #+(or cmu scl) `(alien:deref ,obj ,i)
+ #+sbcl `(sb-alien:deref ,obj ,i)
+ #+lispworks `(fli:dereference ,obj :index ,i :copy-foreign-object nil)
+ #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
+ #+openmcl
+ (let* ((array-type (array-type type))
+ (local-type (convert-from-uffi-type array-type :allocation))
+ (element-size-in-bits (ccl::%foreign-type-or-record-size local-type :bits)))
+ (ccl::%foreign-access-form
+ obj
+ (ccl::%foreign-type-or-record local-type)
+ `(* ,i ,element-size-in-bits)
+ nil))
+ #+digitool
+ (let* ((array-type (array-type type))
+ (local-type (convert-from-uffi-type array-type :allocation))
+ (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
+ `(,accessor
+ ,obj
+ (* (the fixnum ,i) ,(size-of-foreign-type local-type))))
+ ))
+
+; this expands to the %set-xx functions which has different params than %put-xx
+#+digitool
+(defmacro deref-array-set (obj type i value)
+ (let* ((array-type (array-type type))
+ (local-type (convert-from-uffi-type array-type :allocation))
+ (accessor (first (macroexpand `(ccl:pref obj ,local-type))))
+ (settor (first (macroexpand `(setf (,accessor obj ,local-type) value)))))
+ `(,settor
+ ,obj
+ (* (the fixnum ,i) ,(size-of-foreign-type local-type))
+ ,value)))
+
+#+digitool
+(defsetf deref-array deref-array-set)
+
+(defmacro def-union (name &rest fields)
+ #+allegro
+ `(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields)))
+ #+lispworks
+ `(fli:define-c-union ,name ,@(process-struct-fields name fields))
+ #+(or cmu scl)
+ `(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
+ #+sbcl
+ `(sb-alien:define-alien-type ,name (sb-alien:union ,name ,@(process-struct-fields name fields)))
+ #+digitool
+ `(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
+ #+openmcl
+ `(ccl::def-foreign-type nil
+ (:union ,name ,@(process-struct-fields name fields)))
+)
+
+
+#-(or sbcl cmu)
+(defun convert-from-foreign-usb8 (s len)
+ (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ (fixnum len))
+ (let ((a (make-array len :element-type '(unsigned-byte 8))))
+ (dotimes (i len a)
+ (declare (fixnum i))
+ (setf (aref a i) (uffi:deref-array s '(:array :unsigned-byte) i)))))
+
+#+sbcl
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (sb-ext:without-package-locks
+ (defvar *system-copy-fn* (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
+ (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL")
+ (intern "COPY-UB8-FROM-SYSTEM-AREA" "SB-KERNEL")))
+ (defconstant +system-copy-offset+ (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
+ (* sb-vm:vector-data-offset sb-vm:n-word-bits)
+ 0))
+ (defconstant +system-copy-multiplier+ (if (fboundp (intern "COPY-FROM-SYSTEM-AREA" "SB-KERNEL"))
+ sb-vm:n-byte-bits
+ 1))))
+
+
+#+sbcl
+(defun convert-from-foreign-usb8 (s len)
+ (let ((sap (sb-alien:alien-sap s)))
+ (declare (type sb-sys:system-area-pointer sap))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((result (make-array len :element-type '(unsigned-byte 8))))
+ (funcall *system-copy-fn* sap 0 result +system-copy-offset+
+ (* len +system-copy-multiplier+))
+ result))))
+
+#+cmu
+(defun convert-from-foreign-usb8 (s len)
+ (let ((sap (alien:alien-sap s)))
+ (declare (type system:system-area-pointer sap))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((result (make-array len :element-type '(unsigned-byte 8))))
+ (kernel:copy-from-system-area sap 0
+ result (* vm:vector-data-offset
+ vm:word-bits)
+ (* len vm:byte-bits))
+ result))))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/corman-notes.txt
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/corman-notes.txt Mon Feb 11 09:23:05 2008
@@ -0,0 +1,17 @@
+some notes:
+ we need the :pascal (:stdcall) calling conventions for
+ (def-function names args &key module returning calling-convention)
+ so I added this. calling-convention defaults to :cdecl
+ but on win32 we mostly use :stdcall
+
+ #+corman is invalid, #+cormanlisp instead
+
+ cormanlisp doesn't need to load and register the dll, since the underlying
+ LoadLibrary() call does this. we need the module keyword for def-function
+instead.
+ (should probably default to kernel32.dll)
+ I'll think about library.cl, but we'll need more real-world win32 examples.
+ (ideally the complete winapi :)
+ I also have to look at valentina.
+
+patch -p0 < corman.diff
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/getenv-ccl.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/corman/getenv-ccl.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,81 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv-ccl.cl
+;;;; Purpose: cormanlisp version
+;;;; Programmer: "Joe Marshall" <prunesquallor(a)attbi.com>
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: getenv-ccl.lisp 10614 2005-07-06 01:05:14Z kevin $
+;;;;
+;;;; *************************************************************************
+
+(in-package :cl-user)
+
+(ct:defun-dll c-getenv ((lpname LPSTR)
+ (lpbuffer LPSTR)
+ (nsize LPDWORD))
+ :library-name "kernel32.dll"
+ :return-type DWORD
+ :entry-name "GetEnvironmentVariableA"
+ :linkage-type :pascal)
+
+(defun getenv (name)
+ (let ((nsizebuf (ct:malloc (sizeof :long)))
+ (buffer (ct:malloc 1))
+ (cname (ct:lisp-string-to-c-string name)))
+ (setf (ct:cref lpdword nsizebuf 0) 0)
+ (let* ((needed-size (c-getenv cname buffer nsizebuf))
+ (buffer1 (ct:malloc (1+ needed-size))))
+ (setf (ct:cref lpdword nsizebuf 0) needed-size)
+ (prog1 (if (zerop (c-getenv cname buffer1 nsizebuf))
+ nil
+ (ct:c-string-to-lisp-string buffer1))
+ (ct:free buffer1)
+ (ct:free nsizebuf)))))
+
+(defun cl:user-homedir-pathname (&optional host)
+ (cond ((or (stringp host)
+ (and (consp host)
+ (every #'stringp host))) nil)
+ ((or (eq host :unspecific)
+ (null host))
+ (let ((homedrive (getenv "HOMEDRIVE"))
+ (homepath (getenv "HOMEPATH")))
+ (parse-namestring
+ (if (and (stringp homedrive)
+ (stringp homepath)
+ (= (length homedrive) 2)
+ (> (length homepath) 0))
+ (concatenate 'string homedrive homepath "\\")
+ "C:\\"))))
+ (t (error "HOST must be a string, list of strings, NIL or :unspecific"))))
+
+;|
+(uffi:def-function ("getenv" c-getenv)
+ ((name :cstring))
+ :returning :cstring)
+
+(defun my-getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-cstring (key-native key)
+ (uffi:convert-from-cstring (c-getenv key-native))))
+
+#examples-uffi
+(progn
+ (flet ((print-results (str)
+ (format t "~&(getenv ~S) => ~S" str (my-getenv str))))
+ (print-results "USER")
+ (print-results "_FOO_")))
+
+
+#test-uffi
+(progn
+ (util.test:test (my-getenv "_FOO_") nil :fail-info "Error retrieving non-existent getenv")
+ (util.test:test (and (stringp (my-getenv "USER"))
+ (< 0 (length (my-getenv "USER"))))
+ t :fail-info "Error retrieving getenv")
+)
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/functions.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/functions.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,239 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: function.lisp
+;;;; Purpose: UFFI source to C function definitions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: functions.lisp 11615 2007-04-13 05:49:01Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+(defun process-function-args (args)
+ (if (null args)
+ #+(or lispworks cmu sbcl scl cormanlisp digitool) nil
+ #+allegro '(:void)
+ #+openmcl (values nil nil)
+
+ ;; args not null
+ #+(or lispworks allegro cmu sbcl scl digitool cormanlisp)
+ (let (processed)
+ (dolist (arg args)
+ (push (process-one-function-arg arg) processed))
+ (nreverse processed))
+ #+openmcl
+ (let ((processed nil)
+ (params nil))
+ (dolist (arg args)
+ (let ((name (car arg))
+ (type (convert-from-uffi-type (cadr arg) :routine)))
+ ;;(when (and (listp type) (eq (car type) :address))
+ ;;(setf type :address))
+ (push name params)
+ (push type processed)
+ (push name processed)))
+ (values (nreverse params) (nreverse processed)))
+ ))
+
+(defun process-one-function-arg (arg)
+ (let ((name (car arg))
+ (type (convert-from-uffi-type (cadr arg) :routine)))
+ #+(or cmu sbcl scl)
+ ;(list name type :in)
+ `(,name ,type ,@(if (= (length arg) 3) (list (third arg)) (values)))
+ #+(or allegro lispworks digitool)
+ (if (and (listp type) (listp (car type)))
+ (append (list name) type)
+ (list name type))
+ #+openmcl
+ (declare (ignore name type))
+ ))
+
+
+(defun allegro-convert-return-type (type)
+ (if (and (listp type) (not (listp (car type))))
+ (list type)
+ type))
+
+(defun funcallable-lambda-list (args)
+ (let ((ll nil))
+ (dolist (arg args)
+ (push (car arg) ll))
+ (nreverse ll)))
+
+#|
+(defmacro def-funcallable (name args &key returning)
+ (let ((result-type (convert-from-uffi-type returning :return))
+ (function-args (process-function-args args)))
+ #+lispworks
+ `(fli:define-foreign-funcallable ,name ,function-args
+ :result-type ,result-type
+ :language :ansi-c
+ :calling-convention :cdecl)
+ #+(or cmu scl sbcl)
+ ;; requires the type of the function pointer be declared correctly!
+ (let* ((ptrsym (gensym))
+ (ll (funcallable-lambda-list args)))
+ `(defun ,name ,(cons ptrsym ll)
+ (alien::alien-funcall ,ptrsym ,@ll)))
+ #+openmcl
+ (multiple-value-bind (params args) (process-function-args args)
+ (let ((ptrsym (gensym)))
+ `(defun ,name ,(cons ptrsym params)
+ (ccl::ff-call ,ptrsym ,@args ,result-type))))
+ #+allegro
+ ;; this is most definitely wrong
+ (let* ((ptrsym (gensym))
+ (ll (funcallable-lambda-list args)))
+ `(defun ,name ,(cons ptrsym ll)
+ (system::ff-funcall ,ptrsym ,@ll)))
+ ))
+|#
+
+(defun convert-lispworks-args (args)
+ (loop for arg in args
+ with processed = nil
+ do
+ (if (and (= (length arg) 3) (eq (third arg) :out))
+ (push (list (first arg)
+ (list :reference-return (second arg))) processed)
+ (push (subseq arg 0 2) processed))
+ finally (return (nreverse processed))))
+
+(defun preprocess-names (names)
+ (let ((fname (gensym)))
+ (if (atom names)
+ (values (list names fname) fname (uffi::make-lisp-name names))
+ (values (list (first names) fname) fname (second names)))))
+
+(defun preprocess-args (args)
+ (loop for arg in args
+ with lisp-args = nil and out = nil and processed = nil
+ do
+ (if (= (length arg) 3)
+ (ecase (third arg)
+ (:in
+ (progn
+ (push (first arg) lisp-args)
+ (push (list (first arg) (second arg)) processed)))
+ (:out
+ (progn
+ (push (list (first arg) (second arg)) out)
+ (push (list (first arg) (list '* (second arg))) processed))))
+ (progn
+ (push (first arg) lisp-args)
+ (push arg processed)))
+ finally (return (values (nreverse lisp-args)
+ (nreverse out)
+ (nreverse processed)))))
+
+
+(defmacro def-function (names args &key module returning)
+ (multiple-value-bind (lisp-args out processed)
+ (preprocess-args args)
+ (declare (ignorable lisp-args processed))
+ (if (= (length out) 0)
+ `(%def-function ,names ,args
+ ,@(if module (list :module module) (values))
+ ,@(if returning (list :returning returning) (values)))
+
+ #+(or cmu scl sbcl)
+ `(%def-function ,names ,args
+ ,@(if returning (list :returning returning) (values)))
+ #+(and lispworks lispworks5)
+ (multiple-value-bind (name-pair fname lisp-name)
+ (preprocess-names names)
+ `(progn
+ (%def-function ,name-pair ,(convert-lispworks-args args)
+ ,@(if module (list :module module) (values))
+ ,@(if returning (list :returning returning) (values)))
+ (defun ,lisp-name ,lisp-args
+ (,fname ,@(mapcar
+ #'(lambda (arg)
+ (cond ((member (first arg) lisp-args)
+ (first arg))
+ ((member (first arg) out :key #'first)
+ t)))
+ args)))))
+ #+(and lispworks (not lispworks5))
+ `(%def-function ,names ,(convert-lispworks-args args)
+ ,@(if module (list :module module) (values))
+ ,@(if returning (list :returning returning) (values)))
+ #-(or cmu scl sbcl lispworks)
+ (multiple-value-bind (name-pair fname lisp-name)
+ (preprocess-names names)
+ `(progn
+ (%def-function ,name-pair ,processed
+ :module ,module :returning ,returning)
+ ;(declaim (inline ,fname))
+ (defun ,lisp-name ,lisp-args
+ (with-foreign-objects ,out
+ (values (,fname ,@(mapcar #'first args))
+ ,@(mapcar #'(lambda (arg)
+ (list 'deref-pointer
+ (first arg)
+ (second arg))) out))))))
+ )))
+
+
+;; name is either a string representing foreign name, or a list
+;; of foreign-name as a string and lisp name as a symbol
+(defmacro %def-function (names args &key module returning)
+ #+(or cmu sbcl scl allegro openmcl digitool cormanlisp) (declare (ignore module))
+
+ (let* ((result-type (convert-from-uffi-type returning :return))
+ (function-args (process-function-args args))
+ (foreign-name (if (atom names) names (car names)))
+ (lisp-name (if (atom names) (make-lisp-name names) (cadr names))))
+ ;; todo: calling-convention :stdcall for cormanlisp
+ #+allegro
+ `(ff:def-foreign-call (,lisp-name ,foreign-name)
+ ,function-args
+ :returning ,(allegro-convert-return-type result-type)
+ :call-direct t
+ :strings-convert nil)
+ #+(or cmu scl)
+ `(alien:def-alien-routine (,foreign-name ,lisp-name)
+ ,result-type
+ ,@function-args)
+ #+sbcl
+ `(sb-alien:define-alien-routine (,foreign-name ,lisp-name)
+ ,result-type
+ ,@function-args)
+ #+lispworks
+ `(fli:define-foreign-function (,lisp-name ,foreign-name :source)
+ ,function-args
+ ,@(if module (list :module module) (values))
+ :result-type ,result-type
+ :language :ansi-c
+ #+:win32 :calling-convention #+:win32 :cdecl)
+ #+digitool
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (ccl:define-entry-point (,lisp-name ,foreign-name)
+ ,function-args
+ ,result-type))
+ #+openmcl
+ (declare (ignore function-args))
+ #+(and openmcl darwinppc-target)
+ (setf foreign-name (concatenate 'string "_" foreign-name))
+ #+openmcl
+ (multiple-value-bind (params args) (process-function-args args)
+ `(defun ,lisp-name ,params
+ (ccl::external-call ,foreign-name ,@args ,result-type)))
+ #+cormanlisp
+ `(ct:defun-dll ,lisp-name (,function-args)
+ :return-type ,result-type
+ ,@(if module (list :library-name module) (values))
+ :entry-name ,foreign-name
+ :linkage-type ,calling-convention) ; we need :pascal
+ ))
+
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/libraries.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/libraries.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,134 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: libraries.lisp
+;;;; Purpose: UFFI source to load foreign libraries
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: libraries.lisp 11764 2007-07-22 19:09:39Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+(defvar *loaded-libraries* nil
+ "List of foreign libraries loaded. Used to prevent reloading a library")
+
+(defun default-foreign-library-type ()
+ "Returns string naming default library type for platform"
+ #+(or win32 cygwin mswindows) "dll"
+ #+(or macosx darwin ccl-5.0) "dylib"
+ #-(or win32 cygwin mswindows macosx darwin ccl-5.0) "so"
+)
+
+(defun foreign-library-types ()
+ "Returns list of string naming possible library types for platform, sorted by preference"
+ #+(or win32 mswindows) '("dll" "lib")
+ #+(or macosx darwin ccl-5.0) '("dylib" "bundle")
+ #-(or win32 mswindows macosx darwin ccl-5.0) '("so" "a" "o")
+)
+
+(defun find-foreign-library (names directories &key types drive-letters)
+ "Looks for a foreign library. directories can be a single
+string or a list of strings of candidate directories. Use default
+library type if type is not specified."
+ (unless types
+ (setq types (foreign-library-types)))
+ (unless (listp types)
+ (setq types (list types)))
+ (unless (listp names)
+ (setq names (list names)))
+ (unless (listp directories)
+ (setq directories (list directories)))
+ #+(or win32 mswindows)
+ (unless (listp drive-letters)
+ (setq drive-letters (list drive-letters)))
+ #-(or win32 mswindows)
+ (setq drive-letters '(nil))
+ (dolist (drive-letter drive-letters)
+ (dolist (name names)
+ (dolist (dir directories)
+ (dolist (type types)
+ (let ((path (make-pathname
+ #+lispworks :host
+ #+lispworks (when drive-letter drive-letter)
+ #-lispworks :device
+ #-lispworks (when drive-letter drive-letter)
+ :name name
+ :type type
+ :directory
+ (etypecase dir
+ (pathname
+ (pathname-directory dir))
+ (list
+ dir)
+ (string
+ (pathname-directory
+ (parse-namestring dir)))))))
+ (when (probe-file path)
+ (return-from find-foreign-library path)))))))
+ nil)
+
+
+(defun load-foreign-library (filename &key module supporting-libraries
+ force-load)
+ #+(or allegro openmcl digitool sbcl) (declare (ignore module supporting-libraries))
+ #+(or cmu scl) (declare (ignore module))
+ #+lispworks (declare (ignore supporting-libraries))
+
+ (flet ((load-failure ()
+ (error "Unable to load foreign library \"~A\"." filename)))
+ (when (and filename (or (null (pathname-directory filename))
+ (probe-file filename)))
+ (if (pathnamep filename) ;; ensure filename is a string to check if already loaded
+ (setq filename (namestring (if (null (pathname-directory filename))
+ filename
+ ;; lispworks treats as UNC, so use truename
+ #+(and lispworks win32) (truename filename)
+ #-(and lispworks win32) filename))))
+
+ (if (and (not force-load)
+ (find filename *loaded-libraries* :test #'string-equal))
+ t ;; return T, but don't reload library
+ (progn
+ #+cmu
+ (let ((type (pathname-type (parse-namestring filename))))
+ (if (string-equal type "so")
+ (unless
+ (sys::load-object-file filename)
+ (load-failure))
+ (alien:load-foreign filename
+ :libraries
+ (convert-supporting-libraries-to-string
+ supporting-libraries))))
+ #+scl
+ (let ((type (pathname-type (parse-namestring filename))))
+ (alien:load-foreign filename
+ :libraries
+ (convert-supporting-libraries-to-string
+ supporting-libraries)))
+ #+sbcl
+ (handler-case (sb-alien::load-1-foreign filename)
+ (sb-int:unsupported-operator (c)
+ (if (fboundp (intern "LOAD-SHARED-OBJECT" :sb-alien))
+ (funcall (intern "LOAD-SHARED-OBJECT" :sb-alien) filename)
+ (error c))))
+
+ #+lispworks (fli:register-module module :real-name filename
+ :connection-style :immediate)
+ #+allegro (load filename)
+ #+openmcl (ccl:open-shared-library filename)
+ #+digitool (ccl:add-to-shared-library-search-path filename t)
+
+ (push filename *loaded-libraries*)
+ t)))))
+
+(defun convert-supporting-libraries-to-string (libs)
+ (let (lib-load-list)
+ (dolist (lib libs)
+ (push (format nil "-l~A" lib) lib-load-list))
+ (nreverse lib-load-list)))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/objects.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/objects.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,291 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: objects.lisp
+;;;; Purpose: UFFI source to handle objects and pointers
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: objects.lisp 11022 2006-08-14 04:26:22Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defun size-of-foreign-type (type)
+ #+lispworks (fli:size-of type)
+ #+allegro (ff:sizeof-fobject type)
+ #+(or cmu scl) (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes
+ #+sbcl (ash (eval `(sb-alien:alien-size ,type)) -3) ;; convert from bits to bytes
+ #+clisp (values (ffi:size-of type))
+ #+digitool
+ (let ((mcl-type (ccl:find-mactype type nil t)))
+ (if mcl-type
+ (ccl::mactype-record-size mcl-type)
+ (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
+ #+openmcl (ccl::%foreign-type-or-record-size type :bytes)
+ ))
+
+(defmacro allocate-foreign-object (type &optional (size :unspecified))
+ "Allocates an instance of TYPE. If size is specified, then allocate
+an array of TYPE with size SIZE. The TYPE parameter is evaluated."
+ (if (eq size :unspecified)
+ (progn
+ #+(or cmu scl)
+ `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
+ #+sbcl
+ `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
+ #+lispworks
+ `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
+ #+allegro
+ `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
+ #+(or openmcl digitool)
+ `(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
+ )
+ (progn
+ #+(or cmu scl)
+ `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
+ #+sbcl
+ `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
+ #+lispworks
+ `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
+ #+allegro
+ `(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
+ #+(or openmcl digitool)
+ `(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
+ )))
+
+(defmacro free-foreign-object (obj)
+ #+(or cmu scl)
+ `(alien:free-alien ,obj)
+ #+sbcl
+ `(sb-alien:free-alien ,obj)
+ #+lispworks
+ `(fli:free-foreign-object ,obj)
+ #+allegro
+ `(ff:free-fobject ,obj)
+ #+(or openmcl digitool)
+ `(dispose-ptr ,obj)
+ )
+
+(defmacro null-pointer-p (obj)
+ #+lispworks `(fli:null-pointer-p ,obj)
+ #+allegro `(zerop ,obj)
+ #+(or cmu scl) `(alien:null-alien ,obj)
+ #+sbcl `(sb-alien:null-alien ,obj)
+ #+(or openmcl digitool) `(ccl:%null-ptr-p ,obj)
+ )
+
+(defmacro make-null-pointer (type)
+ #+(or allegro openmcl digitool) (declare (ignore type))
+ #+(or cmu scl) `(alien:sap-alien (system:int-sap 0) (* ,(convert-from-uffi-type (eval type) :type)))
+ #+sbcl `(sb-alien:sap-alien (sb-sys:int-sap 0) (* ,(convert-from-uffi-type (eval type) :type)))
+ #+lispworks `(fli:make-pointer :address 0 :type (quote ,(convert-from-uffi-type (eval type) :type)))
+ #+allegro 0
+ #+(or openmcl digitool) `(ccl:%null-ptr)
+ )
+
+(defmacro make-pointer (addr type)
+ #+(or allegro openmcl digitool) (declare (ignore type))
+ #+(or cmu scl) `(alien:sap-alien (system:int-sap ,addr) (* ,(convert-from-uffi-type (eval type) :type)))
+ #+sbcl `(sb-alien:sap-alien (sb-sys:int-sap ,addr) (* ,(convert-from-uffi-type (eval type) :type)))
+ #+lispworks `(fli:make-pointer :address ,addr :type (quote ,(convert-from-uffi-type (eval type) :type)))
+ #+allegro addr
+ #+(or openmcl digitool) `(ccl:%int-to-ptr ,addr)
+ )
+
+
+(defmacro char-array-to-pointer (obj)
+ #+(or cmu scl) `(alien:cast ,obj (* (alien:unsigned 8)))
+ #+sbcl `(sb-alien:cast ,obj (* (sb-alien:unsigned 8)))
+ #+lispworks `(fli:make-pointer :type '(:unsigned :char)
+ :address (fli:pointer-address ,obj))
+ #+allegro obj
+ #+(or openmcl digitool) obj
+ )
+
+(defmacro deref-pointer (ptr type)
+ "Returns a object pointed"
+ #+(or cmu sbcl lispworks scl) (declare (ignore type))
+ #+(or cmu scl) `(alien:deref ,ptr)
+ #+sbcl `(sb-alien:deref ,ptr)
+ #+lispworks `(fli:dereference ,ptr)
+ #+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :deref)) :c ,ptr)
+ #+(or openmcl digitool) `(ccl:pref ,ptr ,(convert-from-uffi-type type :deref))
+ )
+
+#+digitool
+(defmacro deref-pointer-set (ptr type value)
+ `(setf (ccl:pref ,ptr ,(convert-from-uffi-type type :deref)) ,value))
+
+#+digitool
+(defsetf deref-pointer deref-pointer-set)
+
+(defmacro ensure-char-character (obj)
+ #+(or digitool) obj
+ #+(or allegro cmu sbcl scl openmcl) `(code-char ,obj)
+ ;; lispworks varies whether deref'ing array vs. slot access of a char
+ #+lispworks `(if (characterp ,obj) ,obj (code-char ,obj)))
+
+(defmacro ensure-char-integer (obj)
+ #+(or digitool) `(char-code ,obj)
+ #+(or allegro cmu sbcl scl openmcl) obj
+ ;; lispworks varies whether deref'ing array vs. slot access of a char
+ #+lispworks
+ `(if (integerp ,obj) ,obj (char-code ,obj)))
+
+(defmacro ensure-char-storable (obj)
+ #+(or digitool (and lispworks (not lispworks5))) obj
+ #+(or allegro cmu lispworks5 openmcl sbcl scl)
+ `(char-code ,obj))
+
+(defmacro pointer-address (obj)
+ #+(or cmu scl)
+ `(system:sap-int (alien:alien-sap ,obj))
+ #+sbcl
+ `(sb-sys:sap-int (sb-alien:alien-sap ,obj))
+ #+lispworks
+ `(fli:pointer-address ,obj)
+ #+allegro
+ obj
+ #+(or openmcl digitool)
+ `(ccl:%ptr-to-int ,obj)
+ )
+
+;; TYPE is evaluated.
+#-(or openmcl digitool)
+(defmacro with-foreign-object ((var type) &rest body)
+ #-(or cmu sbcl lispworks scl) ; default version
+ `(let ((,var (allocate-foreign-object ,type)))
+ (unwind-protect
+ (progn ,@body)
+ (free-foreign-object ,var)))
+ #+(or cmu scl)
+ (let ((obj (gensym))
+ (ctype (convert-from-uffi-type (eval type) :allocate)))
+ (if (and (consp ctype) (eq 'array (car ctype)))
+ `(alien:with-alien ((,obj ,ctype))
+ (let* ((,var ,obj))
+ ,@body))
+ `(alien:with-alien ((,obj ,ctype))
+ (let* ((,var (alien:addr ,obj)))
+ ,@body))))
+ #+sbcl
+ (let ((obj (gensym))
+ (ctype (convert-from-uffi-type (eval type) :allocate)))
+ (if (and (consp ctype) (eq 'array (car ctype)))
+ `(sb-alien:with-alien ((,obj ,ctype))
+ (let* ((,var ,obj))
+ ,@body))
+ `(sb-alien:with-alien ((,obj ,ctype))
+ (let* ((,var (sb-alien:addr ,obj)))
+ ,@body))))
+ #+lispworks
+ `(fli:with-dynamic-foreign-objects ((,var ,(convert-from-uffi-type
+ (eval type) :allocate)))
+ ,@body)
+ )
+
+#-(or openmcl digitool)
+(defmacro with-foreign-objects (bindings &rest body)
+ (if bindings
+ `(with-foreign-object ,(car bindings)
+ (with-foreign-objects ,(cdr bindings)
+ ,@body))
+ `(progn ,@body)))
+
+#+(or openmcl digitool)
+(defmacro with-foreign-objects (bindings &rest body)
+ (let ((params nil) type count)
+ (dolist (spec (reverse bindings)) ;keep order - macroexpands to let*
+ (setf type (convert-from-uffi-type (eval (nth 1 spec)) :allocate))
+ (setf count 1)
+ (when (and (listp type) (eq (first type) :array))
+ (setf count (nth 2 type))
+ (unless (integerp count) (error "Invalid size for array: ~a" type))
+ (setf type (nth 1 type)))
+ (push (list (first spec) (* count (size-of-foreign-type type))) params))
+ `(ccl:%stack-block ,params ,@body)))
+
+#+(or openmcl digitool)
+(defmacro with-foreign-object ((var type) &rest body)
+ `(with-foreign-objects ((,var ,type))
+ ,@body))
+
+#+lispworks
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ `(fli:with-coerced-pointer (,binding-name
+ :type ',(convert-from-uffi-type (eval type) :type))
+ ,pointer
+ ,@body))
+
+#+(or cmu scl sbcl)
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ `(let ((,binding-name
+ (#+(or cmu scl) alien:cast
+ #+sbcl sb-alien:cast
+ ,pointer (* ,(convert-from-uffi-type (eval type) :type)))))
+ ,@body))
+
+#+(or allegro openmcl)
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ (declare (ignore type))
+ `(let ((,binding-name ,pointer))
+ ,@body))
+
+#-(or lispworks cmu scl sbcl allegro openmcl)
+(defmacro with-cast-pointer ((binding-name pointer type) &body body)
+ (declare (ignore binding-name pointer type body))
+ '(error "WITH-CAST-POINTER not (yet) implemented for ~A"
+ (lisp-implementation-type)))
+
+#+(or allegro openmcl)
+(defun convert-external-name (name)
+ "Add an underscore to NAME if necessary for the ABI."
+ #+(or macosx darwinppc-target) (concatenate 'string "_" name)
+ #-(or macosx darwinppc-target) name)
+
+(defmacro def-foreign-var (names type module)
+ #-lispworks (declare (ignore module))
+ (let ((foreign-name (if (atom names) names (first names)))
+ (lisp-name (if (atom names) (make-lisp-name names) (second names)))
+ #-allegro
+ (var-type (convert-from-uffi-type type :type)))
+ #+(or cmu scl)
+ `(alien:def-alien-variable (,foreign-name ,lisp-name) ,var-type)
+ #+sbcl
+ `(sb-alien:define-alien-variable (,foreign-name ,lisp-name) ,var-type)
+ #+allegro
+ `(define-symbol-macro ,lisp-name
+ (ff:fslot-value-typed (quote ,(convert-from-uffi-type type :deref))
+ :c (ff:get-entry-point ,(convert-external-name foreign-name))))
+ #+lispworks
+ `(progn
+ (fli:define-foreign-variable (,lisp-name ,foreign-name)
+ :accessor :address-of
+ :type ,var-type
+ :module ,module)
+ (define-symbol-macro ,lisp-name (fli:dereference (,lisp-name)
+ :copy-foreign-object nil)))
+ #+openmcl
+ `(define-symbol-macro ,lisp-name
+ (deref-pointer (ccl:foreign-symbol-address
+ ,(convert-external-name foreign-name)) ,var-type))
+ #-(or allegro cmu scl sbcl lispworks openmcl)
+ `(define-symbol-macro ,lisp-name
+ '(error "DEF-FOREIGN-VAR not (yet) defined for ~A"
+ (lisp-implementation-type)))))
+
+
+;;; Define a special variable, like DEFVAR, that will be initialized
+;;; to a pointer which may need to be reset when a saved image is
+;;; loaded. This is needed for OpenMCL, which sets pointers to "dead
+;;; macptrs" when a saved image is loaded.
+;; This may possibly be needed for sbcl's SAVE-LISP-AND-DIE
+(defmacro def-pointer-var (name value &optional doc)
+ #-openmcl `(defvar ,name ,value ,@(if doc (list doc)))
+ #+openmcl `(ccl::defloadvar ,name ,value ,doc))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/os.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/os.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,79 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: os.lisp
+;;;; Purpose: Operating system interface for UFFI
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Sep 2002
+;;;;
+;;;; $Id: os.lisp 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg.
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+
+(defun getenv (var)
+ "Return the value of the environment variable."
+ #+allegro (sys::getenv (string var))
+ #+clisp (sys::getenv (string var))
+ #+cmu (cdr (assoc (string var) ext:*environment-list* :test #'equalp
+ :key #'string))
+ #+gcl (si:getenv (string var))
+ #+lispworks (lw:environment-variable (string var))
+ #+lucid (lcl:environment-variable (string var))
+ #+(or openmcl digitool) (ccl::getenv var)
+ #+sbcl (sb-ext:posix-getenv var)
+ #-(or allegro clisp cmu gcl lispworks lucid openmcl digitool sbcl)
+ (error 'not-implemented :proc (list 'getenv var)))
+
+
+;; modified from function ASDF -- Copyright Dan Barlow and Contributors
+
+(defun run-shell-command (control-string &rest args &key output)
+ "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
+synchronously execute the result using a Bourne-compatible shell, with
+output to *trace-output*. Returns the shell's exit code."
+ (unless output
+ (setq output *trace-output*))
+
+ (let ((command (apply #'format nil control-string args)))
+ #+sbcl
+ (sb-impl::process-exit-code
+ (sb-ext:run-program
+ "/bin/sh"
+ (list "-c" command)
+ :input nil :output output))
+
+ #+(or cmu scl)
+ (ext:process-exit-code
+ (ext:run-program
+ "/bin/sh"
+ (list "-c" command)
+ :input nil :output output))
+
+ #+allegro
+ (excl:run-shell-command command :input nil :output output)
+
+ #+lispworks
+ (system:call-system-showing-output
+ command
+ :shell-type "/bin/sh"
+ :output-stream output)
+
+ #+clisp ;XXX not exactly *trace-output*, I know
+ (ext:run-shell-command command :output :terminal :wait t)
+
+ #+openmcl
+ (nth-value 1
+ (ccl:external-process-status
+ (ccl:run-program "/bin/sh" (list "-c" command)
+ :input nil :output output
+ :wait t)))
+
+ #-(or openmcl clisp lispworks allegro scl cmu sbcl)
+ (error "RUN-SHELL-PROGRAM not implemented for this Lisp.")
+ ))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/package.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/package.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,84 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.lisp
+;;;; Purpose: Defines UFFI package
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:cl-user)
+
+(defpackage #:uffi
+ (:use #:cl)
+ (:export
+
+ ;; immediate types
+ #:def-constant
+ #:def-foreign-type
+ #:def-type
+ #:null-char-p
+
+ ;; aggregate types
+ #:def-enum
+ #:def-struct
+ #:get-slot-value
+ #:get-slot-pointer
+ #:def-array-pointer
+ #:deref-array
+ #:def-union
+
+ ;; objects
+ #:allocate-foreign-object
+ #:free-foreign-object
+ #:with-foreign-object
+ #:with-foreign-objects
+ #:size-of-foreign-type
+ #:pointer-address
+ #:deref-pointer
+ #:ensure-char-character
+ #:ensure-char-integer
+ #:ensure-char-storable
+ #:null-pointer-p
+ #:make-null-pointer
+ #:make-pointer
+ #:pointer-address
+ #:+null-cstring-pointer+
+ #:char-array-to-pointer
+ #:with-cast-pointer
+ #:def-foreign-var
+ #:convert-from-foreign-usb8
+ #:def-pointer-var
+
+ ;; string functions
+ #:convert-from-cstring
+ #:convert-to-cstring
+ #:free-cstring
+ #:with-cstring
+ #:with-cstrings
+ #:convert-from-foreign-string
+ #:convert-to-foreign-string
+ #:allocate-foreign-string
+ #:with-foreign-string
+ #:with-foreign-strings
+ #:foreign-string-length
+
+ ;; function call
+ #:def-function
+
+ ;; Libraries
+ #:find-foreign-library
+ #:load-foreign-library
+ #:default-foreign-library-type
+ #:foreign-library-types
+
+ ;; OS
+ #:run-shell-command
+ #:getenv
+ ))
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/primitives.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,311 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: primitives.lisp
+;;;; Purpose: UFFI source to handle immediate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: primitives.lisp 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+#+(or openmcl digitool)
+(defvar *keyword-package* (find-package "KEYWORD"))
+
+#+(or openmcl digitool)
+; MCL and OpenMCL expect a lot of FFI elements to be keywords (e.g. struct field names in OpenMCL)
+; So this provides a function to convert any quoted symbols to keywords.
+(defun keyword (obj)
+ (cond ((keywordp obj)
+ obj)
+ ((null obj)
+ nil)
+ ((symbolp obj)
+ (intern (symbol-name obj) *keyword-package*))
+ ((and (listp obj) (eq (car obj) 'cl:quote))
+ (keyword (cadr obj)))
+ ((stringp obj)
+ (intern obj *keyword-package*))
+ (t
+ obj)))
+
+; Wrapper for unexported function we have to use
+#+digitool
+(defmacro def-mcl-type (name type)
+ `(ccl::def-mactype ,(keyword name) (ccl:find-mactype ,type)))
+
+(defmacro def-constant (name value &key (export nil))
+ "Macro to define a constant and to export it"
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defconstant ,name ,value)
+ ,(when export (list 'export `(quote ,name)))
+ ',name))
+
+(defmacro def-type (name type)
+ "Generates a (deftype) statement for CL. Currently, only CMUCL
+supports takes advantage of this optimization."
+ #+(or lispworks allegro openmcl digitool cormanlisp) (declare (ignore type))
+ #+(or lispworks allegro openmcl digitool cormanlisp) `(deftype ,name () t)
+ #+(or cmu scl)
+ `(deftype ,name () '(alien:alien ,(convert-from-uffi-type type :declare)))
+ #+sbcl
+ `(deftype ,name () '(sb-alien:alien ,(convert-from-uffi-type type :declare)))
+ )
+
+(defmacro null-char-p (val)
+ "Returns T if character is NULL"
+ `(zerop ,val))
+
+(defmacro def-foreign-type (name type)
+ #+lispworks `(fli:define-c-typedef ,name ,(convert-from-uffi-type type :type))
+ #+allegro `(ff:def-foreign-type ,name ,(convert-from-uffi-type type :type))
+ #+(or cmu scl) `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
+ #+sbcl `(sb-alien:define-alien-type ,name ,(convert-from-uffi-type type :type))
+ #+cormanlisp `(ct:defctype ,name ,(convert-from-uffi-type type :type))
+ #+(or openmcl digitool)
+ (let ((mcl-type (convert-from-uffi-type type :type)))
+ (unless (or (keywordp mcl-type) (consp mcl-type))
+ (setf mcl-type `(quote ,mcl-type)))
+ #+digitool
+ `(def-mcl-type ,(keyword name) ,mcl-type)
+ #+openmcl
+ `(ccl::def-foreign-type ,(keyword name) ,mcl-type))
+ )
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar +type-conversion-hash+ (make-hash-table :size 20 :test #'eq))
+ #+(or cmu sbcl scl) (defvar *cmu-def-type-hash*
+ (make-hash-table :size 20 :test #'eq))
+ )
+
+#+(or cmu scl)
+(defvar *cmu-sbcl-def-type-list*
+ '((:char . (alien:signed 8))
+ (:unsigned-char . (alien:unsigned 8))
+ (:byte . (alien:signed 8))
+ (:unsigned-byte . (alien:unsigned 8))
+ (:short . (alien:signed 16))
+ (:unsigned-short . (alien:unsigned 16))
+ (:int . (alien:signed 32))
+ (:unsigned-int . (alien:unsigned 32))
+ #-x86-64 (:long . (alien:signed 32))
+ #-x86-64 (:unsigned-long . (alien:unsigned 32))
+ #+x86-64 (:long . (alien:signed 64))
+ #+x86-64 (:unsigned-long . (alien:unsigned 64))
+ (:float . alien:single-float)
+ (:double . alien:double-float)
+ (:void . t)
+ )
+ "Conversions in CMUCL for def-foreign-type are different than in def-function")
+
+#+sbcl
+(defvar *cmu-sbcl-def-type-list*
+ '((:char . (sb-alien:signed 8))
+ (:unsigned-char . (sb-alien:unsigned 8))
+ (:byte . (sb-alien:signed 8))
+ (:unsigned-byte . (sb-alien:unsigned 8))
+ (:short . (sb-alien:signed 16))
+ (:unsigned-short . (sb-alien:unsigned 16))
+ (:int . (sb-alien:signed 32))
+ (:unsigned-int . (sb-alien:unsigned 32))
+ #-x86-64 (:long . (sb-alien:signed 32))
+ #-x86-64 (:unsigned-long . (sb-alien:unsigned 32))
+ #+x86-64 (:long . (sb-alien:signed 64))
+ #+x86-64 (:unsigned-long . (sb-alien:unsigned 64))
+ (:float . sb-alien:single-float)
+ (:double . sb-alien:double-float)
+ (:void . t)
+ )
+ "Conversions in SBCL for def-foreign-type are different than in def-function")
+
+(defvar *type-conversion-list* nil)
+
+#+(or cmu scl)
+(setq *type-conversion-list*
+ '((* . *) (:void . c-call:void)
+ (:pointer-void . (* t))
+ (:cstring . c-call:c-string)
+ (:char . c-call:char)
+ (:unsigned-char . (alien:unsigned 8))
+ (:byte . (alien:signed 8))
+ (:unsigned-byte . (alien:unsigned 8))
+ (:short . c-call:short)
+ (:unsigned-short . c-call:unsigned-short)
+ (:int . alien:integer) (:unsigned-int . c-call:unsigned-int)
+ (:long . c-call:long) (:unsigned-long . c-call:unsigned-long)
+ (:float . c-call:float) (:double . c-call:double)
+ (:array . alien:array)))
+
+#+sbcl
+(setq *type-conversion-list*
+ '((* . *) (:void . sb-alien:void)
+ (:pointer-void . (* t))
+ #-sb-unicode(:cstring . sb-alien:c-string)
+ #+sb-unicode(:cstring . sb-alien:utf8-string)
+ (:char . sb-alien:char)
+ (:unsigned-char . (sb-alien:unsigned 8))
+ (:byte . (sb-alien:signed 8))
+ (:unsigned-byte . (sb-alien:unsigned 8))
+ (:short . sb-alien:short)
+ (:unsigned-short . sb-alien:unsigned-short)
+ (:int . sb-alien:int) (:unsigned-int . sb-alien:unsigned-int)
+ (:long . sb-alien:long) (:unsigned-long . sb-alien:unsigned-long)
+ (:float . sb-alien:float) (:double . sb-alien:double)
+ (:array . sb-alien:array)))
+
+#+(or allegro cormanlisp)
+(setq *type-conversion-list*
+ '((* . *) (:void . :void)
+ (:short . :short)
+ (:pointer-void . (* :void))
+ (:cstring . (* :unsigned-char))
+ (:byte . :char)
+ (:unsigned-byte . :unsigned-char)
+ (:char . :char)
+ (:unsigned-char . :unsigned-char)
+ (:int . :int) (:unsigned-int . :unsigned-int)
+ (:long . :long) (:unsigned-long . :unsigned-long)
+ (:float . :float) (:double . :double)
+ (:array . :array)))
+
+#+lispworks
+(setq *type-conversion-list*
+ '((* . :pointer) (:void . :void)
+ (:short . :short)
+ (:pointer-void . (:pointer :void))
+ (:cstring . (:reference-pass (:ef-mb-string :external-format
+ (:latin-1 :eol-style :lf))
+ :allow-null t))
+ (:cstring-returning . (:reference (:ef-mb-string :external-format
+ (:latin-1 :eol-style :lf))
+ :allow-null t))
+ (:byte . :byte)
+ (:unsigned-byte . (:unsigned :byte))
+ (:char . :char)
+ (:unsigned-char . (:unsigned :char))
+ (:int . :int) (:unsigned-int . (:unsigned :int))
+ (:long . :long) (:unsigned-long . (:unsigned :long))
+ (:float . :float) (:double . :double)
+ (:array . :c-array)))
+
+#+digitool
+(setq *type-conversion-list*
+ '((* . :pointer) (:void . :void)
+ (:short . :short) (:unsigned-short . :unsigned-short)
+ (:pointer-void . :pointer)
+ (:cstring . :string)
+ (:char . :character)
+ (:unsigned-char . :unsigned-byte)
+ (:byte . :signed-byte) (:unsigned-byte . :unsigned-byte)
+ (:int . :long) (:unsigned-int . :unsigned-long)
+ (:long . :long) (:unsigned-long . :unsigned-long)
+ (:float . :single-float) (:double . :double-float)
+ (:array . :array)))
+
+#+openmcl
+(setq *type-conversion-list*
+ '((* . :address) (:void . :void)
+ (:short . :short) (:unsigned-short . :unsigned-short)
+ (:pointer-void . :address)
+ (:cstring . :address)
+ (:char . :signed-char)
+ (:unsigned-char . :unsigned-char)
+ (:byte . :signed-byte) (:unsigned-byte . :unsigned-byte)
+ (:int . :int) (:unsigned-int . :unsigned-int)
+ (:long . :long) (:unsigned-long . :unsigned-long)
+ (:long-long . :signed-doubleword) (:unsigned-long-long . :unsigned-doubleword)
+ (:float . :single-float) (:double . :double-float)
+ (:array . :array)))
+
+(dolist (type *type-conversion-list*)
+ (setf (gethash (car type) +type-conversion-hash+) (cdr type)))
+
+#+(or cmu sbcl scl)
+(dolist (type *cmu-sbcl-def-type-list*)
+ (setf (gethash (car type) *cmu-def-type-hash*) (cdr type)))
+
+(defun basic-convert-from-uffi-type (type)
+ (let ((found-type (gethash type +type-conversion-hash+)))
+ (if found-type
+ found-type
+ #-(or openmcl digitool) type
+ #+(or openmcl digitool) (keyword type))))
+
+(defun %convert-from-uffi-type (type context)
+ "Converts from a uffi type to an implementation specific type"
+ (if (atom type)
+ (cond
+ #+(or allegro cormanlisp)
+ ((and (or (eq context :routine) (eq context :return))
+ (eq type :cstring))
+ (setq type '((* :char) integer)))
+ #+(or cmu sbcl scl)
+ ((eq context :type)
+ (let ((cmu-type (gethash type *cmu-def-type-hash*)))
+ (if cmu-type
+ cmu-type
+ (basic-convert-from-uffi-type type))))
+ #+lispworks
+ ((and (eq context :return)
+ (eq type :cstring))
+ (basic-convert-from-uffi-type :cstring-returning))
+ #+digitool
+ ((and (eq type :void) (eq context :return)) nil)
+ (t
+ (basic-convert-from-uffi-type type)))
+ (let ((sub-type (car type)))
+ (case sub-type
+ (cl:quote
+ (convert-from-uffi-type (cadr type) context))
+ (:struct-pointer
+ #+(or openmcl digitool) `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
+ #-(or openmcl digitool) (%convert-from-uffi-type (list '* (cadr type)) :struct)
+ )
+ (:struct
+ #+(or openmcl digitool) `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
+ #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :struct)
+ )
+ (:union
+ #+(or openmcl digitool) `(:union ,(%convert-from-uffi-type (cadr type) :union))
+ #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :union)
+ )
+ (t
+ (cons (%convert-from-uffi-type (first type) context)
+ (%convert-from-uffi-type (rest type) context)))))))
+
+(defun convert-from-uffi-type (type context)
+ (let ((result (%convert-from-uffi-type type context)))
+ (cond
+ ((atom result) result)
+ #+openmcl
+ ((eq (car result) :address)
+ (if (eq context :struct)
+ (append '(:*) (cdr result))
+ :address))
+ #+digitool
+ ((and (eq (car result) :pointer) (eq context :allocation) :pointer))
+ (t result))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (char= #\a (schar (symbol-name '#:a) 0))
+ (pushnew :uffi-lowercase-reader *features*))
+ (when (not (string= (symbol-name '#:a)
+ (symbol-name '#:A)))
+ (pushnew :uffi-case-sensitive *features*)))
+
+(defun make-lisp-name (name)
+ (let ((converted (substitute #\- #\_ name)))
+ (intern
+ #+uffi-case-sensitive converted
+ #+(and (not uffi-lowercase-reader) (not uffi-case-sensitive)) (string-upcase converted)
+ #+(and uffi-lowercase-reader (not uffi-case-sensitive)) (string-downcase converted))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (setq cl:*features* (delete :uffi-lowercase-reader *features*))
+ (setq cl:*features* (delete :uffi-case-sensitive *features*)))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/readmacros-mcl.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/readmacros-mcl.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,35 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: readmacros-mcl.lisp
+;;;; Purpose: This file holds functions using read macros for MCL
+;;;; Programmer: Kevin M. Rosenberg/John Desoi
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: readmacros-mcl.lisp 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+
+;; trap macros don't work right directly in the macros
+#+digitool
+(defun new-ptr (size)
+ (#_NewPtr size))
+
+#+digitool
+(defun dispose-ptr (ptr)
+ (#_DisposePtr ptr))
+
+#+openmcl
+(defmacro new-ptr (size)
+ `(ccl::malloc ,size))
+
+#+openmcl
+(defmacro dispose-ptr (ptr)
+ `(ccl::free ,ptr))
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/strings.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/strings.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,412 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: strings.lisp
+;;;; Purpose: UFFI source to handle strings, cstring and foreigns
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: strings.lisp 11023 2006-08-14 06:25:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;; *************************************************************************
+
+(in-package #:uffi)
+
+
+(def-pointer-var +null-cstring-pointer+
+ #+(or cmu sbcl scl) nil
+ #+allegro 0
+ #+lispworks (fli:make-pointer :address 0 :type '(:unsigned :char))
+ #+(or openmcl digitool) (ccl:%null-ptr)
+)
+
+(defmacro convert-from-cstring (obj)
+ "Converts a string from a c-call. Same as convert-from-foreign-string, except
+that LW/CMU automatically converts strings from c-calls."
+ #+(or cmu sbcl lispworks scl) obj
+ #+allegro
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (zerop ,stored)
+ nil
+ (values (excl:native-to-string ,stored)))))
+ #+(or openmcl digitool)
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (ccl:%null-ptr-p ,stored)
+ nil
+ (values (ccl:%get-cstring ,stored)))))
+ )
+
+(defmacro convert-to-cstring (obj)
+ #+(or cmu sbcl scl lispworks) obj
+ #+allegro
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (null ,stored)
+ 0
+ (values (excl:string-to-native ,stored)))))
+ #+(or openmcl digitool)
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (null ,stored)
+ +null-cstring-pointer+
+ (let ((ptr (new-ptr (1+ (length ,stored)))))
+ (ccl::%put-cstring ptr ,stored)
+ ptr))))
+ )
+
+(defmacro free-cstring (obj)
+ #+(or cmu sbcl scl lispworks) (declare (ignore obj))
+ #+allegro
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (unless (zerop ,stored)
+ (ff:free-fobject ,stored))))
+ #+(or openmcl digitool)
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (unless (ccl:%null-ptr-p ,stored)
+ (dispose-ptr ,stored))))
+ )
+
+(defmacro with-cstring ((cstring lisp-string) &body body)
+ #+(or cmu sbcl scl lispworks)
+ `(let ((,cstring ,lisp-string)) ,@body)
+ #+allegro
+ (let ((acl-native (gensym))
+ (stored-lisp-string (gensym)))
+ `(let ((,stored-lisp-string ,lisp-string))
+ (excl:with-native-string (,acl-native ,stored-lisp-string)
+ (let ((,cstring (if ,stored-lisp-string ,acl-native 0)))
+ ,@body))))
+ #+(or openmcl digitool)
+ (let ((stored-lisp-string (gensym)))
+ `(let ((,stored-lisp-string ,lisp-string))
+ (if (stringp ,stored-lisp-string)
+ (ccl:with-cstrs ((,cstring ,stored-lisp-string))
+ ,@body)
+ (let ((,cstring +null-cstring-pointer+))
+ ,@body))))
+ )
+
+(defmacro with-cstrings (bindings &rest body)
+ (if bindings
+ `(with-cstring ,(car bindings)
+ (with-cstrings ,(cdr bindings)
+ ,@body))
+ `(progn ,@body)))
+
+;;; Foreign string functions
+
+(defmacro convert-to-foreign-string (obj)
+ #+lispworks
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (null ,stored)
+ +null-cstring-pointer+
+ (fli:convert-to-foreign-string
+ ,stored
+ :external-format '(:latin-1 :eol-style :lf)))))
+ #+allegro
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (null ,stored)
+ 0
+ (values (excl:string-to-native ,stored)))))
+ #+(or cmu scl)
+ (let ((size (gensym))
+ (storage (gensym))
+ (stored-obj (gensym))
+ (i (gensym)))
+ `(let ((,stored-obj ,obj))
+ (etypecase ,stored-obj
+ (null
+ (alien:sap-alien (system:int-sap 0) (* (alien:unsigned 8))))
+ (string
+ (let* ((,size (length ,stored-obj))
+ (,storage (alien:make-alien (alien:unsigned 8) (1+ ,size))))
+ (setq ,storage (alien:cast ,storage (* (alien:unsigned 8))))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (dotimes (,i ,size)
+ (declare (fixnum ,i))
+ (setf (alien:deref ,storage ,i)
+ (char-code (char ,stored-obj ,i))))
+ (setf (alien:deref ,storage ,size) 0))
+ ,storage)))))
+ #+sbcl
+ (let ((size (gensym))
+ (storage (gensym))
+ (stored-obj (gensym))
+ (i (gensym)))
+ `(let ((,stored-obj ,obj))
+ (etypecase ,stored-obj
+ (null
+ (sb-alien:sap-alien (sb-sys:int-sap 0) (* (sb-alien:unsigned 8))))
+ (string
+ (let* ((,size (length ,stored-obj))
+ (,storage (sb-alien:make-alien (sb-alien:unsigned 8) (1+ ,size))))
+ (setq ,storage (sb-alien:cast ,storage (* (sb-alien:unsigned 8))))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (dotimes (,i ,size)
+ (declare (fixnum ,i))
+ (setf (sb-alien:deref ,storage ,i)
+ (char-code (char ,stored-obj ,i))))
+ (setf (sb-alien:deref ,storage ,size) 0))
+ ,storage)))))
+ #+(or openmcl digitool)
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (null ,stored-obj)
+ +null-cstring-pointer+
+ (let ((ptr (new-ptr (1+ (length ,stored-obj)))))
+ (ccl::%put-cstring ptr ,stored-obj)
+ ptr))))
+ )
+
+;; Either length or null-terminated-p must be non-nil
+(defmacro convert-from-foreign-string (obj &key
+ length
+ (locale :default)
+ (null-terminated-p t))
+ #+allegro
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (zerop ,stored-obj)
+ nil
+ (if (eq ,locale :none)
+ (fast-native-to-string ,stored-obj ,length)
+ (values
+ (excl:native-to-string
+ ,stored-obj
+ ,@(when length (list :length length))
+ :truncate (not ,null-terminated-p)))))))
+ #+lispworks
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (fli:null-pointer-p ,stored-obj)
+ nil
+ (if (eq ,locale :none)
+ (fast-native-to-string ,stored-obj ,length)
+ (fli:convert-from-foreign-string
+ ,stored-obj
+ ,@(when length (list :length length))
+ :null-terminated-p ,null-terminated-p
+ :external-format '(:latin-1 :eol-style :lf))))))
+ #+(or cmu scl)
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (null-pointer-p ,stored-obj)
+ nil
+ (cmucl-naturalize-cstring (alien:alien-sap ,stored-obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p))))
+
+ #+sbcl
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (null-pointer-p ,stored-obj)
+ nil
+ (sbcl-naturalize-cstring (sb-alien:alien-sap ,stored-obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p))))
+ #+(or openmcl digitool)
+ (declare (ignore null-terminated-p))
+ #+(or openmcl digitool)
+ (let ((stored-obj (gensym)))
+ `(let ((,stored-obj ,obj))
+ (if (ccl:%null-ptr-p ,stored-obj)
+ nil
+ #+digitool (ccl:%get-cstring
+ ,stored-obj 0
+ ,@(if length (list length) nil))
+ #+openmcl ,@(if length
+ `((ccl:%str-from-ptr ,stored-obj ,length))
+ `((ccl:%get-cstring ,stored-obj))))))
+ )
+
+
+(defmacro allocate-foreign-string (size &key (unsigned t))
+ #+ignore
+ (let ((array-def (gensym)))
+ `(let ((,array-def (list 'alien:array 'c-call:char ,size)))
+ (eval `(alien:cast (alien:make-alien ,,array-def)
+ ,(if ,unsigned
+ '(* (alien:unsigned 8))
+ '(* (alien:signed 8)))))))
+
+ #+(or cmu scl)
+ `(alien:make-alien ,(if unsigned
+ '(alien:unsigned 8)
+ '(alien:signed 8))
+ ,size)
+
+ #+sbcl
+ `(sb-alien:make-alien ,(if unsigned
+ '(sb-alien:unsigned 8)
+ '(sb-alien:signed 8))
+ ,size)
+
+ #+lispworks
+ `(fli:allocate-foreign-object :type
+ ,(if unsigned
+ ''(:unsigned :char)
+ :char)
+ :nelems ,size)
+ #+allegro
+ (declare (ignore unsigned))
+ #+allegro
+ `(ff:allocate-fobject :char :c ,size)
+ #+(or openmcl digitool)
+ (declare (ignore unsigned))
+ #+(or openmcl digitool)
+ `(new-ptr ,size)
+ )
+
+(defun foreign-string-length (foreign-string)
+ #+allegro `(ff:foreign-strlen ,foreign-string)
+ #-allegro
+ `(loop with size = 0
+ until (char= (deref-array ,foreign-string '(:array :unsigned-char) size) #\Null)
+ do (incf size)
+ finally return size))
+
+
+(defmacro with-foreign-string ((foreign-string lisp-string) &body body)
+ (let ((result (gensym)))
+ `(let* ((,foreign-string (convert-to-foreign-string ,lisp-string))
+ (,result (progn ,@body)))
+ (declare (dynamic-extent ,foreign-string))
+ (free-foreign-object ,foreign-string)
+ ,result)))
+
+(defmacro with-foreign-strings (bindings &body body)
+ `(with-foreign-string ,(car bindings)
+ ,@(if (cdr bindings)
+ `((with-foreign-strings ,(cdr bindings) ,@body))
+ body)))
+
+;; Modified from CMUCL's source to handle non-null terminated strings
+#+cmu
+(defun cmucl-naturalize-cstring (sap &key length (null-terminated-p t))
+ (declare (type system:system-area-pointer sap))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((null-terminated-length
+ (when null-terminated-p
+ (loop
+ for offset of-type fixnum upfrom 0
+ until (zerop (system:sap-ref-8 sap offset))
+ finally (return offset)))))
+ (if length
+ (if (and null-terminated-length
+ (> (the fixnum length) (the fixnum null-terminated-length)))
+ (setq length null-terminated-length))
+ (setq length null-terminated-length)))
+ (let ((result (make-string length)))
+ (kernel:copy-from-system-area sap 0
+ result (* vm:vector-data-offset
+ vm:word-bits)
+ (* length vm:byte-bits))
+ result)))
+
+#+scl
+;; kernel:copy-from-system-area doesn't work like it does on CMUCL or SBCL,
+;; so have to iteratively copy from sap
+(defun cmucl-naturalize-cstring (sap &key length (null-terminated-p t))
+ (declare (type system:system-area-pointer sap))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((null-terminated-length
+ (when null-terminated-p
+ (loop
+ for offset of-type fixnum upfrom 0
+ until (zerop (system:sap-ref-8 sap offset))
+ finally (return offset)))))
+ (if length
+ (if (and null-terminated-length
+ (> (the fixnum length) (the fixnum null-terminated-length)))
+ (setq length null-terminated-length))
+ (setq length null-terminated-length)))
+ (let ((result (make-string length)))
+ (dotimes (i length)
+ (declare (type fixnum i))
+ (setf (char result i) (code-char (system:sap-ref-8 sap i))))
+ result)))
+
+#+(and sbcl (not sb-unicode))
+(defun sbcl-naturalize-cstring (sap &key length (null-terminated-p t))
+ (declare (type sb-sys:system-area-pointer sap)
+ (type (or null fixnum) length))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((null-terminated-length
+ (when null-terminated-p
+ (loop
+ for offset of-type fixnum upfrom 0
+ until (zerop (sb-sys:sap-ref-8 sap offset))
+ finally (return offset)))))
+ (if length
+ (if (and null-terminated-length
+ (> (the fixnum length) (the fixnum null-terminated-length)))
+ (setq length null-terminated-length))
+ (setq length null-terminated-length)))
+ (let ((result (make-string length)))
+ (funcall *system-copy-fn* sap 0 result +system-copy-offset+
+ (* length +system-copy-multiplier+))
+ result)))
+
+#+(and sbcl sb-unicode)
+(defun sbcl-naturalize-cstring (sap &key length (null-terminated-p t))
+ (declare (type sb-sys:system-area-pointer sap)
+ (type (or null fixnum) length))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (cond
+ (null-terminated-p
+ (let ((casted (sb-alien:cast (sb-alien:sap-alien sap (* char))
+ #+sb-unicode sb-alien:utf8-string
+ #-sb-unicode sb-alien:c-string)))
+ (if length
+ (copy-seq (subseq casted 0 length))
+ (copy-seq casted))))
+ (t
+ (let ((result (make-string length)))
+ ;; this will not work in sb-unicode
+ (funcall *system-copy-fn* sap 0 result +system-copy-offset+
+ (* length +system-copy-multiplier+))
+ result)))))
+
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (def-function "strlen"
+ ((str (* :unsigned-char)))
+ :returning :unsigned-int))
+
+(def-type char-ptr-def (* :unsigned-char))
+
+#+(or (and allegro (not ics)) (and lispworks (not lispworks5)))
+(defun fast-native-to-string (s len)
+ (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ (type char-ptr-def s))
+ (let* ((len (or len (strlen s)))
+ (str (make-string len)))
+ (declare (fixnum len)
+ (type (simple-array #+lispworks base-char
+ #-lispworks (signed-byte 8) (*)) str))
+ (dotimes (i len str)
+ (setf (aref str i)
+ (uffi:deref-array s '(:array :char) i)))))
+
+#+(or (and allegro ics) lispworks5)
+(defun fast-native-to-string (s len)
+ (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ (type char-ptr-def s))
+ (let* ((len (or len (strlen s)))
+ (str (make-string len)))
+ (dotimes (i len str)
+ (setf (schar str i) (code-char (uffi:deref-array s '(:array :unsigned-byte) i))))))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/Makefile
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/Makefile Mon Feb 11 09:23:05 2008
@@ -0,0 +1,30 @@
+# FILE IDENTIFICATION
+#
+# Name: Makefile
+# Purpose: Makefile for UFFI examples
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile 10614 2005-07-06 01:05:14Z kevin $
+#
+# This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+
+SUBDIRS=
+
+include ../Makefile.common
+
+base=uffi-c-test
+source=$(base).c
+object=$(base).o
+shared_lib=$(base).so
+
+.PHONY: all
+all: $(shared_lib)
+
+$(shared_lib): $(source) Makefile
+ BASE=$(base) OBJECT=$(object) SOURCE=$(source) SHARED_LIB=$(shared_lib) sh make.sh
+ rm $(object)
+
+.PHONY: distclean
+distclean: clean
+ rm -f $(base).dylib $(base).dylib $(base).so $(base).o
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/Makefile.msvc
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/Makefile.msvc Mon Feb 11 09:23:05 2008
@@ -0,0 +1,28 @@
+# FILE IDENTIFICATION
+#
+# Name: Makefile.msvc
+# Purpose: Makefile for the CLSQL UFFI helper package (MSVC)
+# Programer: Kevin M. Rosenberg
+# Date Started: Mar 2002
+#
+# CVS Id: $Id: Makefile.msvc,v 1.1 2002/03/23 10:26:03 kevin Exp $
+#
+# This file, part of CLSQL, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+#
+
+BASE=c-test-fns
+
+# Nothing to configure beyond here
+
+SRC=$(BASE).c
+OBJ=$(BASE).obj
+DLL=$(BASE).dll
+
+$(DLL): $(SRC)
+ cl /MD /LD -D_MT /DWIN32=1 $(SRC)
+ del $(OBJ) $(BASE).exp
+
+clean:
+ del /q $(DLL)
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/arrays.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/arrays.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,57 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: arrays.lisp
+;;;; Purpose: UFFI test arrays
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: arrays.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-constant +column-length+ 10)
+(uffi:def-constant +row-length+ 10)
+
+(uffi:def-foreign-type long-ptr (* :long))
+
+(deftest :array.1
+ (let ((a (uffi:allocate-foreign-object :long +column-length+))
+ (results nil))
+ (dotimes (i +column-length+)
+ (setf (uffi:deref-array a '(:array :long) i) (* i i)))
+ (dotimes (i +column-length+)
+ (push (uffi:deref-array a '(:array :long) i) results))
+ (uffi:free-foreign-object a)
+ (nreverse results))
+ (0 1 4 9 16 25 36 49 64 81))
+
+
+(deftest :array.2
+ (let ((a (uffi:allocate-foreign-object 'long-ptr +row-length+))
+ (results nil))
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (setf (uffi:deref-array a '(:array (* :long)) r)
+ (uffi:allocate-foreign-object :long +column-length+))
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (setf (uffi:deref-array col '(:array :long) c) (+ (* r +column-length+) c)))))
+
+ (dotimes (r +row-length+)
+ (declare (fixnum r))
+ (let ((col (uffi:deref-array a '(:array (* :long)) r)))
+ (dotimes (c +column-length+)
+ (declare (fixnum c))
+ (push (uffi:deref-array col '(:array :long) c) results))))
+ (uffi:free-foreign-object a)
+ (nreverse results))
+ (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99))
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/atoifl.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/atoifl.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,42 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: atoifl.lisp
+;;;; Purpose: UFFI Example file to atoi/atof/atol
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: atoifl.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-function ("atoi" c-atoi)
+ ((str :cstring))
+ :returning :int)
+
+(uffi:def-function ("atol" c-atol)
+ ((str :cstring))
+ :returning :long)
+
+(uffi:def-function ("atof" c-atof)
+ ((str :cstring))
+ :returning :double)
+
+(defun atoi (str)
+ "Returns a int from a string."
+ (uffi:with-cstring (str-cstring str)
+ (c-atoi str-cstring)))
+
+(defun atof (str)
+ "Returns a double float from a string."
+ (uffi:with-cstring (str-cstring str)
+ (c-atof str-cstring)))
+
+(deftest :atoi.1 (atoi "123") 123)
+(deftest :atoi.2 (atoi "") 0)
+(deftest :atof.3 (atof "2.23") 2.23d0)
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/casts.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/casts.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,51 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICAION
+;;;;
+;;;; Name: casts.lisp
+;;;; Purpose: Tests of with-cast-pointer
+;;;; Programmer: Kevin M. Rosenberg / Edi Weitz
+;;;; Date Started: Aug 2003
+;;;;
+;;;; $Id: casts.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-function ("cast_test_int" cast-test-int)
+ ()
+ :module "uffi_tests"
+ :returning :pointer-void)
+
+(uffi:def-function ("cast_test_float" cast-test-float)
+ ()
+ :module "uffi_tests"
+ :returning :pointer-void)
+
+(deftest :cast.1
+ (progn
+ (uffi:with-cast-pointer (temp (cast-test-int) :int)
+ (assert (= (uffi:deref-pointer temp :int) 23)))
+ (let ((result (cast-test-int)))
+ (uffi:with-cast-pointer (result2 result :int)
+ (assert (= (uffi:deref-pointer result2 :int) 23)))
+ (uffi:with-cast-pointer (temp result :int)
+ (assert (= (uffi:deref-pointer temp :int) 23))))
+ t)
+ t)
+
+(deftest :cast.2
+ (progn
+ (uffi:with-cast-pointer (temp (cast-test-float) :double)
+ (assert (= (uffi:deref-pointer temp :double) 3.21d0)))
+ (let ((result (cast-test-float)))
+ (uffi:with-cast-pointer (result2 result :double)
+ (assert (= (uffi:deref-pointer result2 :double) 3.21d0)))
+ (uffi:with-cast-pointer (temp result :double)
+ (assert (= (uffi:deref-pointer temp :double) 3.21d0))))
+ t)
+ t)
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/compress.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/compress.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,92 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: compress.lisp
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: compress.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-function ("compress" c-compress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun compress (source)
+ "Returns two values: array of bytes containing the compressed data
+ and the numbe of compressed bytes"
+ (let* ((sourcelen (length source))
+ (destsize (+ 12 (ceiling (* sourcelen 1.01))))
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-compress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (values (uffi:convert-from-foreign-usb8
+ dest newdestlen)
+ newdestlen)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(uffi:def-function ("uncompress" c-uncompress)
+ ((dest (* :unsigned-char))
+ (destlen (* :long))
+ (source :cstring)
+ (source-len :long))
+ :returning :int
+ :module "zlib")
+
+(defun uncompress (source)
+ (let* ((sourcelen (length source))
+ (destsize 200000) ;adjust as needed
+ (dest (uffi:allocate-foreign-string destsize :unsigned t))
+ (destlen (uffi:allocate-foreign-object :long)))
+ (setf (uffi:deref-pointer destlen :long) destsize)
+ (uffi:with-cstring (source-native source)
+ (let ((result (c-uncompress dest destlen source-native sourcelen))
+ (newdestlen (uffi:deref-pointer destlen :long)))
+ (unwind-protect
+ (if (zerop result)
+ (uffi:convert-from-foreign-string
+ dest
+ :length newdestlen
+ :null-terminated-p nil)
+ (error "zlib error, code ~D" result))
+ (progn
+ (uffi:free-foreign-object destlen)
+ (uffi:free-foreign-object dest)))))))
+
+(deftest :compress.1 (compress "")
+ #(120 156 3 0 0 0 0 1) 8)
+(deftest :compress.2 (compress "test")
+ #(120 156 43 73 45 46 1 0 4 93 1 193) 12)
+(deftest :compress.3 (compress "test2")
+ #(120 156 43 73 45 46 49 2 0 6 80 1 243) 13)
+
+(defun compress-uncompress (str)
+ (multiple-value-bind (compressed len) (compress str)
+ (declare (ignore len))
+ (multiple-value-bind (uncompressed len2) (uncompress compressed)
+ (declare (ignore len2))
+ uncompressed)))
+
+
+(deftest :uncompress.1 "" "")
+(deftest :uncompress.2 "test" "test")
+(deftest :uncompress.3 "test2" "test2")
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/foreign-loader.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/foreign-loader.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,47 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: foreign-loader.lisp
+;;;; Purpose: Loads foreign libraries
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: foreign-loader.lisp 11021 2006-08-14 04:22:28Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+;;; For CMUCL, it's necessary to load foreign files separate from their
+;;; usage
+
+(in-package uffi-tests)
+
+#+clisp (uffi:load-foreign-library "/usr/lib/libz.so" :module "z")
+#-clisp
+(unless (uffi:load-foreign-library
+ (uffi:find-foreign-library
+ #-(or macosx darwin)
+ "libz"
+ #+(or macosx darwin)
+ "z"
+ (list (pathname-directory *load-pathname*)
+ "/usr/local/lib/" #+(or 64bit x86-64) "/usr/lib64/"
+ "/usr/lib/" "/zlib/"))
+ :module "zlib"
+ :supporting-libraries '("c"))
+ (warn "Unable to load zlib"))
+
+#+clisp (uffi:load-foreign-library "/home/kevin/debian/src/uffi/tests/uffi-c-test.so" :module "uffi_tests")
+#-clisp
+(unless (uffi:load-foreign-library
+ (uffi:find-foreign-library
+ '(#+(or 64bit x86-64) "uffi-c-test64" "uffi-c-test")
+ (list (pathname-directory *load-truename*)
+ "/usr/lib/uffi/"
+ "/home/kevin/debian/src/uffi/tests/"))
+ :supporting-libraries '("c")
+ :module "uffi_tests")
+ (warn "Unable to load uffi-c-test library"))
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/foreign-var.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/foreign-var.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,88 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: foreign-var
+;;;; Purpose: Tests of foreign variables
+;;;; Authors: Kevin M. Rosenberg and Edi Weitz
+;;;; Date Started: Aug 2003
+;;;;
+;;;; $Id: foreign-var.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(def-foreign-var "uchar_13" :unsigned-byte "uffi_tests")
+(def-foreign-var "schar_neg_120" :byte "uffi_tests")
+(def-foreign-var "uword_257" :unsigned-short "uffi_tests")
+(def-foreign-var "sword_neg_321" :short "uffi_tests")
+(def-foreign-var "uint_1234567" :int "uffi_tests")
+(def-foreign-var "sint_neg_123456" :int "uffi_tests")
+(def-foreign-var "float_neg_4_5" :float "uffi_tests")
+(def-foreign-var "double_3_1" :double "uffi_tests")
+
+(deftest :fvar.1 uchar-13 13)
+(deftest :fvar.2 schar-neg-120 -120)
+(deftest :fvar.3 uword-257 257)
+(deftest :fvar.4 sword-neg-321 -321)
+(deftest :fvar.5 uint-1234567 1234567)
+(deftest :fvar.6 sint-neg-123456 -123456)
+(deftest :fvar.7 float-neg-4-5 -4.5f0)
+(deftest :fvar.8 double-3-1 3.1d0)
+
+(uffi:def-foreign-var ("fvar_addend" *fvar-addend*) :int "uffi_tests")
+
+(uffi:def-struct fvar-struct
+ (i :int)
+ (d :double))
+
+(uffi:def-foreign-var ("fvar_struct" *fvar-struct*) fvar-struct
+ "uffi_tests")
+
+(uffi:def-function ("fvar_struct_int" fvar-struct-int)
+ ()
+ :returning :int
+ :module "uffi_tests")
+
+ (uffi:def-function ("fvar_struct_double" fvar-struct-double)
+ ()
+ :returning :double
+ :module "uffi_tests")
+
+(deftest :fvarst.1 *fvar-addend* 3)
+(deftest :fvarst.2 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 42)
+(deftest :fvarst.3 (= (+ *fvar-addend*
+ (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i))
+ (fvar-struct-int))
+ t)
+(deftest :fvarst.4 (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd) 3.2d0)
+(deftest :fvarst.5 (= (uffi:get-slot-value *fvar-struct* 'fvar-struct 'd)
+ (fvar-struct-double))
+ t)
+
+(deftest fvarst.6
+ (let ((orig *fvar-addend*))
+ (incf *fvar-addend* 3)
+ (prog1
+ *fvar-addend*
+ (setf *fvar-addend* orig)))
+ 6)
+
+(deftest fvarst.7
+ (let ((orig *fvar-addend*))
+ (incf *fvar-addend* 3)
+ (prog1
+ (fvar-struct-int)
+ (setf *fvar-addend* orig)))
+ 48)
+
+(deftest fvarst.8
+ (let ((orig (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i)))
+ (decf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) 10)
+ (prog1
+ (fvar-struct-int)
+ (setf (uffi:get-slot-value *fvar-struct* 'fvar-struct 'i) orig)))
+ 35)
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/getenv.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/getenv.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,64 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: getenv.lisp
+;;;; Purpose: UFFI Example file to get environment variable
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: getenv.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+
+(uffi:def-function ("getenv" c-getenv)
+ ((name :cstring))
+ :returning :cstring)
+
+(uffi:def-function ("setenv" c-setenv)
+ ((name :cstring)
+ (value :cstring)
+ (overwrite :int))
+ :returning :int)
+
+(uffi:def-function ("unsetenv" c-unsetenv)
+ ((name :cstring))
+ :returning :void)
+
+(defun my-getenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-cstring (key-native key)
+ (uffi:convert-from-cstring (c-getenv key-native))))
+
+(defun my-setenv (key name &optional (overwrite t))
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (check-type name string)
+ (setq overwrite (if overwrite 1 0))
+ (uffi:with-cstrings ((key-native key)
+ (name-native name))
+ (c-setenv key-native name-native (if overwrite 1 0))))
+
+(defun my-unsetenv (key)
+ "Returns an environment variable, or NIL if it does not exist"
+ (check-type key string)
+ (uffi:with-cstrings ((key-native key))
+ (c-unsetenv key-native)))
+
+(deftest :getenv.1 (progn
+ (my-unsetenv "__UFFI_FOO1__")
+ (my-getenv "__UFFI_FOO1__"))
+ nil)
+(deftest :getenv.2 (progn
+ (my-setenv "__UFFI_FOO1__" "UFFI-TEST")
+ (my-getenv "__UFFI_FOO1__"))
+ "UFFI-TEST")
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/gethostname.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/gethostname.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,52 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: gethostname.lisp
+;;;; Purpose: UFFI Example file to get hostname of system
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: gethostname.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+
+;;; This example is inspired by the example on the CL-Cookbook web site
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (uffi:def-function ("gethostname" c-gethostname)
+ ((name (* :unsigned-char))
+ (len :int))
+ :returning :int)
+
+ (defun gethostname ()
+ "Returns the hostname"
+ (let* ((name (uffi:allocate-foreign-string 256))
+ (result-code (c-gethostname name 256))
+ (hostname (when (zerop result-code)
+ (uffi:convert-from-foreign-string name))))
+ (uffi:free-foreign-object name)
+ (unless (zerop result-code)
+ (error "gethostname() failed."))
+ hostname))
+
+ (defun gethostname2 ()
+ "Returns the hostname"
+ (uffi:with-foreign-object (name '(:array :unsigned-char 256))
+ (if (zerop (c-gethostname (uffi:char-array-to-pointer name) 256))
+ (uffi:convert-from-foreign-string name)
+ (error "gethostname() failed.")))))
+
+(deftest :gethostname.1 (stringp (gethostname)) t)
+(deftest :gethostname.2 (stringp (gethostname2)) t)
+(deftest :gethostname.3 (plusp (length (gethostname))) t)
+(deftest :gethostname.4 (plusp (length (gethostname2))) t)
+(deftest :gethostname.5 (string= (gethostname) (gethostname2)) t)
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/make.sh
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/make.sh Mon Feb 11 09:23:05 2008
@@ -0,0 +1,45 @@
+#!/bin/sh
+
+case "`uname`" in
+ Linux) os_linux=1 ;;
+ FreeBSD) os_freebsd=1 ;;
+ GNU/kFreeBSD) os_gnukfreebsd=1;;
+ Darwin) os_darwin=1 ;;
+ SunOS) os_sunos=1 ;;
+ AIX) os_aix=1 ;;
+ GNU) os_gnu=1 ;;
+ *) echo "Unable to identify uname " `uname`
+ exit 1 ;;
+esac
+
+if [ "$os_linux" ]; then
+ gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+ gcc -shared $OBJECT -o $SHARED_LIB
+
+elif [ "$os_gnu" ]; then
+ gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+ gcc -shared $OBJECT -o $SHARED_LIB
+
+elif [ "$os_freebsd" ]; then
+ gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+ gcc -shared $OBJECT -o $SHARED_LIB
+
+elif [ "$os_gnukfreebsd" ]; then
+ gcc -fPIC -DPIC -c $SOURCE -o $OBJECT
+ gcc -shared $OBJECT -o $SHARED_LIB
+
+elif [ "$os_darwin" ]; then
+ cc -dynamic -c $SOURCE -o $OBJECT
+ ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress -o $BASE.dylib $OBJECT
+ ld -bundle /usr/lib/bundle1.o -flat_namespace -undefined suppress /usr/lib/libz.dylib -o z.dylib
+
+elif [ "$os_sunos" ]; then
+ cc -KPIC -c $SOURCE -o $OBJECT
+ cc -G $OBJECT -o $SHARED_LIB
+
+elif [ "$os_aix" ]; then
+ gcc -c -D_BSD -D_NO_PROTO -D_NONSTD_TYPES -D_MBI=void $SOURCE
+ make_shared -o $SHARED_LIB $OBJECT
+fi
+
+exit 0
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/objects.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/objects.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,70 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: pointers.lisp
+;;;; Purpose: Test file for UFFI pointers
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Aug 2003
+;;;;
+;;;; $Id: objects.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(deftest :chptr.1
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (ensure-char-character
+ (deref-pointer fs :char))))
+ #\t)
+
+(deftest :chptr.2
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (ensure-char-character
+ (deref-pointer fs :unsigned-char))))
+ #\t)
+
+(deftest :chptr.3
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (ensure-char-integer
+ (deref-pointer fs :unsigned-char))))
+ 116)
+
+(deftest :chptr.4
+ (let ((native-string "test string"))
+ (uffi:with-foreign-string (fs native-string)
+ (integerp
+ (ensure-char-integer
+ (deref-pointer fs :unsigned-char)))))
+ t)
+
+(deftest :chptr.5
+ (let ((fs (uffi:allocate-foreign-object :unsigned-char 128)))
+ (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
+ (uffi:ensure-char-storable #\a))
+ (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
+ (uffi:ensure-char-storable (code-char 0)))
+ (uffi:convert-from-foreign-string fs))
+ "a")
+
+;; This produces an array which needs fli:foreign-aref to access
+;; rather than fli:dereference
+
+#-lispworks
+(deftest :chptr.6
+ (uffi:with-foreign-object (fs '(:array :unsigned-char 128))
+ (setf (uffi:deref-array fs '(:array :unsigned-char) 0)
+ (uffi:ensure-char-storable #\a))
+ (setf (uffi:deref-array fs '(:array :unsigned-char) 1)
+ (uffi:ensure-char-storable (code-char 0)))
+ (uffi:convert-from-foreign-string fs))
+ "a")
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/package.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/package.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,20 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.lisp
+;;;; Purpose: Package file uffi testing suite
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Apr 2003
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2003-2005 by Kevin M. Rosenberg
+;;;;
+;;;; $Id: package.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;; *************************************************************************
+
+(defpackage #:uffi-tests
+ (:use #:asdf #:cl #:uffi #:rtest)
+ (:shadowing-import-from #:uffi #:run-shell-command))
+
+(in-package #:uffi-tests)
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/rt.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/rt.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,254 @@
+#|----------------------------------------------------------------------------|
+ | Copyright 1990 by the Massachusetts Institute of Technology, Cambridge MA. |
+ | |
+ | Permission to use, copy, modify, and distribute this software and its |
+ | documentation for any purpose and without fee is hereby granted, provided |
+ | that this copyright and permission notice appear in all copies and |
+ | supporting documentation, and that the name of M.I.T. not be used in |
+ | advertising or publicity pertaining to distribution of the software |
+ | without specific, written prior permission. M.I.T. makes no |
+ | representations about the suitability of this software for any purpose. |
+ | It is provided "as is" without express or implied warranty. |
+ | |
+ | M.I.T. DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING |
+ | ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL |
+ | M.I.T. BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR |
+ | ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, |
+ | WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, |
+ | ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS |
+ | SOFTWARE. |
+ |----------------------------------------------------------------------------|#
+
+(defpackage #:regression-test
+ (:nicknames #:rtest #-lispworks #:rt)
+ (:use #:cl)
+ (:export #:*do-tests-when-defined* #:*test* #:continue-testing
+ #:deftest #:do-test #:do-tests #:get-test #:pending-tests
+ #:rem-all-tests #:rem-test)
+ (:documentation "The MIT regression tester with pfdietz's modifications"))
+
+(in-package :regression-test)
+
+(defvar *test* nil "Current test name")
+(defvar *do-tests-when-defined* nil)
+(defvar *entries* '(nil) "Test database")
+(defvar *in-test* nil "Used by TEST")
+(defvar *debug* nil "For debugging")
+(defvar *catch-errors* t
+ "When true, causes errors in a test to be caught.")
+(defvar *print-circle-on-failure* nil
+ "Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
+(defvar *compile-tests* nil
+ "When true, compile the tests before running them.")
+(defvar *optimization-settings* '((safety 3)))
+(defvar *expected-failures* nil
+ "A list of test names that are expected to fail.")
+
+(defstruct (entry (:conc-name nil)
+ (:type list))
+ pend name form)
+
+(defmacro vals (entry) `(cdddr ,entry))
+
+(defmacro defn (entry) `(cdr ,entry))
+
+(defun pending-tests ()
+ (do ((l (cdr *entries*) (cdr l))
+ (r nil))
+ ((null l) (nreverse r))
+ (when (pend (car l))
+ (push (name (car l)) r))))
+
+(defun rem-all-tests ()
+ (setq *entries* (list nil))
+ nil)
+
+(defun rem-test (&optional (name *test*))
+ (do ((l *entries* (cdr l)))
+ ((null (cdr l)) nil)
+ (when (equal (name (cadr l)) name)
+ (setf (cdr l) (cddr l))
+ (return name))))
+
+(defun get-test (&optional (name *test*))
+ (defn (get-entry name)))
+
+(defun get-entry (name)
+ (let ((entry (find name (cdr *entries*)
+ :key #'name
+ :test #'equal)))
+ (when (null entry)
+ (report-error t
+ "~%No test with name ~:@(~S~)."
+ name))
+ entry))
+
+(defmacro deftest (name form &rest values)
+ `(add-entry '(t ,name ,form .,values)))
+
+(defun add-entry (entry)
+ (setq entry (copy-list entry))
+ (do ((l *entries* (cdr l))) (nil)
+ (when (null (cdr l))
+ (setf (cdr l) (list entry))
+ (return nil))
+ (when (equal (name (cadr l))
+ (name entry))
+ (setf (cadr l) entry)
+ (report-error nil
+ "Redefining test ~:@(~S~)"
+ (name entry))
+ (return nil)))
+ (when *do-tests-when-defined*
+ (do-entry entry))
+ (setq *test* (name entry)))
+
+(defun report-error (error? &rest args)
+ (cond (*debug*
+ (apply #'format t args)
+ (if error? (throw '*debug* nil)))
+ (error? (apply #'error args))
+ (t (apply #'warn args))))
+
+(defun do-test (&optional (name *test*))
+ (do-entry (get-entry name)))
+
+(defun equalp-with-case (x y)
+ "Like EQUALP, but doesn't do case conversion of characters."
+ (cond
+ ((eq x y) t)
+ ((consp x)
+ (and (consp y)
+ (equalp-with-case (car x) (car y))
+ (equalp-with-case (cdr x) (cdr y))))
+ ((and (typep x 'array)
+ (= (array-rank x) 0))
+ (equalp-with-case (aref x) (aref y)))
+ ((typep x 'vector)
+ (and (typep y 'vector)
+ (let ((x-len (length x))
+ (y-len (length y)))
+ (and (eql x-len y-len)
+ (loop
+ for e1 across x
+ for e2 across y
+ always (equalp-with-case e1 e2))))))
+ ((and (typep x 'array)
+ (typep y 'array)
+ (not (equal (array-dimensions x)
+ (array-dimensions y))))
+ nil)
+ ((typep x 'array)
+ (and (typep y 'array)
+ (let ((size (array-total-size x)))
+ (loop for i from 0 below size
+ always (equalp-with-case (row-major-aref x i)
+ (row-major-aref y i))))))
+ (t (eql x y))))
+
+(defun do-entry (entry &optional
+ (s *standard-output*))
+ (catch '*in-test*
+ (setq *test* (name entry))
+ (setf (pend entry) t)
+ (let* ((*in-test* t)
+ ;; (*break-on-warnings* t)
+ (aborted nil)
+ r)
+ ;; (declare (special *break-on-warnings*))
+
+ (block aborted
+ (setf r
+ (flet ((%do
+ ()
+ (if *compile-tests*
+ (multiple-value-list
+ (funcall (compile
+ nil
+ `(lambda ()
+ (declare
+ (optimize ,@*optimization-settings*))
+ ,(form entry)))))
+ (multiple-value-list
+ (eval (form entry))))))
+ (if *catch-errors*
+ (handler-bind
+ ((style-warning #'muffle-warning)
+ (error #'(lambda (c)
+ (setf aborted t)
+ (setf r (list c))
+ (return-from aborted nil))))
+ (%do))
+ (%do)))))
+
+ (setf (pend entry)
+ (or aborted
+ (not (equalp-with-case r (vals entry)))))
+
+ (when (pend entry)
+ (let ((*print-circle* *print-circle-on-failure*))
+ (format s "~&Test ~:@(~S~) failed~
+ ~%Form: ~S~
+ ~%Expected value~P: ~
+ ~{~S~^~%~17t~}~%"
+ *test* (form entry)
+ (length (vals entry))
+ (vals entry))
+ (format s "Actual value~P: ~
+ ~{~S~^~%~15t~}.~%"
+ (length r) r)))))
+ (when (not (pend entry)) *test*))
+
+(defun continue-testing ()
+ (if *in-test*
+ (throw '*in-test* nil)
+ (do-entries *standard-output*)))
+
+(defun do-tests (&optional
+ (out *standard-output*))
+ (dolist (entry (cdr *entries*))
+ (setf (pend entry) t))
+ (if (streamp out)
+ (do-entries out)
+ (with-open-file
+ (stream out :direction :output)
+ (do-entries stream))))
+
+(defun do-entries (s)
+ (format s "~&Doing ~A pending test~:P ~
+ of ~A tests total.~%"
+ (count t (cdr *entries*)
+ :key #'pend)
+ (length (cdr *entries*)))
+ (dolist (entry (cdr *entries*))
+ (when (pend entry)
+ (format s "~@[~<~%~:; ~:@(~S~)~>~]"
+ (do-entry entry s))))
+ (let ((pending (pending-tests))
+ (expected-table (make-hash-table :test #'equal)))
+ (dolist (ex *expected-failures*)
+ (setf (gethash ex expected-table) t))
+ (let ((new-failures
+ (loop for pend in pending
+ unless (gethash pend expected-table)
+ collect pend)))
+ (if (null pending)
+ (format s "~&No tests failed.")
+ (progn
+ (format s "~&~A out of ~A ~
+ total tests failed: ~
+ ~:@(~{~<~% ~1:;~S~>~
+ ~^, ~}~)."
+ (length pending)
+ (length (cdr *entries*))
+ pending)
+ (if (null new-failures)
+ (format s "~&No unexpected failures.")
+ (when *expected-failures*
+ (format s "~&~A unexpected failures: ~
+ ~:@(~{~<~% ~1:;~S~>~
+ ~^, ~}~)."
+ (length new-failures)
+ new-failures)))
+ ))
+ (null pending))))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/strtol.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/strtol.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,64 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: strtol.lisp
+;;;; Purpose: UFFI Example file to strtol, uses pointer arithmetic
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: strtol.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-foreign-type char-ptr (* :unsigned-char))
+
+;; This example does not use :cstring to pass the input string since
+;; the routine needs to do pointer arithmetic to see how many characters
+;; were parsed
+
+(uffi:def-function ("strtol" c-strtol)
+ ((nptr char-ptr)
+ (endptr (* char-ptr))
+ (base :int))
+ :returning :long)
+
+(defun strtol (str &optional (base 10))
+ "Returns a long int from a string. Returns number and condition flag.
+Condition flag is T if all of string parses as a long, NIL if
+their was no string at all, or an integer indicating position in string
+of first non-valid character"
+ (let* ((str-native (uffi:convert-to-foreign-string str))
+ (endptr (uffi:allocate-foreign-object 'char-ptr))
+ (value (c-strtol str-native endptr base))
+ (endptr-value (uffi:deref-pointer endptr 'char-ptr)))
+
+ (unwind-protect
+ (if (uffi:null-pointer-p endptr-value)
+ (values value t)
+ (let ((next-char-value (uffi:deref-pointer endptr-value :unsigned-char))
+ (chars-parsed (- (uffi:pointer-address endptr-value)
+ (uffi:pointer-address str-native))))
+ (cond
+ ((zerop chars-parsed)
+ (values nil nil))
+ ((uffi:null-char-p next-char-value)
+ (values value t))
+ (t
+ (values value chars-parsed)))))
+ (progn
+ (uffi:free-foreign-object str-native)
+ (uffi:free-foreign-object endptr)))))
+
+(deftest :strtol.1 (strtol "123") 123 t)
+(deftest :strtol.2 (strtol "0") 0 t)
+(deftest :strtol.3 (strtol "55a") 55 2)
+(deftest :strtol.4 (strtol "a") nil nil)
+
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/structs.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/structs.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,36 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: structs.lisp
+;;;; Purpose: Test file for UFFI structures
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: structs.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+;; Compilation failure as reported by Edi Weitz
+
+
+(uffi:def-struct foo
+ (bar :pointer-self))
+
+(uffi:def-foreign-type foo-ptr (* foo))
+
+;; tests that compilation worked
+(deftest :structs.1
+ (with-foreign-object (p 'foo)
+ t)
+ t)
+
+(deftest :structs.2
+ (progn
+ (uffi:def-foreign-type foo-struct (:struct foo))
+ t)
+ t)
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/time.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/time.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,110 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: time.lisp
+;;;; Purpose: UFFI test file, time, use C structures
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: time.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-foreign-type time-t :unsigned-long)
+
+(uffi:def-struct tm
+ (sec :int)
+ (min :int)
+ (hour :int)
+ (mday :int)
+ (mon :int)
+ (year :int)
+ (wday :int)
+ (yday :int)
+ (isdst :int)
+ ;; gmoffset present on SusE SLES9
+ (gmoffset :long))
+
+(uffi:def-function ("time" c-time)
+ ((time (* time-t)))
+ :returning time-t)
+
+(uffi:def-function "gmtime"
+ ((time (* time-t)))
+ :returning (:struct-pointer tm))
+
+(uffi:def-function "asctime"
+ ((time (:struct-pointer tm)))
+ :returning :cstring)
+
+(uffi:def-type time-t :unsigned-long)
+(uffi:def-type tm-pointer (:struct-pointer tm))
+
+(deftest :time.1
+ (uffi:with-foreign-object (time 'time-t)
+ (setf (uffi:deref-pointer time :unsigned-long) 7381)
+ (uffi:deref-pointer time :unsigned-long))
+ 7381)
+
+(deftest :time.2
+ (uffi:with-foreign-object (time 'time-t)
+ (setf (uffi:deref-pointer time :unsigned-long) 7381)
+ (let ((tm-ptr (the tm-pointer (gmtime time))))
+ (values (1+ (uffi:get-slot-value tm-ptr 'tm 'mon))
+ (uffi:get-slot-value tm-ptr 'tm 'mday)
+ (+ 1900 (uffi:get-slot-value tm-ptr 'tm 'year))
+ (uffi:get-slot-value tm-ptr 'tm 'hour)
+ (uffi:get-slot-value tm-ptr 'tm 'min)
+ (uffi:get-slot-value tm-ptr 'tm 'sec)
+ )))
+ 1 1 1970 2 3 1)
+
+
+(uffi:def-struct timeval
+ (secs :long)
+ (usecs :long))
+
+(uffi:def-struct timezone
+ (minutes-west :int)
+ (dsttime :int))
+
+(uffi:def-function ("gettimeofday" c-gettimeofday)
+ ((tv (* timeval))
+ (tz (* timezone)))
+ :returning :int)
+
+(defun get-utime ()
+ (uffi:with-foreign-object (tv 'timeval)
+ (let ((res (c-gettimeofday tv (uffi:make-null-pointer 'timezone))))
+ (values
+ (+ (* 1000000 (uffi:get-slot-value tv 'timeval 'secs))
+ (uffi:get-slot-value tv 'timeval 'usecs))
+ res))))
+
+(deftest :timeofday.1
+ (multiple-value-bind (t1 res1) (get-utime)
+ (multiple-value-bind (t2 res2) (get-utime)
+ (and (or (= t2 t1) (> t2 t1))
+ (> t1 1000000000)
+ (> t2 1000000000)
+ (zerop res1)
+ (zerop res2))))
+ t)
+
+(defun posix-time-to-asctime (secs)
+ "Converts number of seconds elapsed since 00:00:00 on January 1, 1970, Coordinated Universal Time (UTC)"
+ (string-right-trim
+ '(#\newline #\return)
+ (uffi:convert-from-cstring
+ (uffi:with-foreign-object (time 'time-t)
+ (setf (uffi:deref-pointer time :unsigned-long) secs)
+ (asctime (gmtime time))))))
+
+(deftest :time.3
+ (posix-time-to-asctime 0)
+ "Thu Jan 1 00:00:00 1970")
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/uffi-c-test-lib.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/uffi-c-test-lib.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,98 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: uffi-c-test-lib.lisp
+;;;; Purpose: UFFI Example file for zlib compression
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: uffi-c-test-lib.lisp 10608 2005-07-01 00:39:48Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+
+(uffi:def-function ("cs_to_upper" cs-to-upper)
+ ((input (* :unsigned-char)))
+ :returning :void
+ :module "uffi_tests")
+
+(defun string-to-upper (str)
+ (uffi:with-foreign-string (str-foreign str)
+ (cs-to-upper str-foreign)
+ (uffi:convert-from-foreign-string str-foreign)))
+
+(uffi:def-function ("cs_count_upper" cs-count-upper)
+ ((input :cstring))
+ :returning :int
+ :module "uffi_tests")
+
+(defun string-count-upper (str)
+ (uffi:with-cstring (str-cstring str)
+ (cs-count-upper str-cstring)))
+
+(uffi:def-function ("half_double_vector" half-double-vector)
+ ((size :int)
+ (vec (* :double)))
+ :returning :void
+ :module "uffi_tests")
+
+(uffi:def-function ("return_long_negative_one" return-long-negative-one)
+ ()
+ :returning :long
+ :module "uffi_tests")
+
+(uffi:def-function ("return_int_negative_one" return-int-negative-one)
+ ()
+ :returning :int
+ :module "uffi_tests")
+
+(uffi:def-function ("return_short_negative_one" return-short-negative-one)
+ ()
+ :returning :short
+ :module "uffi_tests")
+
+
+(uffi:def-constant +double-vec-length+ 10)
+(defun test-half-double-vector ()
+ (let ((vec (uffi:allocate-foreign-object :double +double-vec-length+))
+ results)
+ (dotimes (i +double-vec-length+)
+ (setf (uffi:deref-array vec '(:array :double) i)
+ (coerce i 'double-float)))
+ (half-double-vector +double-vec-length+ vec)
+ (dotimes (i +double-vec-length+)
+ (push (uffi:deref-array vec '(:array :double) i) results))
+ (uffi:free-foreign-object vec)
+ (nreverse results)))
+
+(defun t2 ()
+ (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+ (dotimes (i +double-vec-length+)
+ (setf (aref vec i) (coerce i 'double-float)))
+ (half-double-vector +double-vec-length+ vec)
+ vec))
+
+#+(or cmu scl)
+(defun t3 ()
+ (let ((vec (make-array +double-vec-length+ :element-type 'double-float)))
+ (dotimes (i +double-vec-length+)
+ (setf (aref vec i) (coerce i 'double-float)))
+ (system:without-gcing
+ (half-double-vector +double-vec-length+ (system:vector-sap vec)))
+ vec))
+
+(deftest :c-test.1 (string-to-upper "this is a test") "THIS IS A TEST")
+(deftest :c-test.2 (string-to-upper nil) nil)
+(deftest :c-test.3 (string-count-upper "This is a Test") 2)
+(deftest :c-test.4 (string-count-upper nil) -1)
+(deftest :c-test.5 (test-half-double-vector)
+ (0.0d0 0.5d0 1.0d0 1.5d0 2.0d0 2.5d0 3.0d0 3.5d0 4.0d0 4.5d0))
+(deftest :c-test.6 (return-long-negative-one) -1)
+(deftest :c-test.7 (return-int-negative-one) -1)
+(deftest :c-test.8 (return-short-negative-one) -1)
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/uffi-c-test.c
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/uffi-c-test.c Mon Feb 11 09:23:05 2008
@@ -0,0 +1,158 @@
+/***************************************************************************
+ * FILE IDENTIFICATION
+ *
+ * Name: c-test-fns.c
+ * Purpose: Test functions in C for UFFI library
+ * Programer: Kevin M. Rosenberg
+ * Date Started: Mar 2002
+ *
+ * CVS Id: $Id: uffi-c-test.c 10614 2005-07-06 01:05:14Z kevin $
+ *
+ * This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+ *
+ * These variables are correct for GCC
+ * you'll need to modify these for other compilers
+ ***************************************************************************/
+
+#ifdef WIN32
+#include <windows.h>
+
+BOOL WINAPI DllEntryPoint(HINSTANCE hinstdll,
+ DWORD fdwReason,
+ LPVOID lpvReserved)
+{
+ return 1;
+}
+
+#define DLLEXPORT __declspec(dllexport)
+
+#else
+#define DLLEXPORT
+#endif
+
+#include <ctype.h>
+#include <stdlib.h>
+#include <math.h>
+
+
+DLLEXPORT unsigned char uchar_13 = 13;
+DLLEXPORT signed char schar_neg_120 = -120;
+DLLEXPORT unsigned short uword_257 = 257;
+DLLEXPORT signed short sword_neg_321 = -321;
+DLLEXPORT unsigned int uint_1234567 = 1234567;
+DLLEXPORT signed int sint_neg_123456 = -123456;
+DLLEXPORT double double_3_1 = 3.1;
+DLLEXPORT float float_neg_4_5 = -4.5;
+
+/* Test of constant input string */
+DLLEXPORT
+int
+cs_count_upper (char* psz)
+{
+ int count = 0;
+
+ if (psz) {
+ while (*psz) {
+ if (isupper (*psz))
+ ++count;
+ ++psz;
+ }
+ return count;
+ } else
+ return -1;
+}
+
+/* Test of input and output of a string */
+DLLEXPORT
+void
+cs_to_upper (char* psz)
+{
+ if (psz) {
+ while (*psz) {
+ *psz = toupper (*psz);
+ ++psz;
+ }
+ }
+}
+
+/* Test of an output only string */
+DLLEXPORT
+void
+cs_make_random (int size, char* buffer)
+{
+ int i;
+ for (i = 0; i < size; i++)
+ buffer[i] = 'A' + (rand() % 26);
+}
+
+
+/* Test of input/output vector */
+DLLEXPORT
+void
+half_double_vector (int size, double* vec)
+{
+ int i;
+ for (i = 0; i < size; i++)
+ vec[i] /= 2.;
+}
+
+
+
+DLLEXPORT
+void *
+cast_test_int () {
+ int *x = (int *) malloc(sizeof(int));
+ *x = 23;
+ return x;
+}
+
+DLLEXPORT
+void *
+cast_test_float ()
+{
+ double *y = (double *) malloc(sizeof(double));
+ *y = 3.21;
+ return y;
+}
+
+DLLEXPORT
+long
+return_long_negative_one ()
+{
+ return -1;
+}
+
+DLLEXPORT
+int
+return_int_negative_one ()
+{
+ return -1;
+}
+
+DLLEXPORT
+short
+return_short_negative_one ()
+{
+ return -1;
+}
+
+DLLEXPORT int fvar_addend = 3;
+
+typedef struct {
+ int i;
+ double d;
+} fvar_struct_type;
+
+fvar_struct_type fvar_struct = {42, 3.2};
+
+DLLEXPORT
+int fvar_struct_int () {
+ return (fvar_addend + fvar_struct.i);
+}
+
+DLLEXPORT
+double fvar_struct_double () {
+ return fvar_struct.d;
+}
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/union.lisp
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/tests/union.lisp Mon Feb 11 09:23:05 2008
@@ -0,0 +1,71 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: union.lisp
+;;;; Purpose: UFFI Example file to test unions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Mar 2002
+;;;;
+;;;; $Id: union.lisp 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(in-package #:uffi-tests)
+
+(uffi:def-union tunion1
+ (char :char)
+ (int :int)
+ (uint :unsigned-int)
+ (sf :float)
+ (df :double))
+
+(defvar *u* (uffi:allocate-foreign-object 'tunion1))
+(setf (uffi:get-slot-value *u* 'tunion1 'uint)
+ #-(or sparc sparc-v9 powerpc ppc)
+ (+ (* 1 (char-code #\A))
+ (* 256 (char-code #\B))
+ (* 65536 (char-code #\C))
+ (* 16777216 128))
+ #+(or sparc sparc-v9 powerpc ppc)
+ (+ (* 16777216 (char-code #\A))
+ (* 65536 (char-code #\B))
+ (* 256 (char-code #\C))
+ (* 1 128)))
+
+(deftest :union.1
+ (uffi:ensure-char-character
+ (uffi:get-slot-value *u* 'tunion1 'char))
+ #\A)
+
+(deftest :union.2
+ (uffi:ensure-char-integer
+ (uffi:get-slot-value *u* 'tunion1 'char))
+ 65)
+
+#-(or sparc sparc-v9 openmcl digitool)
+(deftest :union.3 (plusp (uffi:get-slot-value *u* 'tunion1 'uint)) t)
+
+
+(uffi:def-union foo-u
+ (bar :pointer-self))
+
+(uffi:def-foreign-type foo-u-ptr (* foo-u))
+
+;; tests that compilation worked
+(deftest :unions.4
+ (with-foreign-object (p 'foo-u)
+ t)
+ t)
+
+(deftest :unions.5
+ (progn
+ (uffi:def-foreign-type foo-union (:union foo-u))
+ t)
+ t)
+
+
+
+
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/uffi-tests.asd
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/uffi-tests.asd Mon Feb 11 09:23:05 2008
@@ -0,0 +1,95 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: uffi-tests.asd
+;;;; Purpose: ASDF system definitionf for uffi testing package
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Apr 2003
+;;;;
+;;;; $Id: uffi-tests.asd 10586 2005-06-08 21:51:30Z kevin $
+;;;; *************************************************************************
+
+(defpackage #:uffi-tests-system
+ (:use #:asdf #:cl))
+(in-package #:uffi-tests-system)
+
+(operate 'load-op 'uffi)
+
+(defvar *library-file-dir* (append (pathname-directory *load-truename*)
+ (list "tests")))
+
+(defclass uffi-test-source-file (c-source-file)
+ ())
+
+(defmethod output-files ((o compile-op) (c uffi-test-source-file))
+ (let* ((library-file-type
+ (funcall (intern (symbol-name'#:default-foreign-library-type)
+ (symbol-name '#:uffi))))
+ (found
+ (some #'(lambda (dir)
+ (probe-file (make-pathname
+ :directory dir
+ :name (component-name c)
+ :type library-file-type)))
+ '((:absolute "usr" "lib" "uffi")))))
+ (list (if found
+ found
+ (make-pathname :name (component-name c)
+ :type library-file-type
+ :directory *library-file-dir*)))))
+
+(defmethod perform ((o load-op) (c uffi-test-source-file))
+ nil) ;;; library will be loaded by a loader file
+
+(defmethod operation-done-p ((o load-op) (c uffi-test-source-file))
+ (and (symbol-function (intern (symbol-name '#:cs-count-upper)
+ (find-package '#:uffi-tests)))
+ t))
+
+(defmethod perform ((o compile-op) (c uffi-test-source-file))
+ (unless (operation-done-p o c)
+ #-(or win32 mswindows)
+ (unless (zerop (run-shell-command
+ #-freebsd "cd ~A; make"
+ #+freebsd "cd ~A; gmake"
+ (namestring (make-pathname :name nil
+ :type nil
+ :directory *library-file-dir*))))
+ (error 'operation-error :component c :operation o))))
+
+(defmethod operation-done-p ((o compile-op) (c uffi-test-source-file))
+ (or (and (probe-file #p"/usr/lib/uffi/uffi-c-test.so") t)
+ (let ((lib (make-pathname :defaults (component-pathname c)
+ :type (uffi:default-foreign-library-type))))
+ (and (probe-file lib)
+ (> (file-write-date lib) (file-write-date (component-pathname c)))))))
+
+(defsystem uffi-tests
+ :depends-on (:uffi)
+ :components
+ ((:module tests
+ :components
+ ((:file "rt")
+ (:file "package" :depends-on ("rt"))
+ (:uffi-test-source-file "uffi-c-test" :depends-on ("package"))
+ (:file "strtol" :depends-on ("package"))
+ (:file "atoifl" :depends-on ("package"))
+ (:file "getenv" :depends-on ("package"))
+ (:file "gethostname" :depends-on ("package"))
+ (:file "union" :depends-on ("package"))
+ (:file "arrays" :depends-on ("package"))
+ (:file "structs" :depends-on ("package"))
+ (:file "objects" :depends-on ("package"))
+ (:file "time" :depends-on ("package"))
+ (:file "foreign-loader" :depends-on ("package" "uffi-c-test"))
+ (:file "uffi-c-test-lib" :depends-on ("foreign-loader"))
+ (:file "compress" :depends-on ("foreign-loader"))
+ (:file "casts" :depends-on ("foreign-loader"))
+ (:file "foreign-var" :depends-on ("foreign-loader"))
+ ))))
+
+(defmethod perform ((o test-op) (c (eql (find-system :uffi-tests))))
+ (or (funcall (intern (symbol-name '#:do-tests)
+ (find-package '#:regression-test)))
+ (error "test-op failed")))
Added: branches/trunk-reorg/thirdparty/uffi-1.6.0/uffi.asd
==============================================================================
--- (empty file)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/uffi.asd Mon Feb 11 09:23:05 2008
@@ -0,0 +1,48 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: uffi.asd
+;;;; Purpose: ASDF system definition file for UFFI package
+;;;; Author: Kevin M. Rosenberg
+;;;; Date Started: Aug 2002
+;;;;
+;;;; $Id: uffi.asd 10917 2006-04-18 00:07:09Z kevin $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
+;;;;
+;;;; *************************************************************************
+
+(defpackage #:uffi-system (:use #:asdf #:cl))
+(in-package #:uffi-system)
+
+#+(or allegro lispworks cmu openmcl digitool cormanlisp sbcl scl)
+(defsystem uffi
+ :name "uffi"
+ :author "Kevin Rosenberg <kevin(a)rosenberg.net>"
+ :version "1.2.x"
+ :maintainer "Kevin M. Rosenberg <kmr(a)debian.org>"
+ :licence "Lessor Lisp General Public License"
+ :description "Universal Foreign Function Library for Common Lisp"
+ :long-description "UFFI provides a universal foreign function interface (FFI) for Common Lisp. UFFI supports CMUCL, Lispworks, and AllegroCL."
+
+ :components
+ ((:module :src
+ :components
+ ((:file "package")
+ (:file "primitives" :depends-on ("package"))
+ #+(or openmcl digitool) (:file "readmacros-mcl" :depends-on ("package"))
+ (:file "objects" :depends-on ("primitives"))
+ (:file "aggregates" :depends-on ("primitives"))
+ (:file "strings" :depends-on ("primitives" "functions" "aggregates" "objects"))
+ (:file "functions" :depends-on ("primitives"))
+ (:file "libraries" :depends-on ("package"))
+ (:file "os" :depends-on ("package"))))
+ ))
+
+#+(or allegro lispworks cmu openmcl digitool cormanlisp sbcl scl)
+(defmethod perform ((o test-op) (c (eql (find-system 'uffi))))
+ (oos 'load-op 'uffi-tests)
+ (oos 'test-op 'uffi-tests :force t))
+
+
1
0
[bknr-cvs] r2473 - in branches/trunk-reorg/projects/bos: m2 web
by ksprotte＠common-lisp.net 11 Feb '08
by ksprotte＠common-lisp.net 11 Feb '08
11 Feb '08
Author: ksprotte
Date: Mon Feb 11 09:10:28 2008
New Revision: 2473
Modified:
branches/trunk-reorg/projects/bos/m2/bos.m2.asd
branches/trunk-reorg/projects/bos/web/bos.web.asd
Log:
changed bos dependencies (:bknr does not exist anymore)
bos.m2: :bknr-datastore :bknr-modules
bos.web: :bknr-web :bknr-modules
Modified: branches/trunk-reorg/projects/bos/m2/bos.m2.asd
==============================================================================
--- branches/trunk-reorg/projects/bos/m2/bos.m2.asd (original)
+++ branches/trunk-reorg/projects/bos/m2/bos.m2.asd Mon Feb 11 09:10:28 2008
@@ -1,7 +1,7 @@
(in-package :cl-user)
(asdf:defsystem :bos.m2
- :depends-on (:bknr :bknr-modules :net.post-office :cl-mime :iconv :kmrcl :iterate :arnesi)
+ :depends-on (:bknr-datastore :bknr-modules :cl-smtp :cl-mime :iconv :kmrcl :iterate :arnesi)
:components ((:file "packages")
(:file "geo-utm" :depends-on ("packages"))
(:file "geometry" :depends-on ("packages"))
Modified: branches/trunk-reorg/projects/bos/web/bos.web.asd
==============================================================================
--- branches/trunk-reorg/projects/bos/web/bos.web.asd (original)
+++ branches/trunk-reorg/projects/bos/web/bos.web.asd Mon Feb 11 09:10:28 2008
@@ -16,7 +16,7 @@
:description "worldpay test web server"
:long-description ""
- :depends-on (:bknr :bknr-modules :bos.m2 :cxml)
+ :depends-on (:bknr-web :bknr-modules :bos.m2 :cxml)
:components ((:file "packages")
(:file "utf-8" :depends-on ("packages"))
1
0