Browse Source

First commit.

main
Michael Fiano 2 months ago
commit
d47bc94e1b
Signed by: mfiano
GPG Key ID: F87DF4666D70FC63
  1. 21
      LICENSE
  2. 37
      README.md
  3. 14
      identifier-pool.asd
  4. 97
      src/identifier-pool.lisp
  5. 19
      src/package.lisp

21
LICENSE

@ -0,0 +1,21 @@
MIT License
Copyright (c) Michael Fiano
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.

37
README.md

@ -0,0 +1,37 @@
# identifier-pool
A simple generational identification number allocator.
## Overview
This library is able to generate increasing identifiers (integers) in such a way that previously
deallocated identifiers are available to be reclaimed by the generator the next time one is
allocated. Essentially, it solves the "ABA Problem": https://en.wikipedia.org/wiki/ABA_problem
It does so in a space-efficient manner, without the need for the storage of a list of deallocated
identifiers. It does this by keeping deallocated identifiers around and modifying their data on
deletion to build a sort of implicit linked list. That is, when an identifier is marked for
deletion, the following occurs:
* The packed version portion of its data is incremented.
* The packed ID portion of its data is set to the integer stored in the pool's FREE-HEAD slot
(FREE-HEAD can be thought of as the head of the implicit linked list). If FREE-HEAD is null, then
instead, all of the bits of the ID are set. #xFFFFFF represents the "invalid" ID.
* FREE-HEAD is set to the ID portion of its data.
This, in effect, constructs an implicit linked list of the next available identifiers that can be
generated.
## Install
```lisp
(ql:quickload :identifier-pool)
```
## License
Copyright © 2019-2022 Michael Fiano <mail@mfiano.net>
Licensed under the MIT License.

14
identifier-pool.asd

@ -0,0 +1,14 @@
(asdf:defsystem #:identifier-pool
:description "A simple generational identification number allocator."
:author "Michael Fiano <mail@mfiano.net>"
:license "MIT"
:homepage "https://github.com/mfiano/identifier-pool"
:version "0.1.0"
:encoding :utf-8
:depends-on (#:dynamic-array
#:mfiano-utils)
:pathname "src"
:serial t
:components
((:file "package")
(:file "identifier-pool")))

97
src/identifier-pool.lisp

@ -0,0 +1,97 @@
(in-package #:identifier-pool)
(u:define-constant +id-bits+ 24 :test #'=)
(u:define-constant +id-mask+ (1- (expt 2 +id-bits+)) :test #'=)
(u:define-constant +version-bits+ 32 :test #'=)
(u:define-constant +version-mask+ (1- (expt 2 +version-bits+)) :test #'=)
(declaim (inline %make-pool))
(defstruct (pool
(:constructor %make-pool)
(:conc-name nil)
(:predicate nil)
(:copier nil))
(store (da:make-array) :type da:dynamic-array)
free-head
(count 0 :type u:ub24))
(u:fn-> unpack (fixnum) (values u:ub24 u:ub32))
(declaim (inline unpack))
(defun unpack (identifier)
(declare (optimize speed))
(values (ldb (byte +id-bits+ 0) identifier)
(ldb (byte +version-bits+ +id-bits+) identifier)))
(u:fn-> pack (u:ub24 u:ub32) fixnum)
(declaim (inline pack))
(defun pack (id version)
(declare (optimize speed))
(dpb version (byte +version-bits+ +id-bits+)
(dpb id (byte +id-bits+ 0) 0)))
(u:fn-> id (fixnum) u:ub24)
(declaim (inline id))
(defun id (identifier)
(declare (optimize speed))
(nth-value 0 (unpack identifier)))
(u:fn-> version (fixnum) u:ub32)
(declaim (inline version))
(defun version (identifier)
(declare (optimize speed))
(nth-value 1 (unpack identifier)))
(defun make-pool (&key (capacity 128))
(%make-pool :store (da:make-array :capacity capacity)))
(u:fn-> generate (pool) fixnum)
(defun generate (pool)
(declare (optimize speed))
(let ((store (store pool))
(free-head (free-head pool)))
(incf (count pool))
(if free-head
(u:mvlet ((id version (unpack (da:aref store free-head))))
(setf (free-head pool) (if (= id +id-mask+) nil id)
(da:aref store free-head) (pack free-head version)))
(let ((identifier (pack (da:length store) 0)))
(da:push store identifier)
identifier))))
(u:fn-> free (pool fixnum) boolean)
(defun free (pool identifier)
(declare (optimize speed))
(let ((store (store pool))
(index (unpack identifier)))
(when (< index (da:length store))
(u:mvlet ((id version (unpack (da:aref store index))))
(when (= index id)
(setf (da:aref store id) (pack (or (free-head pool) +id-mask+)
(logand (1+ version) +version-mask+))
(free-head pool) id)
(decf (count pool))
t)))))
(u:fn-> active-p (pool fixnum) boolean)
(defun active-p (pool identifier)
(declare (optimize speed))
(let ((store (store pool))
(index (logand identifier +id-mask+)))
(and (< index (da:length store))
(= (unpack (da:aref store index)) identifier))))
(u:fn-> map (pool function) null)
(defun map (pool func)
(declare (optimize speed))
(let* ((store (store pool))
(length (da:length store)))
(if (free-head pool)
(loop :for i :below length
:for identifier = (da:aref store i)
:when (= (logand identifier +id-mask+) i)
:do (funcall func identifier))
(dotimes (i length)
(funcall func (da:aref store i))))))

19
src/package.lisp

@ -0,0 +1,19 @@
(in-package #:cl-user)
(defpackage #:identifier-pool
(:local-nicknames
(#:da #:dynamic-array)
(#:u #:mfiano-utils))
(:use #:cl)
(:shadow
#:count
#:map)
(:export
#:active-p
#:count
#:free
#:generate
#:id
#:make-pool
#:map
#:version))
Loading…
Cancel
Save