lloda pushed a commit to branch main
in repository guile.
commit 71d9f143e3b4147e032bbb7614ffd3aba66603cc
Author: Rob Browning <r...@defaultvalue.org>
AuthorDate: Wed Sep 10 16:01:28 2025 -0500
srfi-207: pregenerate and reuse standard base64 encodings
Pregenerate and re-use encoding tables for the two RFC standard
encodings, and represent the tables as bytevectors since that's more
efficient and all we need. cf.
https://datatracker.ietf.org/doc/html/rfc4648#section-4
https://datatracker.ietf.org/doc/html/rfc4648#section-5
* module/srfi/srfi-207.scm (get-base64-encode-table): Represent table
as bytevector and re-use common encodings.
* module/srfi/srfi-207/upstream/base64.scm (make-base64-encode-table):
Move to srfi-207.scm as get-base64-encode-table.
(base64-encode-bytevector): Get table via get-base64-encode-table.
(base64-encode-bytevector!): Access table as bytevector.
---
module/srfi/srfi-207.scm | 18 ++++++++++++++++++
module/srfi/srfi-207/upstream/base64.scm | 15 ++-------------
2 files changed, 20 insertions(+), 13 deletions(-)
diff --git a/module/srfi/srfi-207.scm b/module/srfi/srfi-207.scm
index 56085d6be..cd6d1de15 100644
--- a/module/srfi/srfi-207.scm
+++ b/module/srfi/srfi-207.scm
@@ -23,6 +23,7 @@
;;; Code:
(define-module (srfi srfi-207)
+ #:use-module ((ice-9 iconv) #:select (string->bytevector))
#:use-module ((rnrs arithmetic bitwise) #:select (bitwise-and bitwise-ior))
#:use-module ((rnrs bytevectors)
#:select (bytevector->u8-list
@@ -102,6 +103,23 @@
((_ pred) (unless pred (error "invalid assumption:" (quote pred))))
((_ pred msg ...) (unless pred (error msg ...)))))
+(define common-base64-encoding
+ "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
+
+(define standard-base64-encode-table ; RFC 4648 section 4
+ (bytestring common-base64-encoding "+/="))
+
+(define url&filename-safe-base64-encode-table ; RFC 4648 section 5
+ (bytestring common-base64-encoding "-_="))
+
+(define (get-base64-encode-table digits)
+ (cond
+ ((string= "+/" digits) standard-base64-encode-table)
+ ((string= "-_" digits) url&filename-safe-base64-encode-table)
+ (else (bytestring common-base64-encoding
+ (string->bytevector digits "ASCII")
+ "="))))
+
(include-from-path "ice-9/read/bytestring.scm")
(include-from-path "srfi/srfi-207/upstream/base64.scm")
(include-from-path "srfi/srfi-207/upstream/bytestrings-impl.scm")
diff --git a/module/srfi/srfi-207/upstream/base64.scm
b/module/srfi/srfi-207/upstream/base64.scm
index 71845c174..cfbd2c9c1 100644
--- a/module/srfi/srfi-207/upstream/base64.scm
+++ b/module/srfi/srfi-207/upstream/base64.scm
@@ -50,17 +50,6 @@
(define (base64-decode-u8 table u8)
(vector-ref table u8))
-(define (make-base64-encode-table digits)
- (vector-unfold
- (lambda (i)
- (cond ((< i 26) (+ i 65)) ; upper-case letters
- ((< i 52) (+ i 71)) ; lower-case letters
- ((< i 62) (- i 4)) ; numbers
- ((= i 62) (char->integer (string-ref digits 0)))
- ((= i 63) (char->integer (string-ref digits 1)))
- (else (error "out of range"))))
- 64))
-
;;;; Decoding
(define (decode-base64-string src digits)
@@ -124,13 +113,13 @@
(rem (- len (* quot 3)))
(res-len (arithmetic-shift (+ quot (if (zero? rem) 0 1)) 2))
(res (make-bytevector res-len))
- (table (make-base64-encode-table digits)))
+ (table (get-base64-encode-table digits)))
(base64-encode-bytevector! bv 0 len res table)
res))
(define (base64-encode-bytevector! bv start end res table)
(let ((limit (- end 2))
- (enc (lambda (i) (vector-ref table i))))
+ (enc (lambda (i) (bytevector-u8-ref table i))))
(let lp ((i start) (j 0))
(if (>= i limit)
(case (- end i)
