Remove parallel decoder.

4 files changed, 4 insertions, 183 deletions

diff --git a/NEWS b/NEWS
index df7b31d..e0cf18e 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,7 @@
 + Added a parallel encoder, accessible through ~p/eris-encode~ as well as
   ~p/{fetch,store}-data~.
 + ~lparallel~ added as a dependency rather than ~bordeaux-threads~.
++ Removed the parallel decoder, as it was broken from the start.
 * 0.2
 *Backwards incompatible*:
 + The eris-encode function now takes an OUTPUT-FUNCTION
diff --git a/eris.asd b/eris.asd
index 7950016..8d70f27 100644
--- a/eris.asd
+++ b/eris.asd
@@ -2,8 +2,7 @@
   :name "eris"
   :author "mail@ykonai.net"
   :license "LGPLv3 or later"
-  :depends-on ("ironclad" "alexandria" "serapeum" "trivial-gray-streams"
-                          "lparallel" #+unix "osicat" #+unix "mmap")
+  :depends-on ("ironclad" "alexandria" "serapeum" "trivial-gray-streams" "lparallel" )
   :components
   ((:module "src"
     :serial t
@@ -16,8 +15,7 @@
                  (:file "backend")
                  (:file "file-backend")
                  (:file "hash-backend")
-                 (:file "eris-parallel")
-                 #+nil (:file "parallel-decoder"))))
+                 (:file "eris-parallel"))))
   :in-order-to ((test-op (test-op :eris/test))))
 
 (defsystem "eris/test"
@@ -34,5 +32,4 @@
                              (:file "rfc")
                              (:file "autogenerated-tests")
                              (:file "backend-tests")
-                             (:file "encode-parallel")
-                             #+nil (:file "parallel-tests")))))
+                             (:file "encode-parallel")))))
diff --git a/src/parallel-decoder.lisp b/src/parallel-decoder.lisp
deleted file mode 100644
index 00636d7..0000000
--- a/src/parallel-decoder.lisp
+++ /dev/null
@@ -1,139 +0,0 @@
-;; This file is part of eris-cl.
-;; Copyright (C) 2022 Piotr Szarmański
-
-;; eris-cl is free software: you can redistribute it and/or modify it under the
-;; terms of the GNU Lesser General Public License as published by the Free
-;; Software Foundation, either version 3 of the License, or (at your option) any
-;; later version.
-
-;; eris-cl 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 General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License along with
-;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
-
-(in-package :eris)
-
-(defun split-list-equally (list parts)
-  (let* ((len (length list))
-         (mod (mod len parts))
-         (base (/ (- len mod) parts)))
-    (if (< len parts)
-        (map 'list #'list list)
-        (loop with pos = 0
-              for i from (1- parts) downto 0
-              collecting (subseq
-                          list
-                          pos
-                          (if (<= mod i)
-                              (setf pos (+ pos base))
-                              (setf pos (+ pos base 1))))))))
-
-(defun mem-write-vector (vector ptr &optional (offset 0) (count (length vector)))
-  (declare (type octet-vector vector)
-           (type fixnum offset count))
-  (declare (optimize ;; (speed 3) (safety 0) (space 0)
-                     (debug 3)))
-  (loop for i below count
-        for off from offset
-        do (setf (cffi:mem-ref ptr :unsigned-char off) (aref vector i))))
-
-(defclass reference-pair+ (reference-pair)
-  ((index :initarg :index :accessor index :type (integer 0 32768))))
-
-(defun map-over-key-references (function block)
-  (loop for i from 0 to (1- (/ (length block) 64))
-        for key-ref = (octets-to-reference-pair (nsubseq block (* 64 i)))
-        until (key-reference-null? key-ref)
-        do (funcall function key-ref i)))
-
-(defun decode-blocks (reference-pair-list level block-capacity fetch-function output-file cache-capacity last-block)
-  (lambda ()
-    (mmap:with-mmap (addr fd size output-file :open :write :protection :write :mmap :shared)
-      (let ((get-block (cached-lambda (:cache-class 'lru-cache 
-                                       :capacity cache-capacity
-                                       :table (make-hash-table :size (1+ cache-capacity) :test #'equalp))
-                           (reference key &optional nonce)
-                         (let* ((block (execute-fetch-function fetch-function reference)))
-                           (unless block (error 'missing-block :reference reference))
-                           (hash-check block reference)
-                           (decrypt-block block key nonce))))
-            (nonce-array (initialize-nonce-array level)))
-        (labels ((descend (level reference-pair block-id)
-                   (let ((block (funcall get-block (reference reference-pair) (key reference-pair) (aref nonce-array level))))
-                     (if (zerop level)
-                         (if (= last-block block-id)
-                             (mem-write-vector block addr (* 64 block-capacity block-id) (unpad-block block))
-                             (mem-write-vector block addr (* 64 block-capacity block-id)))
-                         ;; (bordeaux-threads:with-lock-held (lock)
-                         ;;   (file-position stream (* 64 block-capacity block-id))
-                         ;;   (write-sequence block stream))
-                         (map-over-key-references
-                          (lambda (key-ref i)
-                            (descend (1- level) key-ref (+ i (* block-capacity block-id))))
-                          block)))))
-          (mapc (lambda (key-ref)
-                  (descend level key-ref (index key-ref)))
-                reference-pair-list))))))
-
-(defun eris-decode-parallel (read-capability fetch-function output-file
-                             &key (cache-capacity 4096) (threads 4) (initial-bindings bordeaux-threads:*default-special-bindings*))
-  "Decode an ERIS READ-CAPABILITY in parallel using THREADS threads into a file
-designated by OUTPUT-FILE.
-
-Fetch-function must be a function with one argument, the reference octet, which
-returns a (simple-array (unsigned-byte 8)) containing the block. The block will
-be destructively modified, so you MUST provide a fresh array every time. In
-addition, the function MUST be thread-safe.
-
-CACHE-CAPACITY indicates the total amount of blocks stored for all threads. Each
-thread has its own cache.
-
-INITIAL-BINDINGS is passed to make-thread. This is only useful if you are
-locally binding a special variable to some value."
-  (declare (type read-capability read-capability)
-           (type function fetch-function)
-           (type integer cache-capacity))
-  (with-slots (level block-size root-reference-pair) read-capability
-    (let ((root (decrypt-block (execute-fetch-function fetch-function (reference root-reference-pair))
-                               (key root-reference-pair)
-                               (make-nonce level))))
-      (when (> level 0) (hash-check root (key root-reference-pair)))
-      (case level
-        (0 (with-open-file (file output-file :direction :output :element-type '(unsigned-byte 8))
-             (write-sequence root file :end (unpad-block root))))
-        (t (let* ((initial-list
-                    (loop for i from 0 to (/ block-size 64)
-                          for key-ref = (octets-to-reference-pair (nsubseq root (* 64 i)))
-                          until (key-reference-null? key-ref)
-                          collect key-ref))
-                  (list (split-list-equally
-                         (loop for i from 0 to (1- (length initial-list))
-                               collecting (change-class (elt initial-list i) 'reference-pair+ :index i))
-                         threads))
-                  ;; (lock (bordeaux-threads:make-lock "stream-lock"))
-                  (eof (find-eof root
-                                 (lambda (reference key nonce)
-                                   (let* ((block (execute-fetch-function fetch-function reference)))
-                                     (unless block (error 'missing-block :reference reference))
-                                     (hash-check block reference)
-                                     (decrypt-block block key nonce)))
-                                 block-size
-                                 level)))
-             (let ((fd (osicat-posix:creat output-file #o666)))
-               (osicat-posix:posix-fallocate fd 0 eof)
-               (osicat-posix:close fd))
-             (map 'nil #'bordeaux-threads:join-thread
-                  (map 'list (lambda (reference-pairs)
-                               (bordeaux-threads:make-thread
-                                (decode-blocks reference-pairs
-                                               (1- level)
-                                               (/ block-size 64)
-                                               fetch-function
-                                               output-file
-                                               (truncate (/ cache-capacity threads))
-                                               (truncate (/ eof block-size)))
-                                :initial-bindings initial-bindings))
-                       list))))))))
-
diff --git a/tests/parallel-tests.lisp b/tests/parallel-tests.lisp
deleted file mode 100644
index aa3c337..0000000
--- a/tests/parallel-tests.lisp
+++ /dev/null
@@ -1,38 +0,0 @@
-;; This file is part of eris-cl.
-;; Copyright (C) 2022 Piotr Szarmański
-
-;; eris-cl is free software: you can redistribute it and/or modify it under the
-;; terms of the GNU Lesser General Public License as published by the Free
-;; Software Foundation, either version 3 of the License, or (at your option) any
-;; later version.
-
-;; eris-cl 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 General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License along with
-;; eris-cl. If not, see <https://www.gnu.org/licenses/>.
-
-(in-package :eris/test)
-
-(def-suite* parallel-tests :in eris-tests)
-
-(defmacro assert-parallel-decode (array block-size)
-  `(uiop:with-temporary-file (:stream output-file :pathname pathname :direction :io)
-     (let* ((*table* (make-hash-table :test #'equalp))
-            (array ,array)
-            (read-capability (eris-encode array ,block-size #'hashtable-encode)))
-       (eris-decode-parallel read-capability #'hashtable-decode pathname
-                                  :initial-bindings (acons '*table* *table* bordeaux-threads:*default-special-bindings*)
-                                  :threads 4)
-       (is (equalp array
-                   (alexandria:read-stream-content-into-byte-vector output-file))))))
-
-(test simple-parallel-decode
-  (assert-parallel-decode (make-octets 4096 :element 101) 1024)
-  (assert-parallel-decode (make-octets 4095 :element 102) 1024)
-  (assert-parallel-decode (make-octets 18000 :element 103) 1024)
-  (assert-parallel-decode (make-octets 128000 :element 104) 32768)
-  (assert-parallel-decode (make-octets 131071 :element 104) 32768)
-  (assert-parallel-decode (make-octets 131072 :element 104) 32768)
-  (assert-parallel-decode (make-octets 131073 :element 104) 32768))