blob: 9f78fa6e43021b481b90412794624434cd49c84f (
plain) (
tree)
|
|
#!/home/dbane/openlisp-10.9.0/uxlisp -shell
;;; UUID V1 from https://tools.ietf.org/html/rfc4122#page-18, ported to Lisp.
(require "sysdep")
(defpackage #:uuid
(:use #:openlisp #:sysdep)
(:export
#:main))
(in-package #:uuid)
(defclass <uuid> () ((time-low :accessor time-low)
(time-mid :accessor time-mid)
(time-hi-and-version :accessor time-hi-and-version)
(clock-seq-hi-and-reserved :accessor clock-seq-hi-and-reserved)
(clock-seq-low :accessor clock-seq-low)
(node :accessor node)))
(defgeneric format-v1 (obj clockseq timestamp node))
(defmethod format-v1 ((obj <uuid>) clock-seq timestamp node)
(setf (time-low obj) (logand timestamp #xFFFFFFFF))
(setf (time-mid obj) (logand (ash timestamp -32) #xFFFF))
(setf (time-hi-and-version obj) (logand (ash timestamp -48) #x0FFF))
(setf (time-hi-and-version obj) (logior (time-hi-and-version obj) (ash 1 12)))
(setf (clock-seq-low obj) (logand clock-seq #xFF))
(setf (clock-seq-hi-and-reserved obj) (ash (logand clock-seq #x3F00) -8))
(setf (clock-seq-hi-and-reserved obj) (logior (clock-seq-hi-and-reserved obj) #x80))
(setf (node obj) node))
(defun get-current-time ()
)
(defmethod initialize-object :after ((self <uuid>) initargs)
(let ((timestamp (get-current-time))
(node (get-ieee-node-identifier)))
(format-v1 self clockseq timestamp node)))
(defgeneric print-object (obj))
(defmethod print-object ((obj <uuid>))
(format (standard-output) ""))
(defun main ()
(let ((u (create (class <uuid>))))
(format (standard-output) "(create (class <uuid>)): ")
(print-object u)))
(provide "uuid")
(main)
|