bknr-cvs

Download

bknr-cvs@common-lisp.net

1964 discussions

[bknr-cvs] r2482 - trunk/projects/lisp-ecoop/website/templates
by dverna＠common-lisp.net 12 Feb '08

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.  -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

[bknr-cvs] r2481 - branches/trunk-reorg/projects/bos/web
by ksprotte＠common-lisp.net 12 Feb '08

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

[bknr-cvs] r2480 - branches/trunk-reorg/xhtmlgen
by ksprotte＠common-lisp.net 12 Feb '08

12 Feb '08

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

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

[bknr-cvs] r2478 - branches/trunk-reorg/thirdparty/arnesi
by ksprotte＠common-lisp.net 11 Feb '08

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

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

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

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

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"> + +  + <group xml:base="file:///sw/share/xml/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="dtd/docbookx/4.2.0/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="xsl/docbook-xsl/" /> + +  + <nextCatalog catalog="dtd/xml/4.2/catalog.xml" /> + +  +  +  + <system + systemId="docbook.dtd" + uri="dtd/xml/4.2.0/xml/docbookx.dtd" /> + +  + <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"> + +  + <group xml:base="file:///usr/share/sgml/docbook/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="dtd/xml/4.2/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="stylesheet/xsl/nwalsh/" /> + +  + <nextCatalog catalog="dtd/xml/4.2/catalog.xml" /> + +  +  +  + <system + systemId="docbook.dtd" + uri="dtd/xml/4.2/xml/docbookx.dtd" /> + +  + <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"> + +  + <group xml:base="file:///usr/share/sgml/docbook/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="xml-dtd-4.2/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="xsl-stylesheets/" /> + +  + <nextCatalog catalog="xml-dtd-4.2/catalog.xml" /> + +  +  +  + <system + systemId="docbook.dtd" + uri="xml-dtd-4.2/docbookx.dtd" /> + +  + <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"> + +  + <group xml:base="file:///usr/share/xml/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="db42xml/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="docbook/docbook-xsl/" /> + +  + <nextCatalog catalog="db42xml/catalog.xml" /> + +  +  +  + <system + systemId="docbook.dtd" + uri="db42xml/docbookx.dtd" /> + +  + <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"> + +  + <group xml:base="file:///usr/share/sgml/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="db42xml/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="docbook/docbook-xsl/" /> + +  + <nextCatalog catalog="db42xml/catalog.xml" /> + +  +  +  + <system + systemId="docbook.dtd" + uri="db42xml/docbookx.dtd" /> + +  + <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"> + +  + <group xml:base="file:///usr/share/xml/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="docbook/schema/dtd/4.2/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="docbook/stylesheet/nwalsh/current/" /> + +  + <nextCatalog catalog="docbook/schema/dtd/4.2/catalog.xml" /> + +  +  +  + <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" /> +  + <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"> + +  + <group xml:base="file:///usr/share/sgml/docbook/" > + +  + <rewriteSystem + systemIdStartString="http://www.oasis-open.org/docbook/xml/4.2/" + rewritePrefix="dtd/xml/4.2/" /> +  + <rewriteURI + uriStartString="http://docbook.sourceforge.net/release/xsl/current/" + rewritePrefix="stylesheet/xsl/nwalsh/" /> + +  + <nextCatalog catalog="dtd/xml/4.2/catalog.xml" /> + +  +  +  + <system + systemId="docbook.dtd" + uri="dtd/xml/4.2/xml/docbookx.dtd" /> + +  + <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#[&#7K3RGSN7!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"> + + +<!ENTITY % local.chapter.class "| xi:include"> + +<!ENTITY % local.divcomponent.mix "| xi:include"> + +<!ENTITY % local.para.char.mix "| xi:include"> + +<!ENTITY % local.info.class "| xi:include"> + + +<!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

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

Jump to page: