git.fiddlerwoaroof.com
Browse code

feat(delta): first cut of delta extraction

Edward authored on 19/05/2021 08:32:46
Showing 2 changed files
delta.lisp
History View file @ b27750d
... ... 
@@ -48,33 +48,63 @@
48 48 
           :unless (zerop (aref bv ix))
49 49 
             :sum (expt 2 n))))
50 50
51 
+(defun expand-copy (copy)
52 
+  ;; TODO: implement this
53 
+  copy)
54 
+
51 55 
 (defun partition-commands (data)
52 56 
   (let ((idx 0))
53 57 
     (labels ((advance ()
54 
-               (prog1 (elt data idx)
55 
-                 (incf idx)))
58 
+               (if (>= idx (length data))
59 
+                   (progn (incf idx)
60 
+                          0)
61 
+                   (prog1 (elt data idx)
62 
+                     (incf idx))))
56 63 
              (get-command ()
57 64 
                (let* ((bv (int->bit-vector (elt data idx)))
58 65 
                       (discriminator (elt bv 0))
59 66 
                       (insts (subseq bv 1)))
60 67 
                  (incf idx)
61 68 
                  (if (= 1 discriminator)
62 
-                     (list :copy
63 
-                           insts
64 
-                           (coerce (loop repeat (count 1 insts) collect (advance))
65 
-                                   '(vector (unsigned-byte 8))))
69 
+                     (expand-copy
70 
+                      (list :copy
71 
+                            insts
72 
+                            (coerce (loop repeat (count 1 insts) collect (advance))
73 
+                                    '(vector (unsigned-byte 8)))))
66 74 
                      (list :add
67 
-                           (coerce (loop repeat (1- (bit-vector->int (reverse insts)))
75 
+                           (coerce (loop repeat (bit-vector->int insts)
68 76 
                                          collect (advance))
69 77 
                                    '(vector (unsigned-byte 8))))))))
70 78 
       (loop while (< idx (length data))
71 79 
             collect (get-command)))))
72 80
73 
-(defmethod -extract-object-of-type ((type (eql :ofs-delta)) s repository &key offset-from)
74 
-  (format t "~&data: ~s~%" s)
75 
-  (make-ofs-delta offset-from
76 
-                  (partition-commands s)
77 
-                  repository))
81 
+
82 
+(defun get-ofs-delta-offset (buf)
83 
+  (let ((idx 0))
84 
+    (flet ((advance ()
85 
+             (prog1 (elt buf idx)
86 
+               (incf idx))))
87 
+      (let* ((c (advance))
88 
+             (ofs (logand c 127)))
89 
+        (loop
90 
+          do (format t "~&~s ~s ~s" idx c ofs)
91 
+          while (> (logand c 128) 0)
92 
+          do
93 
+             (setf c (advance))
94 
+             (setf ofs (+ (ash (1+ ofs)
95 
+                               7)
96 
+                          (logand c 127))))
97 
+        (values (- ofs) idx)))))
98 
+
99 
+(defmethod -extract-object-of-type ((type (eql :ofs-delta)) s repository &key offset-from packfile)
100 
+  (multiple-value-bind (offset consumed) (get-ofs-delta-offset s)
101 
+    (make-ofs-delta (list packfile
102 
+                          (+ offset-from offset))
103 
+                    (partition-commands (chipz:decompress
104 
+                                         nil
105 
+                                         (chipz:make-dstate 'chipz:zlib)
106 
+                                         (subseq s consumed)))
107 
+                    repository)))
78 108 
 (defmethod -extract-object-of-type ((type (eql :ref-delta)) s repository &key offset-from)
79 109 
   (make-ref-delta offset-from
80 110 
                   (partition-commands s)
extract.lisp
History View file @ b27750d
... ... 
@@ -52,18 +52,19 @@
52 52 
                              (read-sequence buffer s)
53 53 
                              buffer)
54 54 
                            (chipz:decompress nil (chipz:make-dstate 'chipz:zlib) s)))
55 
-         (object-data (extract-object-of-type type decompressed repository pos)))
55 
+         (object-data (extract-object-of-type type decompressed repository pos (pathname s))))
56 56 
     (list (cons :type (object-type->sym type))
57 57 
           (cons :decompressed-size size)
58 58 
           (cons :object-data object-data)
59 59 
           (cons :raw-data decompressed))))
60 60
61 
-(defun extract-object-of-type (type s repository pos)
61 
+(defun extract-object-of-type (type s repository pos packfile)
62 62 
   (with-simple-restart (continue "Skip object of type ~s" type)
63 63 
     (-extract-object-of-type (object-type->sym type)
64 64 
                              s
65 65 
                              repository
66 
-                             :offset-from pos)))
66 
+                             :offset-from pos
67 
+                             :packfile packfile)))
67 68
68 69 
 (defun extract-object-from-pack (pack obj-number)
69 70 
   (with-open-file (s (index-file pack) :element-type '(unsigned-byte 8))
... ... 
@@ -85,7 +86,8 @@
85 86 
                                 (elt (partition 0 rest)
86 87 
                                      1)
87 88 
                                 repo
88 
-                                0)))))
89 
+                                0
90 
+                                nil)))))
89 91
90 92 
 (defgeneric extract-object (object)
91 93 
   (:method ((object loose-ref))