From c14b8636fbac9826115f4524d500536d54c15625 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 11 Apr 2024 09:17:43 +0200
Subject: records: Do not inline the constructor.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Struct initialization uses one instruction per field, which contributes
to code bloat in the case of package modules.  With this change, the
‘.rtl-text’ section of ‘gnu/packages/tex.go’ goes from 7,334,508 B to
6,356,592 B (-13%; -7% on the whole file size), which alone is still
larger than the source file (4,2 MB).

* guix/records.scm (make-syntactic-constructor)[record-inheritance]: Use
CTOR instead of ‘make-struct/no-tail’.
Pass ABI-COOKIE as the first argument to CTOR.
(define-record-type*): Define CTOR-PROCEDURE and pass it to
‘make-syntactic-constructor’.

Change-Id: Ifd7b4e884e9fbf21c43fb4c3ad963126ef5cb476
---
 guix/records.scm | 47 +++++++++++++++++++++++++++++++++--------------
 1 file changed, 33 insertions(+), 14 deletions(-)

(limited to 'guix')

diff --git a/guix/records.scm b/guix/records.scm
index 48637ea0a4..dca1e3c2e7 100644
--- a/guix/records.scm
+++ b/guix/records.scm
@@ -164,16 +164,16 @@ (define (field-inherited-value f)
                (record-error 'name s "extraneous field initializers ~a"
                              unexpected)))
 
-           #`(make-struct/no-tail type
-                          #,@(map (lambda (field index)
-                                    (or (field-inherited-value field)
-                                        (if (innate-field? field)
-                                            (wrap-field-value
-                                             field (field-default-value field))
-                                            #`(struct-ref #,orig-record
-                                                          #,index))))
-                                  '(expected ...)
-                                  (iota (length '(expected ...))))))
+           #`(ctor #,abi-cookie
+                   #,@(map (lambda (field index)
+                             (or (field-inherited-value field)
+                                 (if (innate-field? field)
+                                     (wrap-field-value
+                                      field (field-default-value field))
+                                     #`(struct-ref #,orig-record
+                                                   #,index))))
+                           '(expected ...)
+                           (iota (length '(expected ...))))))
 
          (define (thunked-field? f)
            (memq (syntax->datum f) 'thunked))
@@ -249,8 +249,8 @@ (define (field-value f)
                 (cond ((lset= eq? fields '(expected ...))
                        #`(let* #,(field-bindings
                                   #'((field value) (... ...)))
-                           #,(abi-check #'type abi-cookie)
-                           (ctor #,@(map field-value '(expected ...)))))
+                           (ctor #,abi-cookie
+                                 #,@(map field-value '(expected ...)))))
                       ((pair? (lset-difference eq? fields
                                                '(expected ...)))
                        (record-error 'name s
@@ -435,7 +435,13 @@ (define (compute-abi-cookie field-specs)
               (sanitizers (filter-map field-sanitizer
                                       #'((field properties ...) ...)))
               (cookie     (compute-abi-cookie field-spec)))
-         (with-syntax (((field-spec* ...)
+         (with-syntax ((ctor-procedure
+                        (datum->syntax
+                         #'ctor
+                         (symbol-append (string->symbol " %")
+                                        (syntax->datum #'ctor)
+                                        '-procedure/abi-check)))
+                       ((field-spec* ...)
                         (map field-spec->srfi-9 field-spec))
                        ((field-type ...)
                         (map (match-lambda
@@ -502,7 +508,20 @@ (define #,(current-abi-identifier #'type)
                                                   #'id)))))))
                thunked-field-accessor ...
                delayed-field-accessor ...
-               (make-syntactic-constructor type syntactic-ctor ctor
+
+               (define ctor-procedure
+                 ;; This procedure is *not* inlined, to reduce code bloat
+                 ;; (struct initialization takes at least one instruction per
+                 ;; field).
+                 (case-lambda
+                   ((cookie field ...)
+                    (unless (eq? cookie #,cookie)
+                      (record-abi-mismatch-error type))
+                    (ctor field ...))
+                   (_
+                    (record-abi-mismatch-error type))))
+
+               (make-syntactic-constructor type syntactic-ctor ctor-procedure
                                            (field ...)
                                            #:abi-cookie #,cookie
                                            #:thunked #,thunked
-- 
cgit v1.2.3