| d468a84b |
(in-package :fwoar.cl-git)
|
| 489818ad |
(defclass delta (git-object)
|
| d468a84b |
((%repository :initarg :repository :reader repository)
(%base :initarg :base :reader base)
|
| 2733d76a |
(%commands :initarg :commands :reader commands)
(%src-size :initarg :src-size :reader src-size)
|
| 9d5bb297 |
(%delta-size :initarg :delta-size :reader delta-size))
(:documentation
"The base type for deltified git objects"))
|
| d468a84b |
(defclass+ ofs-delta (delta)
())
(defclass+ ref-delta (delta)
|
| 9d5bb297 |
()
(:documentation "TODO: mostly unimplemented/untested"))
|
| d468a84b |
|
| 2733d76a |
(defun make-ofs-delta (base commands repository src-size delta-size)
(fw.lu:new 'ofs-delta base commands repository src-size delta-size))
|
| d468a84b |
(defun make-ref-delta (base commands repository)
(fw.lu:new 'ofs-delta base commands repository))
|
| f5b39481 |
(defun int->bit-vector (n)
(let* ((integer-length (integer-length n))
(bv-size (* 8 (ceiling integer-length 8)))
(bv (make-array bv-size :element-type 'bit)))
(loop :for ix :below integer-length
:do (setf (aref bv (- bv-size 1 ix))
(if (logbitp ix n)
1
0)))
bv))
(defun bit-vector->int (bv)
(let ((bv-size (array-total-size bv)))
(loop :for ix :from (1- bv-size) :downto 0
:for n :from 0
:unless (zerop (aref bv ix))
:sum (expt 2 n))))
|
| 55e71580 |
(defun obj-to-type (obj)
(etypecase obj
(git-commit :commit)
(git-tree :tree)
(blob :blob)))
|
| 9d5bb297 |
(defun trace-bases (pack delta)
|
| 6df34ee9 |
(assert (typep delta 'delta))
(let* ((offset (second (base delta)))
(o (extract-object-at-pos pack
offset
(make-instance 'git-ref
:hash "00000000"
:repo nil)))
(obj (serapeum:assocdr :object-data o))
(raw (serapeum:assocdr :raw-data o)))
(if (typep obj 'delta)
|
| 55e71580 |
(multiple-value-bind (next base-type) (trace-bases pack obj)
(values (apply-commands next
(commands delta))
base-type))
|
| 6df34ee9 |
(let ((base (apply-commands raw
(commands delta))))
(length base)
|
| 55e71580 |
(values base
(obj-to-type obj))))))
(defun resolve-delta (ref maybe-delta)
(typecase maybe-delta
(delta (multiple-value-bind (raw-data type) (trace-bases (packed-ref-pack ref)
maybe-delta)
(-extract-object-of-type type
raw-data
(ref-repo ref)
:hash (ref-hash ref))))
(t maybe-delta)))
|
| 6df34ee9 |
(defun get-bases (pack delta)
|
| 9d5bb297 |
(if (typep delta 'delta)
(let* ((offset (second (base delta)))
(o (extract-object-at-pos pack
offset
(make-instance 'git-ref
:hash "00000000"
:repo nil)))
|
| 6df34ee9 |
(obj (serapeum:assocdr :object-data o)))
(cons delta (get-bases pack obj)))
(list delta)))
|
| b27750d1 |
|
| d468a84b |
(defun partition-commands (data)
(let ((idx 0))
(labels ((advance ()
|
| b27750d1 |
(if (>= idx (length data))
(progn (incf idx)
0)
(prog1 (elt data idx)
(incf idx))))
|
| d468a84b |
(get-command ()
|
| f5b39481 |
(let* ((bv (int->bit-vector (elt data idx)))
|
| d468a84b |
(discriminator (elt bv 0))
(insts (subseq bv 1)))
(incf idx)
(if (= 1 discriminator)
|
| b27750d1 |
(expand-copy
(list :copy
insts
(coerce (loop repeat (count 1 insts) collect (advance))
'(vector (unsigned-byte 8)))))
|
| d468a84b |
(list :add
|
| b27750d1 |
(coerce (loop repeat (bit-vector->int insts)
|
| d468a84b |
collect (advance))
|
| 9d5bb297 |
'(vector (unsigned-byte 8)))))))
(expand-copy (copy)
(destructuring-bind (command layout numbers) copy
(let* ((next-idx 0)
(parts (map '(vector (unsigned-byte 8))
(lambda (layout-bit)
(if (= layout-bit 1)
(prog1 (elt numbers next-idx)
(incf next-idx))
0))
(reverse layout))))
(list command
(fwoar.bin-parser:le->int (subseq parts 0 4))
(fwoar.bin-parser:le->int (subseq parts 4)))))))
|
| d468a84b |
(loop while (< idx (length data))
collect (get-command)))))
|
| 9d5bb297 |
(defun apply-commands (base commands)
(flexi-streams:with-output-to-sequence (s)
(flet ((do-copy (offset cnt)
|
| 6df34ee9 |
#+(or)
(format t "DOING :COPY ~d ~d~%" offset cnt)
|
| 9d5bb297 |
(write-sequence (subseq base offset (+ offset cnt))
s))
(do-add (data)
|
| 6df34ee9 |
#+(or)
(format t "DOING :ADD ~d~%" (length data))
|
| 9d5bb297 |
(write-sequence data s)))
(loop for (command . args) in commands
when (eql command :copy) do
(apply #'do-copy args)
when (eql command :add) do
(apply #'do-add args)))))
|
| b27750d1 |
|
| 6df34ee9 |
(defun get-ofs-delta-offset-streaming (buf)
(let* ((idx 0))
(flet ((advance ()
(read-byte buf)))
(loop
for c = (advance)
for ofs = (logand c 127) then (+ (ash (1+ ofs)
7)
(logand c 127))
while (> (logand c 128) 0)
finally
(return (values (- ofs) idx))))))
|
| b27750d1 |
(defun get-ofs-delta-offset (buf)
|
| a1d069b5 |
(let* ((idx 0))
|
| b27750d1 |
(flet ((advance ()
(prog1 (elt buf idx)
(incf idx))))
|
| a1d069b5 |
(loop
for c = (advance)
for ofs = (logand c 127) then (+ (ash (1+ ofs)
7)
(logand c 127))
while (> (logand c 128) 0)
finally
(return (values (- ofs) idx))))))
|
| 2733d76a |
(defun decode-size (buf)
(let ((parts ()))
(loop for raw across buf
for bits = (int->bit-vector raw)
for morep = (= (elt bits 0) 1)
do (push (subseq bits 1) parts)
while morep)
(let ((result (make-array (* 7 (length parts))
:element-type 'bit)))
(loop for x from 0 by 7
for part in parts
do
(replace result part :start1 x))
(values (bit-vector->int result)
(length parts)))))
|
| b27750d1 |
|
| 6df34ee9 |
(defmethod -extract-object-of-type ((type (eql :ofs-delta)) s repository &key offset-from packfile base)
(multiple-value-bind (src-size consumed-1) (decode-size s)
(multiple-value-bind (delta-size consumed-2) (decode-size (subseq s
consumed-1))
(make-ofs-delta (list packfile
(+ offset-from base))
(partition-commands (subseq s
(+ consumed-1
consumed-2)))
repository
src-size
delta-size))))
|
| d468a84b |
(defmethod -extract-object-of-type ((type (eql :ref-delta)) s repository &key offset-from)
(make-ref-delta offset-from
(partition-commands s)
repository))
|