3rdparties/software/cl+ssl-20200427-git/src/ffi-buffer-clisp.lisp (3166 bytes)
1 ;;;; -*- Mode: LISP; Syntax: COMMON-LISP; indent-tabs-mode: nil; coding: utf-8; show-trailing-whitespace: t -*- 2 3 ;;;; CLISP speedup comments by Pixel / pinterface, 2007, 4 ;;;; copied from https://code.kepibu.org/cl+ssl/ 5 ;;;; 6 ;;;; ## Speeding Up clisp 7 ;;;; cl+ssl has some serious speed issues on CLISP. For small requests, 8 ;;;; it's not enough to worry about, but on larger requests the speed 9 ;;;; issue can mean the difference between a 15 second download and a 15 10 ;;;; minute download. And that just won't do! 11 ;;;; 12 ;;;; ### What Makes cl+ssl on clisp so slow? 13 ;;;; On clisp, cffi's with-pointer-to-vector-data macro uses copy-in, 14 ;;;; copy-out semantics, because clisp doesn't offer a with-pinned-object 15 ;;;; facility or some other way of getting at the pointer to a simple-array. 16 ;;;; Very sad, I know. In addition to being a leaky abstraction, wptvd is really slow. 17 ;;;; 18 ;;;; ### How to Speed Things Up? 19 ;;;; The simplest thing that can possibly work: break the abstraction. 20 ;;;; I introduce several new functions (buffer-length, buffer-elt, etc.) 21 ;;;; and use those wherever an ssl-stream-*-buffer happens to be used, 22 ;;;; in place of the corresponding sequence functions. 23 ;;;; Those buffer-* functions operate on clisp's ffi:pointer objects, 24 ;;;; resulting in a tremendous speedup--and probably a memory leak or two. 25 ;;;; 26 ;;;; ### This Is Not For You If... 27 ;;;; While I've made an effort to ensure this patch doesn't break other 28 ;;;; implementations, if you have code which relies on ssl-stream-*-buffer 29 ;;;; returning an array you can use standard CL functions on, it will break 30 ;;;; on clisp under this patch. But you weren't relying on cl+ssl 31 ;;;; internals anyway, now were you? 32 33 #+xcvb (module (:depends-on ("package" "reload" "conditions" "ffi" "ffi-buffer-all"))) 34 35 (in-package :cl+ssl) 36 37 (defun make-buffer (size) 38 (cffi-sys:%foreign-alloc size)) 39 40 (defun buffer-length (buf) 41 (declare (ignore buf)) 42 +initial-buffer-size+) 43 44 (defun buffer-elt (buf index) 45 (ffi:memory-as buf 'ffi:uint8 index)) 46 (defun set-buffer-elt (buf index val) 47 (setf (ffi:memory-as buf 'ffi:uint8 index) val)) 48 (defsetf buffer-elt set-buffer-elt) 49 50 (declaim 51 (inline calc-buf-end)) 52 53 ;; to calculate non NIL value of the buffer end index 54 (defun calc-buf-end (buf-start seq seq-start seq-end) 55 (+ buf-start 56 (- (or seq-end (length seq)) 57 seq-start))) 58 59 (defun s/b-replace (seq buf &key (start1 0) end1 (start2 0) end2) 60 (when (null end2) 61 (setf end2 (calc-buf-end start2 seq start1 end1))) 62 (replace 63 seq 64 (ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end2 start2))) start2) 65 :start1 start1 66 :end1 end1)) 67 68 (defun as-vector (seq) 69 (if (typep seq 'vector) 70 seq 71 (make-array (length seq) :initial-contents seq :element-type '(unsigned-byte 8)))) 72 73 (defun b/s-replace (buf seq &key (start1 0) end1 (start2 0) end2) 74 (when (null end1) 75 (setf end1 (calc-buf-end start1 seq start2 end2))) 76 (setf 77 (ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end1 start1))) start1) 78 (as-vector (subseq seq start2 end2))) 79 seq) 80 81 (defmacro with-pointer-to-vector-data ((ptr buf) &body body) 82 `(let ((,ptr ,buf)) 83 ,@body))