commit d47bc94e1bc9fe4d1f0a9391180f7ff1924f9e9a Author: Michael Fiano Date: Thu Apr 21 05:47:00 2022 -0400 First commit. diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..a5353af --- /dev/null +++ b/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. diff --git a/README.md b/README.md new file mode 100644 index 0000000..36f5023 --- /dev/null +++ b/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 + +Licensed under the MIT License. diff --git a/identifier-pool.asd b/identifier-pool.asd new file mode 100644 index 0000000..e459bbf --- /dev/null +++ b/identifier-pool.asd @@ -0,0 +1,14 @@ +(asdf:defsystem #:identifier-pool + :description "A simple generational identification number allocator." + :author "Michael Fiano " + :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"))) diff --git a/src/identifier-pool.lisp b/src/identifier-pool.lisp new file mode 100755 index 0000000..5e9072a --- /dev/null +++ b/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)))))) diff --git a/src/package.lisp b/src/package.lisp new file mode 100644 index 0000000..e458b60 --- /dev/null +++ b/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))