Skip to content

Commit

Permalink
Sync with garbage-pools.
Browse files Browse the repository at this point in the history
  • Loading branch information
@archimag
archimag committed Apr 17, 2013
1 parent ad899ec commit f31723f
Show file tree
Hide file tree
Showing 15 changed files with 71 additions and 71 deletions.
30 changes: 15 additions & 15 deletions html/html.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -27,9 +27,9 @@ Returns: a new document
"
(flet ((toforeign (str)
(if str
(gp:cleanup-register (foreign-string-alloc str) #'foreign-string-free)
(cleanup-register (foreign-string-alloc str) #'foreign-string-free)
(null-pointer))))
(gp:with-garbage-pool ()
(with-garbage-pool ()
(make-instance 'document
:pointer (%htmlNewDocNoDtD (toforeign uri)
(toforeign external-id))))))
Expand Down Expand Up @@ -105,12 +105,12 @@ NOTE: this will not change the document content encoding, just the META flag ass
(options :int))

(defmethod parse-html ((path pathname) &key encoding)
(gp:with-garbage-pool ()
(let ((%path (gp:cleanup-register (cffi:foreign-string-alloc (format nil "~A" path))
#'cffi:foreign-string-free))
(with-garbage-pool ()
(let ((%path (cleanup-register (cffi:foreign-string-alloc (format nil "~A" path))
#'cffi:foreign-string-free))
(%encoding (if encoding
(gp:cleanup-register (cffi:foreign-string-alloc encoding)
#'cffi:foreign-string-free)
(cleanup-register (cffi:foreign-string-alloc encoding)
#'cffi:foreign-string-free)
(cffi:null-pointer))))
(%htmlReadFile %path
%encoding
Expand All @@ -119,12 +119,12 @@ NOTE: this will not change the document content encoding, just the META flag ass
;;; parse-html ((uri puri:uri))

(defmethod parse-html ((uri puri:uri) &key encoding)
(gp:with-garbage-pool ()
(let ((%path (gp:cleanup-register (cffi:foreign-string-alloc (format nil "~A" uri))
#'cffi:foreign-string-free))
(with-garbage-pool ()
(let ((%path (cleanup-register (cffi:foreign-string-alloc (format nil "~A" uri))
#'cffi:foreign-string-free))
(%encoding (if encoding
(gp:cleanup-register (cffi:foreign-string-alloc encoding)
#'cffi:foreign-string-free)
(cleanup-register (cffi:foreign-string-alloc encoding)
#'cffi:foreign-string-free)
(cffi:null-pointer))))
(%htmlReadFile %path
%encoding
Expand Down Expand Up @@ -264,8 +264,8 @@ NOTE: this will not change the document content encoding, just the META flag ass
(otherwise
(with-foreign-string (%encoding "utf-8")
(let ((xtree::*stream-for-xml-serialize* stream))
(gp:with-garbage-pool ()
(let ((%buffer (gp:cleanup-register (xtree::%xmlOutputBufferCreateIO (xtree::%stream-writer-callback stream)
(with-garbage-pool ()
(let ((%buffer (cleanup-register (xtree::%xmlOutputBufferCreateIO (xtree::%stream-writer-callback stream)
(null-pointer)
(null-pointer)
(xtree::%xmlFindCharEncodingHandler %encoding))
Expand All @@ -277,4 +277,4 @@ NOTE: this will not change the document content encoding, just the META flag ass

(defmethod serialize-html ((node node) (target (eql :to-string)) &key)
(with-output-to-string (out)
(serialize-html node out)))
(serialize-html node out)))
4 changes: 2 additions & 2 deletions html/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,12 +6,12 @@
;;; Author: Moskvitin Andrey <archimag@gmail.com>

(defpackage #:libxml2.html
(:use #:cl #:cffi #:libxml2.private #:libxml2.tree #:iter)
(:use #:cl #:cffi #:libxml2.private #:libxml2.tree #:iter #:garbage-pools)
(:nicknames #:html)
(:export #:html-p
#:parse-html
#:with-parse-html
#:parse-html-fragment
#:with-parse-html-fragment
#:meta-encoding
#:serialize-html))
#:serialize-html))
8 changes: 4 additions & 4 deletions tree/namespace.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,11 +38,11 @@
(prefix %xmlCharPtr))

(defun search-ns-by-prefix (element prefix)
(gp:with-garbage-pool ()
(with-garbage-pool ()
(let ((%ns (%xmlSearchNs (pointer (document element))
(pointer element)
(if prefix
(gp:cleanup-register (foreign-string-alloc prefix) #'foreign-string-free)
(cleanup-register (foreign-string-alloc prefix) #'foreign-string-free)
(null-pointer)))))
(unless (null-pointer-p %ns)
(make-instance 'ns :pointer %ns)))))
Expand All @@ -54,11 +54,11 @@
(href %xmlCharPtr))

(defun search-ns-by-href (element href)
(gp:with-garbage-pool ()
(with-garbage-pool ()
(let ((%ns (%xmlSearchNsByHref (pointer (document element))
(pointer element)
(if href
(gp:cleanup-register (foreign-string-alloc href) #'foreign-string-free)
(cleanup-register (foreign-string-alloc href) #'foreign-string-free)
(null-pointer)))))
(unless (null-pointer-p %ns)
(make-instance 'ns :pointer %ns)))))
Expand Down
6 changes: 3 additions & 3 deletions tree/node.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -97,11 +97,11 @@
(setf (foreign-slot-value %node
'%xmlNode
'%ns)
(gp:with-garbage-pool ()
(with-garbage-pool ()
(%xmlNewNs %node
(gp:cleanup-register (foreign-string-alloc href) #'foreign-string-free)
(cleanup-register (foreign-string-alloc href) #'foreign-string-free)
(if prefix
(gp:cleanup-register (foreign-string-alloc prefix) #'foreign-string-free)
(cleanup-register (foreign-string-alloc prefix) #'foreign-string-free)
(null-pointer))))))
(make-instance 'node
:pointer %node)))
Expand Down
2 changes: 1 addition & 1 deletion tree/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,7 @@
#:define-libxml2-function))

(defpackage #:libxml2.tree
(:use #:cl #:iter #:cffi #:libxml2.private #:metabang.bind)
(:use #:cl #:iter #:cffi #:libxml2.private #:metabang.bind #:garbage-pools)
(:nicknames #:xtree)
(:export #:node
#:document
Expand Down
6 changes: 3 additions & 3 deletions tree/resolve.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@
(defmacro with-custom-resolvers ((&rest resolvers) &body body)
`(let ((*resolvers* (list ,@resolvers))
(*stream-for-xml-parse*))
(gp:with-garbage-pool () ,@body)))
(with-garbage-pool () ,@body)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; resolve-file/url
Expand All @@ -71,7 +71,7 @@

(defun resolve-string (str %ctxt)
(%xmlNewStringInputStream %ctxt
(gp:cleanup-register (foreign-string-alloc str) #'foreign-string-free)))
(cleanup-register (foreign-string-alloc str) #'foreign-string-free)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; resolve-stream
Expand Down Expand Up @@ -124,4 +124,4 @@
(null-pointer)
:xml-char-encoding-none)
:xml-char-encoding-none))


10 changes: 5 additions & 5 deletions tree/serialize.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -175,11 +175,11 @@
(defmethod serialize ((el node) (stream stream) &key (encoding :utf-8) (pretty-print nil))
(with-foreign-string (%encoding (format nil "~A" encoding))
(let ((*stream-for-xml-serialize* stream))
(gp:with-garbage-pool ()
(let ((%buffer (gp:cleanup-register (%xmlOutputBufferCreateIO (%stream-writer-callback stream)
(null-pointer)
(null-pointer)
(%xmlFindCharEncodingHandler %encoding))
(with-garbage-pool ()
(let ((%buffer (gcleanup-register (%xmlOutputBufferCreateIO (%stream-writer-callback stream)
(null-pointer)
(null-pointer)
(%xmlFindCharEncodingHandler %encoding))
#'%xmlOutputBufferClose)))
(%xmlNodeDumpOutput %buffer
(pointer (document el))
Expand Down
2 changes: 1 addition & 1 deletion tree/xtree.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -109,7 +109,7 @@
(if obj (release/impl obj)))
(setf (slot-value obj 'pointer) nil))

(gp:defcleanup libxml2-cffi-object-wrapper #'release)
(defcleanup libxml2-cffi-object-wrapper #'release)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Expand Down
4 changes: 2 additions & 2 deletions xpath/expression.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -139,5 +139,5 @@
(node %xmlNodePtr))

(defun getpath (node)
(gp:with-garbage-pool ()
(cffi:foreign-string-to-lisp (gp:cleanup-register (%xmlGetNodePath (pointer node)) 'libxml2.tree::%xmlFree))))
(with-garbage-pool ()
(cffi:foreign-string-to-lisp (cleanup-register (%xmlGetNodePath (pointer node)) 'libxml2.tree::%xmlFree))))
14 changes: 7 additions & 7 deletions xpath/extensions.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -72,7 +72,7 @@
(ctxt %xmlXPathContextPtr))

(defun value-pop (&optional (ctxt *parser-context*))
(xpath-object-value (gp:object-register (make-instance 'xpath-object
(xpath-object-value (object-register (make-instance 'xpath-object
:pointer (%valuePop ctxt)))))

;;; define-xpath-function
Expand All @@ -84,12 +84,12 @@
(ignore-nargs (unless args '(declare (ignore %nargs)))))
`(defcallback ,name :void ((%ctxt %xmlXPathParserContextPtr) (%nargs :int))
,ignore-nargs
(gp:with-garbage-pool ()
(bind ,bindings
(value-push (let ((*parser-context* (make-instance 'xpath-parser-context
:pointer %ctxt)))
,@body)
%ctxt))))))
(with-garbage-pool ()
(bind ,bindings
(value-push (let ((*parser-context* (make-instance 'xpath-parser-context
:pointer %ctxt)))
,@body)
%ctxt))))))



4 changes: 2 additions & 2 deletions xpath/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
;;; Author: Moskvitin Andrey <archimag@gmail.com>

(defpackage #:libxml2.xpath
(:use #:cl #:cffi #:iter #:libxml2.private #:libxml2.tree #+sbcl #:sb-ext #:metabang.bind)
(:use #:cl #:cffi #:iter #:libxml2.private #:libxml2.tree #+sbcl #:sb-ext #:metabang.bind #:garbage-pools)
(:nicknames #:xpath)
(:export #:compiled-expression
#:compile-expression
Expand Down Expand Up @@ -36,4 +36,4 @@
#:with-xpath-functions
#:define-xpath-function

#:*lisp-xpath-functions*))
#:*lisp-xpath-functions*))
18 changes: 9 additions & 9 deletions xpath/xpath-context.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -124,21 +124,21 @@
(defvar *private-xpath-context*)

(defmacro with-%context ((var doc node ns-map) &rest body)
`(gp:with-garbage-pool (xpath-context-pool)
`(with-garbage-pool (xpath-context-pool)
(let ((,var (if (boundp '*private-xpath-context*) *private-xpath-context*
(gp:cleanup-register (%xmlXPathNewContext (pointer ,doc))
#'%xmlXPathFreeContext
xpath-context-pool))))
(cleanup-register (%xmlXPathNewContext (pointer ,doc))
#'%xmlXPathFreeContext
xpath-context-pool))))
#+sbcl(declare (sb-ext:muffle-conditions sb-ext:code-deletion-note))
(if (boundp 'libxml2.xpath::*lisp-xpath-functions*)
(gp:with-garbage-pool ()
(with-garbage-pool ()
(iter (for (func name ns) in *lisp-xpath-functions*)
(%xmlXPathRegisterFuncNS ,var
(gp:cleanup-register (foreign-string-alloc (eval name))
#'foreign-string-free)
(cleanup-register (foreign-string-alloc (eval name))
#'foreign-string-free)
(if ns
(gp:cleanup-register (foreign-string-alloc (eval ns))
#'foreign-string-free)
(cleanup-register (foreign-string-alloc (eval ns))
#'foreign-string-free)
(null-pointer))
(get-callback func)))))
(if ,node
Expand Down
18 changes: 9 additions & 9 deletions xslt/extensions.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -157,13 +157,13 @@


(defun register-xpath-extensions (ctxt function-traits)
(gp:with-garbage-pool ()
(with-garbage-pool ()
(iter (for (func name ns) in function-traits)
(%xsltRegisterExtFunction ctxt
(gp:cleanup-register (foreign-string-alloc (eval name))
(cleanup-register (foreign-string-alloc (eval name))
#'foreign-string-free)
(if ns
(gp:cleanup-register (foreign-string-alloc (eval ns))
(cleanup-register (foreign-string-alloc (eval ns))
#'foreign-string-free)
(null-pointer))
(get-callback func)))))
Expand All @@ -189,14 +189,14 @@
,@body)))

(defun register-xslt-elements (ctxt element-traits)
(gp:with-garbage-pool ()
(with-garbage-pool ()
(iter (for (func name ns) in element-traits)
(%xsltRegisterExtElement ctxt
(gp:cleanup-register (foreign-string-alloc (eval name))
#'foreign-string-free)
(cleanup-register (foreign-string-alloc (eval name))
#'foreign-string-free)
(if ns
(gp:cleanup-register (foreign-string-alloc (eval ns))
#'foreign-string-free)
(cleanup-register (foreign-string-alloc (eval ns))
#'foreign-string-free)
(null-pointer))
(get-callback func)))))

Expand Down Expand Up @@ -232,4 +232,4 @@
(if (boundp '*lisp-xslt-elements*)
(register-xslt-elements ,var *lisp-xslt-elements*))
,@body)
(%xsltFreeTransformContext ,var))))
(%xsltFreeTransformContext ,var))))
2 changes: 1 addition & 1 deletion xslt/packages.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@
;;; Author: Moskvitin Andrey <archimag@gmail.com>

(defpackage #:libxml2.xslt
(:use #:cl #:cffi #:libxml2.private #:libxml2.tree #:iter)
(:use #:cl #:cffi #:libxml2.private #:libxml2.tree #:iter #:garbage-pools)
(:nicknames #:xslt)
(:export #:stylesheet
#:parse-stylesheet
Expand Down
14 changes: 7 additions & 7 deletions xslt/stylesheet.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -81,11 +81,11 @@
;;; parse-stylesheet (obj)

(defmethod parse-stylesheet/impl (obj)
(gp:with-garbage-pool ()
(let* ((doc (gp:object-register (parse obj)))
(with-garbage-pool ()
(let* ((doc (object-register (parse obj)))
(%style (parse-stylesheet/impl (parse obj))))
(unless (null-pointer-p %style)
(progn (gp:cancel-object-cleanup doc)
(progn (cancel-object-cleanup doc)
%style)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Expand Down Expand Up @@ -114,16 +114,16 @@
(defun prepare-xsl-params (params)
(if params
(let* ((array-length (1+ (* 2 (hash-table-count params))))
(%array (gp:cleanup-register (foreign-alloc :pointer
(%array (cleanup-register (foreign-alloc :pointer
:count array-length
:initial-element (null-pointer))
#'foreign-free)))
(iter (for (name value) in-hashtable params)
(for i upfrom 0 by 2)
(setf (mem-aref %array :pointer i)
(gp:cleanup-register (foreign-string-alloc name) #'foreign-string-free))
(cleanup-register (foreign-string-alloc name) #'foreign-string-free))
(setf (mem-aref %array :pointer (1+ i))
(gp:cleanup-register (foreign-string-alloc value) #'foreign-string-free)))
(cleanup-register (foreign-string-alloc value) #'foreign-string-free)))
%array)
(null-pointer)))

Expand All @@ -141,7 +141,7 @@
;;; transform (style (doc document))

(defmethod transform (style (doc document))
(gp:with-garbage-pool ()
(with-garbage-pool ()
(with-transform-context (%ctxt (style doc))
(libxml2.tree::make-libxml2-cffi-object-wrapper/impl (%xsltApplyStylesheetUser (pointer style)
(pointer doc)
Expand Down

0 comments on commit f31723f

Please sign in to comment.