1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
#|
This file is a part of zippy
(c) 2020 Shirakumo http://tymoon.eu (shinmera@tymoon.eu)
Author: Nicolas Hafner <shinmera@tymoon.eu>
|#
(in-package #:org.shirakumo.zippy)
(defvar *version*
'(4 5))
(defvar *compatibility*
#+windows :ntfs
#+darwin :darwin
#+(and unix (not darwin)) :unix)
(defun default-attributes-for (system)
(case system
((:darwin :unix) #o644)
(T 0)))
(defun ensure-buffer (buffer)
(etypecase buffer
(vector buffer)
(integer (make-array buffer :element-type '(unsigned-byte 8)))
(null (make-array 4096 :element-type '(unsigned-byte 8)))))
(defun ensure-password (password)
(etypecase password
(string (babel:string-to-octets password :encoding :utf-8))
((vector (unsigned-byte 8)) password)
(null (restart-case (error "Password is required")
(use-value (password)
(ensure-password password))))))
(defun alist-vector (alist)
(let* ((max (loop for cons in alist maximize (car cons)))
(vec (make-array (1+ max) :initial-element :unknown)))
(loop for (i . e) in alist
do (setf (svref vec i) e))
vec))
(defun alist-table (alist)
(let ((table (make-hash-table)))
(loop for (i . e) in alist
do (setf (gethash i table) e))
table))
(defun cap (value bits)
(let ((max (1- (ash 1 bits))))
(if (< max value)
max
value)))
(defun bitfield (&rest bits)
(let ((int 0))
(loop for i from 0
for bit in bits
do (when bit (setf (ldb (byte 1 i) int) 1)))
int))
(defun enbitfield (list &rest bits)
(let ((int 0))
(loop for i from 0
for bit in bits
do (when (find bit list) (setf (ldb (byte 1 i) int) 1)))
int))
(defun debitfield (int &rest bits)
(loop for i from 0
for bit in bits
when (logbitp i int)
collect bit))
(defun enlist (thing &rest values)
(if (listp thing) thing (list* thing values)))
|
