From 5a3dba38a1ecf3a332f57f3255f64498a28adb5e Mon Sep 17 00:00:00 2001
From: Taylor R Campbell <campbell@mumble.net>
Date: Tue, 4 Dec 2018 06:15:17 +0000
Subject: [PATCH] Disable allocator open coders.

These don't actually do anything useful.  What they do is open-code a
type check -- and then branch to the same primitive call whether the
type check passed or failed.  So they serve only to expand the code.
This appears to have been an aborted experiment in the HP PA-RISC back
end from 1993.
---
 src/compiler/rtlgen/opncod.scm | 56 ----------------------------------
 1 file changed, 56 deletions(-)

diff --git a/src/compiler/rtlgen/opncod.scm b/src/compiler/rtlgen/opncod.scm
index 79d8a0087..d2a2744e9 100644
--- a/src/compiler/rtlgen/opncod.scm
+++ b/src/compiler/rtlgen/opncod.scm
@@ -960,62 +960,6 @@ USA.
 	'()
 	(cons index (loop (cdr operands) (1+ index))))))
 
-#|
-;; This is somewhat painful to implement.  The problem is that most of
-;; the open coding takes place in "rtlcon.scm", and the mechanism for
-;; doing such things is here.  We should probably try to remodularize
-;; the code that transforms "expression-style" RTL into
-;; "statement-style" RTL, so we can call it from here and then work in
-;; the "statement-style" domain.
-
-(define-open-coder/value 'STRING-ALLOCATE
-  (simple-open-coder
-   (lambda (combination expressions finish)
-     (let ((length (car expressions)))
-       (open-code:with-checks
-	combination
-	(list (open-code:nonnegative-check length
-					   'STRING-ALLOCATE
-					   (combination/block combination)))
-	(scfg*scfg->scfg!
-	 (finish
-	  (rtl:make-typed-cons:string
-	   (rtl:make-machine-constant (ucode-type string))
-	   length)))
-	finish
-	'STRING-ALLOCATE
-	expressions)))
-   '(0)
-   internal-close-coding-for-range-checks))
-|#
-
-;; The following are discretionally open-coded by the back-end.
-;; This allows the type and range checking to take place if
-;; the switch is set appropriately.  The back-end does not check.
-
-(define (define-allocator-open-coder name args)
-  (define-open-coder/value name
-    (simple-open-coder
-     (lambda (combination expressions finish)
-       (let ((length (car expressions)))
-	 (open-code:with-checks
-	  combination
-	  (list (open-code:index-fixnum-check length
-					      name
-					      (combination/block combination))
-		(make-false-pcfg))
-	  (make-null-cfg)
-	  finish
-	  name
-	  expressions)))
-     args
-     true)))
-
-(define-allocator-open-coder 'STRING-ALLOCATE '(0))
-(define-allocator-open-coder 'FLOATING-VECTOR-CONS '(0))
-(define-allocator-open-coder 'VECTOR-CONS '(0 1))
-(define-allocator-open-coder 'ALLOCATE-BYTEVECTOR '(0))
-
 (let ((user-ref
        (lambda (name make-fetch type index)
 	 (define-open-coder/value name
-- 
2.25.1