Raymond Toy pushed to branch issue-474-print-parse-hex-floats at cmucl / cmucl Commits: b32b761d by Raymond Toy at 2026-02-22T21:09:09-08:00 Update parse-hex-float to handle single-float Parse-hex-float also no longer recognizes inf or nan since that's not supported by the C hex float literals. Tests updated to handle single-float too. - - - - - 2 changed files: - src/code/ext-code.lisp - tests/extensions.lisp Changes: ===================================== src/code/ext-code.lisp ===================================== @@ -22,94 +22,50 @@ ;;; C-style hex float printer and parser -(defun print-hex-single-float (val &optional force-sign) - (let* ((bits (kernel:single-float-bits val)) - (u-bits (ldb (byte 32 0) bits)) - (sign-bit (ldb (byte 1 31) u-bits)) - (biased-exp (ldb (byte 8 23) u-bits)) - (fraction (ldb (byte 23 0) u-bits)) - (sign-str (cond ((= sign-bit 1) "-") (force-sign "+") (t "")))) - (cond - ((= biased-exp 255) (if (zerop fraction) (format nil "~Ainf" sign-str) "nan")) - ((and (zerop biased-exp) (zerop fraction)) (format nil "~A0x0.000000p+0" sign-str)) - ((zerop biased-exp) (format nil "~A0x0.~6,'0xp-126" sign-str fraction)) - (t (let ((exponent (- biased-exp 127))) - (format nil "~A0x1.~6,'0xp~:[~;+~]~D" sign-str fraction (not (minusp exponent)) exponent)))))) - -(defun print-hex-double-float (val &optional force-sign) - (multiple-value-bind (hi lo) (kernel:double-float-bits val) - (let* ((u-hi (ldb (byte 32 0) hi)) - (sign-bit (ldb (byte 1 31) u-hi)) - (biased-exp (ldb (byte 11 20) u-hi)) - (fraction (logior (ash (ldb (byte 20 0) u-hi) 32) lo)) - (sign-str (cond ((= sign-bit 1) "-") (force-sign "+") (t "")))) - (cond - ((= biased-exp #x7FF) (if (zerop fraction) (format nil "~Ainf" sign-str) "nan")) - ((and (zerop biased-exp) (zerop fraction)) (format nil "~A0x0.0000000000000p+0" sign-str)) - ((zerop biased-exp) (format nil "~A0x0.~13,'0xp-1022" sign-str fraction)) - (t (let ((exponent (- biased-exp 1023))) - (format nil "~A0x1.~13,'0xp~:[~;+~]~D" sign-str fraction (not (minusp exponent)) exponent))))))) - -#+nil -(defun print-hex-single-float (val &optional force-sign) - "Converts a single-float to a C-style hex string (32-bit)." - (let* ((bits (kernel:single-float-bits val)) - (u-bits (ldb (byte 32 0) bits)) - (sign-bit (ldb (byte 1 31) u-bits)) - (biased-exp (ldb (byte 8 23) u-bits)) - (fraction (ldb (byte 23 0) u-bits)) - (sign-str (cond ((= sign-bit 1) - "-") - (force-sign - "+") - (t - "")))) - (cond - ((= biased-exp 255) - (if (zerop fraction) - (format nil "~Ainf" sign-str) - "nan")) - ((and (zerop biased-exp) - (zerop fraction)) - (format nil "~A0x0.000000p+0" sign-str)) - ((zerop biased-exp) - (let ((*print-case* :downcase)) - (format nil "~A0x0.~6,'0xp-126" sign-str fraction))) - (t - (let ((*print-case* :downcase) - (exponent (- biased-exp 127))) - (format nil "~A0x1.~6,'0xp~:[~;+~]~D" - sign-str fraction (not (minusp exponent)) exponent)))))) +(defun print-hex-single-float (val) + "Prints a single-float in bit-perfect C-style hex using raw bits." + (cond ((float-nan-p val) "nan") + ((float-infinity-p val) (if (plusp val) "inf" "-inf")) + ((zerop val) (if (eql val -0.0f0) "-0x0.0p+0" "0x0.0p+0")) + (t + (let* ((bits (ldb (byte 32 0) (kernel:single-float-bits val))) + (sign (ldb (byte 1 31) bits)) + (exp-bits (ldb (byte 8 23) bits)) + (mantissa (ldb (byte 23 0) bits))) + (if (zerop exp-bits) + ;; Subnormal: Leading digit 0, exponent fixed at -126 + (format nil "~A0x0.~6,'0Xp-126" + (if (= sign 1) "-" "") + (ash mantissa 1)) ; Align 23 bits to 24 bits (6 hex digits) + ;; Normalized: Leading digit 1, exponent bias 127 + (format nil "~A0x1.~6,'0Xp~A" + (if (= sign 1) "-" "") + (ash mantissa 1) ; Align 23 bits to 24 bits (6 hex digits) + (- exp-bits 127))))))) -#+nil -(defun print-hex-double-float (val &optional force-sign) - "Converts a double-float to a C-style hex string (64-bit)." - (multiple-value-bind (hi lo) - (kernel:double-float-bits val) - (let* ((u-hi (ldb (byte 32 0) hi)) - (sign-bit (ldb (byte 1 31) u-hi)) - (biased-exp (ldb (byte 11 20) u-hi)) - (fraction (logior (ash (ldb (byte 20 0) u-hi) 32) lo)) - (sign-str (cond ((= sign-bit 1) - "-") - (force-sign "+") - (t "")))) - (cond - ((= biased-exp #x7FF) - (if (zerop fraction) - (format nil "~Ainf" sign-str) - "nan")) - ((and (zerop biased-exp) - (zerop fraction)) - (format nil "~A0x0.0000000000000p+0" sign-str)) - ((zerop biased-exp) - (let ((*print-case* :downcase)) - (format nil "~A0x0.~13,'0xp-1022" sign-str fraction))) +(defun print-hex-double-float (val) + "Prints a double-float in bit-perfect C-style hex using raw bits." + (cond ((float-nan-p val) "nan") + ((float-infinity-p val) (if (plusp val) "inf" "-inf")) + ((zerop val) (if (eql val -0.0d0) "-0x0.0p+0" "0x0.0p+0")) (t - (let ((*print-case* :downcase) - (exponent (- biased-exp 1023))) - (format nil "~A0x1.~13,'0xp~:[~;+~]~D" - sign-str fraction (not (minusp exponent)) exponent))))))) + (multiple-value-bind (hi-bits lo-bits) (kernel:double-float-bits val) + (let* ((hi (ldb (byte 32 0) hi-bits)) + (lo (ldb (byte 32 0) lo-bits)) + (sign (ldb (byte 1 31) hi)) + (exp-bits (ldb (byte 11 20) hi)) + ;; Combine 20 bits from high word and 32 bits from low word + (mantissa (logior (ash (ldb (byte 20 0) hi) 32) lo))) + (if (zerop exp-bits) + ;; Subnormal: Leading digit 0, exponent fixed at -1022 + (format nil "~A0x0.~13,'0Xp-1022" + (if (= sign 1) "-" "") + mantissa) + ;; Normalized: Leading digit 1, exponent bias 1023 + (format nil "~A0x1.~13,'0Xp~A" + (if (= sign 1) "-" "") + mantissa ; 52 bits fits 13 hex digits perfectly + (- exp-bits 1023)))))))) ;;; PRINT-HEX-FLOAT -- Public ;;; @@ -147,104 +103,50 @@ (format s "Hex float parse error in ~S: ~A" (hex-parse-error-text c) (hex-parse-error-message c))))) -#+nil (defun parse-hex-float (str) - "Parses hex strings by converting the significand to a float, then scaling." + "Parses hex floats using scale-float for the exponent. Strictly hex-literal only." (let* ((str (string-trim '(#\Space #\Tab #\Newline #\Return) (string-downcase str))) (len (length str))) (when (zerop len) (error 'hex-parse-error :text str :message "Empty string")) - (let* ((has-sign (or (char= (char str 0) #\-) (char= (char str 0) #\+))) + + (let* ((ends-with-f (and (> len 1) (char= (char str (1- len)) #\f))) + (effective-len (if ends-with-f (1- len) len)) + (prototype (if ends-with-f 1.0f0 1.0d0)) + (has-sign (or (char= (char str 0) #\-) (char= (char str 0) #\+))) (sign (if (and has-sign (char= (char str 0) #\-)) -1 1)) (start (if has-sign 1 0))) - (cond - ((string= str "inf" :start1 start) - (if (= sign 1) double-float-positive-infinity double-float-negative-infinity)) - ((string= str "nan" :start1 start) :nan) - (t - (unless (and (<= (+ start 2) len) (string= str "0x" :start1 start :end1 (+ start 2))) - (error 'hex-parse-error :text str :message "Missing '0x' prefix")) - (let ((p-pos (position #\p str :start start))) - (unless p-pos (error 'hex-parse-error :text str :message "Missing exponent 'p'")) - - ;; Check for internal whitespace - (loop for i from start below len - when (member (char str i) '(#\Space #\Tab #\Newline #\Return)) - do (error 'hex-parse-error :text str :message "Internal whitespace detected")) - - (let* ((sig-start (+ start 2)) - (dot-pos (position #\. str :start sig-start :end p-pos)) - (exp-start (1+ p-pos))) - - (handler-case - (let* ((frac-hex-len (if dot-pos (- p-pos (1+ dot-pos)) 0)) - ;; 1. Combine leading and trailing into one large integer - (significand-int - (if (null dot-pos) - (parse-integer str :start sig-start :end p-pos :radix 16) - (let ((leading (if (= sig-start dot-pos) 0 - (parse-integer str :start sig-start :end dot-pos :radix 16))) - (trailing (if (= (1+ dot-pos) p-pos) 0 - (parse-integer str :start (1+ dot-pos) :end p-pos :radix 16)))) - (+ (ash leading (* 4 frac-hex-len)) trailing)))) - ;; 2. Parse decimal exponent - (raw-exponent (parse-integer str :start exp-start :end len)) - ;; 3. Handle the "cliff" logic for 0x0. vs 0x1. - (starts-with-zero (char= (char str sig-start) #\0)) - (actual-exponent (if (and starts-with-zero (not (zerop significand-int))) - -1022 - raw-exponent))) - - ;; 4. Convert integer to float and scale by (exponent - fractional bits) - ;; scale-float is bit-exact for binary scaling. - (* sign (scale-float (float significand-int 1.0d0) - (- actual-exponent (* 4 frac-hex-len))))) - (error (c) (error 'hex-parse-error :text str :message (format nil "~A" c))))))))))) + + (unless (and (<= (+ start 2) effective-len) + (string= str "0x" :start1 start :end1 (+ start 2))) + (error 'hex-parse-error :text str :message "Missing '0x' prefix")) + + (let ((p-pos (position #\p str :start start :end effective-len))) + (unless p-pos (error 'hex-parse-error :text str :message "Missing exponent 'p'")) -(defun parse-hex-float (str) - "Parses C-style hex strings via an exact rational. Strictly validates digit presence." - (let* ((str (string-trim '(#\Space #\Tab #\Newline #\Return) (string-downcase str))) - (len (length str))) - (when (zerop len) (error 'hex-parse-error :text str :message "Empty string")) - (let* ((has-sign (or (char= (char str 0) #\-) (char= (char str 0) #\+))) - (sign (if (and has-sign (char= (char str 0) #\-)) -1 1)) - (start (if has-sign 1 0))) - (cond - ((string= str "inf" :start1 start) - (if (= sign 1) double-float-positive-infinity double-float-negative-infinity)) - ((string= str "nan" :start1 start) :nan) - (t - (unless (and (<= (+ start 2) len) (string= str "0x" :start1 start :end1 (+ start 2))) - (error 'hex-parse-error :text str :message "Missing '0x' prefix")) - (let ((p-pos (position #\p str :start start))) - (unless p-pos (error 'hex-parse-error :text str :message "Missing exponent 'p'")) - - (loop for i from start below len - when (member (char str i) '(#\Space #\Tab #\Newline #\Return)) - do (error 'hex-parse-error :text str :message "Internal whitespace detected")) + (let* ((sig-start (+ start 2)) + (dot-pos (position #\. str :start sig-start :end p-pos)) + (exp-start (1+ p-pos)) + ;; Leading hex: digits before the dot + (leading-str (subseq str sig-start (or dot-pos p-pos))) + ;; Trailing hex: digits after the dot + (trailing-str (if dot-pos (subseq str (1+ dot-pos) p-pos) "")) + (has-digits (or (plusp (length leading-str)) (plusp (length trailing-str))))) + + (unless has-digits + (error 'hex-parse-error :text str :message "No hex digits in significand")) - (let* ((sig-start (+ start 2)) - (dot-pos (position #\. str :start sig-start :end p-pos)) - (exp-start (1+ p-pos)) - ;; Strict Validation: Ensure there is at least one digit in the significand - (has-leading (and (not (eql sig-start dot-pos)) (not (eql sig-start p-pos)))) - (has-trailing (and dot-pos (not (eql (1+ dot-pos) p-pos))))) - - (unless (or has-leading has-trailing) - (error 'hex-parse-error :text str :message "No hex digits in significand")) - - (handler-case - (let* ((frac-hex-len (if dot-pos (- p-pos (1+ dot-pos)) 0)) - (significand-int - (if (null dot-pos) - (parse-integer str :start sig-start :end p-pos :radix 16) - (let ((leading (if (not has-leading) 0 - (parse-integer str :start sig-start :end dot-pos :radix 16))) - (trailing (if (not has-trailing) 0 - (parse-integer str :start (1+ dot-pos) :end p-pos :radix 16)))) - (+ (ash leading (* 4 frac-hex-len)) trailing)))) - (raw-exponent (parse-integer str :start exp-start :end len)) - ;; significand * 2^(exp - 4*frac_len) - (rational-val (* significand-int - (expt 2 (- raw-exponent (* 4 frac-hex-len)))))) - (* sign (float rational-val 1.0d0))) - (error (c) (error 'hex-parse-error :text str :message (format nil "~A" c))))))))))) + (handler-case + (let* ((leading-int (if (string= leading-str "") 0 + (parse-integer leading-str :radix 16))) + (trailing-len (length trailing-str)) + (trailing-int (if (string= trailing-str "") 0 + (parse-integer trailing-str :radix 16))) + ;; Calculate the significand as a float: leading + (trailing / 16^len) + (significand (float (+ leading-int + (/ trailing-int (expt 16 trailing-len))) + prototype)) + ;; The exponent after 'p' + (raw-exponent (parse-integer str :start exp-start :end effective-len))) + ;; Use scale-float to apply the binary exponent efficiently + (* sign (scale-float significand raw-exponent))) + (error (c) (error 'hex-parse-error :text str :message (format nil "~A" c))))))))) ===================================== tests/extensions.lisp ===================================== @@ -4,153 +4,58 @@ (in-package "EXTENSIONS-TESTS") -#+nil -(defun test-invalid-strings () - (format t "Testing invalid strings...~%") - (let ((invalid-cases '("" "1.0" "0x1.0" "0x1.0p" "0x1.zp+0" "0x.p+0" "0x1 .0p+0"))) - (dolist (case invalid-cases) - (handler-case - (progn (parse-hex-float case) (error "Failed to trap ~S" case)) - (hex-parse-error () (format t " Caught expected error for: ~S~%" case))))) - (format t "Invalid string tests passed.~%")) - -(define-test parse-hex.invalid-strings - (dolist (case '("" "1.0" "0x1.0" "0x1.0p" "0x1.zp+0" "0x.p+0" "0x1 .0p+0")) - (assert-error 'ext:hex-parse-error - (ext:parse-hex-float case) - case))) - -#+nil -(defun run-hex-float-tests (&key (iterations 20000)) - "Validates bit-consistency for double floats." - (format t "Testing ~D random bit patterns (Double Precision)...~%" iterations) - (loop repeat iterations do - (let* ((hi-bits (random (expt 2 32))) - (hi (if (logbitp 31 hi-bits) - (- hi-bits (expt 2 32)) - hi-bits)) - (lo (random (expt 2 32))) - (d-float (kernel:make-double-float hi lo)) - (d-str (print-hex-double-float d-float)) - (d-parsed (parse-hex-float d-str))) - (cond - ((eq d-parsed :nan) - (assert (float-nan-p d-float))) - (t - (multiple-value-bind (n-hi n-lo) - (kernel:double-float-bits d-parsed) - (assert (and (= (ldb (byte 32 0) hi) - (ldb (byte 32 0) n-hi)) - (= lo n-lo)))))))) - (format t "Bit verification passed.~%")) - -(define-test hex-parse-print-consistency - (loop repeat 20000 do - (let* ((hi-bits (random (expt 2 32))) - (hi (if (logbitp 31 hi-bits) - (- hi-bits (expt 2 32)) - hi-bits)) - (lo (random (expt 2 32))) - (d-float (kernel:make-double-float hi lo)) - (d-str (ext:print-hex-float d-float)) - (d-parsed (ext:parse-hex-float d-str))) - (cond - ((eq d-parsed :nan) - (assert-true (ext:float-nan-p d-float) - d-float d-parsed)) - (t - (multiple-value-bind (n-hi n-lo) - (kernel:double-float-bits d-parsed) - (assert-true (= (ldb (byte 32 0) hi) - (ldb (byte 32 0) n-hi)) - hi n-hi) - (assert-true (= lo n-lo) - lo n-lo))))))) - - -#+nil -(defun run-subnormal-stress-test () - (format t "Running subnormal stress tests...~%") - (let* ((s-str "0x0.10534ec00dae8p-1022") - (parsed (parse-hex-float s-str))) - ;; Using assumed builtin float-denormalized-p - (assert (float-denormalized-p parsed)) - (multiple-value-bind (hi lo) (kernel:double-float-bits parsed) - (assert (= (logior (ash (ldb (byte 20 0) hi) 32) lo) #x10534ec00dae8)))) - (loop repeat 5000 do - (let* ((lo (random (expt 2 32))) - (hi (random (expt 2 20))) ; biased exponent is 0 - (val (kernel:make-double-float hi lo)) - (str (ext::print-hex-double-float val)) - (parsed (parse-hex-float str))) - (unless (zerop val) - (multiple-value-bind (new-hi new-lo) (kernel:double-float-bits parsed) - (assert (and (= hi new-hi) (= lo new-lo))))))) - (format t "Subnormal stress test passed.~%")) - -(define-test hex-parse-denormals.1 - (let* ((s-str "0x0.10534ec00dae8p-1022") - (parsed (ext:parse-hex-float s-str))) - (assert-true (ext:float-denormalized-p parsed)) - (multiple-value-bind (hi lo) - (kernel:double-float-bits parsed) - (assert-true (= (logior (ash (ldb (byte 20 0) hi) 32) lo) - #x10534ec00dae8))))) +(defun get-double-bits (val) + (multiple-value-bind (hi lo) (kernel:double-float-bits val) + (logior (ash (ldb (byte 32 0) hi) 32) (ldb (byte 32 0) lo)))) + +(defun get-single-bits (val) + (ldb (byte 32 0) (kernel:single-float-bits val))) + +(define-test test-hex-syntax + (:tag :validation) + (assert-error 'ext:hex-parse-error (ext:parse-hex-float "inf")) + (assert-error 'ext:hex-parse-error (ext:parse-hex-float "0x.p+0")) + (assert-error 'ext:hex-parse-error (ext:parse-hex-float "0x1.0p"))) + +(define-test test-cliff-boundaries + (:tag :precision) + ;; Double Precision (-1022 Cliff) -(define-test hex-parse-denormals.random - (loop repeat 5000 do - (let* ((lo (random (expt 2 32))) - (hi (random (expt 2 20))) ; biased exponent is 0 - (val (kernel:make-double-float hi lo)) - (str (ext::print-hex-double-float val)) - (parsed (ext:parse-hex-float str))) - (unless (zerop val) - (multiple-value-bind (new-hi new-lo) - (kernel:double-float-bits parsed) - (assert-true (and (= hi new-hi) (= lo new-lo)))))))) - -#+nil -(defun run-cliff-tests () - "Tests precision around the smallest normalized and largest subnormal boundary." - (format t "Running boundary (cliff) tests...~%") - (let ((cases '(;; Smallest normalized number (2^-1022) - ("0x1.0000000000000p-1022" #x0010000000000000) - ;; Smallest normalized + 1 ULP - ("0x1.0000000000001p-1022" #x0010000000000001) - ;; Smallest normalized - 1 ULP (Largest subnormal) - ("0x0.fffffffffffffp-1022" #x000fffffffffffff) - ;; The user reported failing case - ("0x1.f0195cb356b8fp-1022" #x001f0195cb356b8f)))) - (dolist (test cases) - (destructuring-bind (str expected-bits) test - (let* ((parsed (parse-hex-float str)) - (actual-bits (multiple-value-bind (hi lo) (kernel:double-float-bits parsed) - (logior (ash (ldb (byte 32 0) hi) 32) lo)))) - (format t " Testing ~A...~%" str) - (unless (= actual-bits expected-bits) - (error "Cliff Mismatch!~%Str: ~A~%Expected: ~16,'0X~%Actual: ~16,'0X" - str expected-bits actual-bits)))))) - (format t "Cliff tests passed.~%")) - -;; Test precision around the smallest normalized and larges denormal boundary. -(define-test hex-parse-denormal-boundary - (let ((cases '(;; Smallest normalized number (2^-1022) - ("0x1.0000000000000p-1022" #x0010000000000000) - ;; Smallest normalized + 1 ULP - ("0x1.0000000000001p-1022" #x0010000000000001) - ;; Smallest normalized - 1 ULP (Largest subnormal) - ("0x0.fffffffffffffp-1022" #x000fffffffffffff) - ;; The user reported failing case - ("0x1.f0195cb356b8fp-1022" #x001f0195cb356b8f) - ;; Failing case 1: 0x0.10534ec00dae8p-1022 - ("0x0.10534ec00dae8p-1022" #x00010534ec00dae8) - ;; Failing case 2: 0x0.49df16729d954p-1022 - ("0x0.49df16729d954p-1022" #x00049df16729d954)))) - (dolist (test cases) - (destructuring-bind (str expected-bits) test - (let* ((parsed (ext:parse-hex-float str)) - (actual-bits (multiple-value-bind (hi lo) - (kernel:double-float-bits parsed) - (logior (ash (ldb (byte 32 0) hi) 32) lo)))) - (assert-equal expected-bits actual-bits - str)))))) + (assert-equal #x0010000000000000 (get-double-bits (ext:parse-hex-float "0x1.0000000000000p-1022"))) + (assert-equal #x000fffffffffffff (get-double-bits (ext:parse-hex-float "0x0.fffffffffffffp-1022"))) + (assert-equal #x001f0195cb356b8f (get-double-bits (ext:parse-hex-float "0x1.f0195cb356b8fp-1022"))) + + ;; Single Precision (-126 Cliff) + + (assert-equal #x00800000 (get-single-bits (ext:parse-hex-float "0x1.000000p-126f"))) + (assert-equal #x00400000 (get-single-bits (ext:parse-hex-float "0x0.800000p-126f"))) + (assert-equal #x7f7fffff (get-single-bits (ext:parse-hex-float "0x1.fffffep+127f")))) + +(define-test test-negative-zero + (:tag :edge-cases) + (assert-equal #x8000000000000000 (get-double-bits (ext:parse-hex-float "-0x0.0p+0"))) + (assert-equal #x80000000 (get-single-bits (ext:parse-hex-float "-0x0.0p+0f"))) + (assert-true (typep (ext:parse-hex-float "-0x0.0p+0f") 'single-float))) + +(define-test test-double-roundtrip + (:tag :stress) + (loop repeat 10000 do + (let* ((hi-bits (random #x100000000)) + (hi (if (logbitp 31 hi-bits) (- hi-bits #x100000000) hi-bits)) + (lo (random #x100000000)) + (val (kernel:make-double-float hi lo))) + (unless (or (ext:float-nan-p val) (ext:float-infinity-p val)) + (let* ((str (ext::print-hex-double-float val)) + (parsed (ext:parse-hex-float str))) + (assert-equal (get-double-bits val) (get-double-bits parsed))))))) + +(define-test test-single-roundtrip + (:tag :stress) + (loop repeat 10000 do + (let* ((bits-raw (random #x100000000)) + (bits (if (logbitp 31 bits-raw) (- bits-raw #x100000000) bits-raw)) + (val (kernel:make-single-float bits))) + (unless (or (ext:float-nan-p val) (ext:float-infinity-p val)) + (let* ((str (concatenate 'string (ext::print-hex-single-float val) "f")) + (parsed (ext:parse-hex-float str))) + (assert-equal (get-single-bits val) (get-single-bits parsed))))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b32b761d8abf7d62fb04c377... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/b32b761d8abf7d62fb04c377... You're receiving this email because of your account on gitlab.common-lisp.net.