fucking weird bug where it overwrites cffi functions?????

master
Avril 4 years ago
parent a4d142cf97
commit 7aa51baa06
Signed by: flanchan
GPG Key ID: 284488987C31F630

@ -1,6 +1,7 @@
;; cl-sipc
(in-package :cl-sipc)
(use-package :cl-sipc-mem)
(defparameter *on-error* #'(lambda (err) nil))
(defparameter *on-message* #'(lambda (msg)

@ -4,3 +4,6 @@
(:use #:cl
#:cffi)
(:nicknames :sipc))
(defpackage #:cl-sipc-mem
(:use #:cl))

@ -1,6 +1,6 @@
;; pointer
(in-package :cl-sipc)
(in-package :cl-sipc-mem)
(defstruct pointer
memory
@ -44,18 +44,18 @@
(type (or (caddr desc) :unsigned-char))
(pointer-from-type-infer (gensym)))
(let ((makeptr
(cond ((eql type0 :string) `(pointer-from-string ,from))
((eql type0 :sequence) `(pointer-from-seq ,from ,type))
((eql type0 :single) `(pointer-from ,from ,type))
(t `(,pointer-from-type-infer ,from ,type)))))
(cond ((eql type0 :string) `(pointer-from-string ,from))
((eql type0 :sequence) `(pointer-from-seq ,from ,type))
((eql type0 :single) `(pointer-from ,from ,type))
(t `(,pointer-from-type-infer ,from ,type)))))
`(flet ((,pointer-from-type-infer (fr ty)
(cond ((stringp fr) (pointer-from-string fr))
((or (vectorp fr)
(listp fr)) (pointer-from-seq fr ty))
(t (pointer-from fr ty)))))
(cond ((stringp fr) (pointer-from-string fr))
((or (vectorp fr)
(listp fr)) (pointer-from-seq fr ty))
(t (pointer-from fr ty)))))
(let* ((,name ,makeptr)
(result
(progn ,@body)))
(progn ,@body)))
(pointer-free ,name)
result)))))
@ -67,18 +67,19 @@
"pointer to Lisp vector"
(let ((vec (make-array (pointer-size ptr) :initial-element 0)))
(loop for x from 0 below (pointer-size ptr)
do (setf (aref vec x) (mem-aref (pointer-memory ptr) type x)))
do (setf (aref vec x) (mem-aref (pointer-memory ptr) type x)))
vec))
(mapc #'export '( make-pointer
pointer
pointer-memory
pointer-p
pointer-size
(mapc #'export '(
pointer
pointer-memory
pointer-p
pointer-size
pointer-from-string
pointer-from-seq
pointer-from
with-pointer
pointer-to-array
pointer-free))
pointer-from-string
pointer-from-seq
pointer-from
with-pointer
pointer-to-array
pointer-free))

Loading…
Cancel
Save