From 31261a521f23ceceed787f54c83420722dff8952 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Tue, 17 Dec 2024 07:48:08 -0500
Subject: Fix some serious compilation performance issues.

The inlining of 'max' was garbage as it repeated the 'a' and 'b'
forms, leading to massive expanded code bloat that took *forever* to
compile large structures.
---
 bstruct.scm | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

(limited to 'bstruct.scm')

diff --git a/bstruct.scm b/bstruct.scm
index eb6f209..067d3c5 100644
--- a/bstruct.scm
+++ b/bstruct.scm
@@ -1363,9 +1363,9 @@
                   (symbolic-match? setter)
                   (expand-setter #'elems #'id type size))))))))))
 
-;; Guile doesn't apply peval to 'max', so let's fix that so struct
-;; size calculations can be optimized to a constant.
-(define-syntax-rule (max a b)
+;; Inline max calculations so the compiler can compile size
+;; calculations down to a constant where possible.
+(define-inlinable (max a b)
   (if (< a b) b a))
 
 (define-syntax define-bstruct*
@@ -1459,11 +1459,11 @@
                                            group-ids packed? endianness))
                      (field-size (sizeof/syntax type))
                      (field-align (alignof/syntax type))
-                     (padding (if packed?
-                                  0
-                                  #`(let ((a #,field-align))
-                                      (modulo (- a (modulo #,offset a)) a))))
-                     (offset #`(+ #,offset #,padding))
+                     (offset (if packed?
+                                 offset
+                                 #`(let ((o #,offset)
+                                         (a #,field-align))
+                                     (+ o (modulo (- a (modulo o a)) a)))))
                      (align #`(max #,align #,field-align)))
                 (lp #'rest
                     (syntax-case #'name ()
@@ -1480,10 +1480,10 @@
            (syntax-case stx ()
              (()
               #`(union #,size #,align #,(reverse fields)))
-             (((underscore expr) . rest-exprs)
+             (((underscore expr) . rest)
               (identifier-eq? #'underscore '_)
               (let ((type (compute-layout #'expr #f group-ids packed? endianness)))
-                (loop #'rest-exprs fields
+                (loop #'rest fields
                       #`(max #,size #,(sizeof/syntax type))
                       align)))
              (((name expr) . rest)
@@ -1493,8 +1493,8 @@
                                           group-ids packed? endianness)))
                 (loop #'rest
                       (cons #`(name #,type) fields)
-                      #`(max #,size #,(sizeof/syntax type))
-                      #`(max #,align #,(alignof/syntax type))))))))
+                      #`(max #,(sizeof/syntax type) #,size)
+                      #`(max #,(alignof/syntax type) #,align)))))))
         ((array length expr)
          (and (symbolic-match? array)
               (exact-integer? (syntax->datum #'length))
-- 
cgit v1.2.3