From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 10 Apr 2017 04:08:57 +0000 (-0700)
Subject: Eliminate unused multi-byte procedures.
X-Git-Tag: mit-scheme-pucked-9.2.12~158^2~58
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=ad60e7aacc0a67a2219abb48d484f22c0c18c2e3;p=mit-scheme.git

Eliminate unused multi-byte procedures.

No need to support a bunch of code that may never be used.
---

diff --git a/src/runtime/bytevector.scm b/src/runtime/bytevector.scm
index 3332a62eb..dd34c0719 100644
--- a/src/runtime/bytevector.scm
+++ b/src/runtime/bytevector.scm
@@ -219,84 +219,18 @@ USA.
   (guarantee u16? u16 'bytevector-u16le-set!)
   (bytevector-u8-set! bytevector index (u16le-byte0 u16))
   (bytevector-u8-set! bytevector (fix:+ index 1) (u16le-byte1 u16)))
-
-(define-integrable (list->bytevector-u16-maker u16-byte0 u16-byte1)
-  (lambda (u16s)
-    (let ((bv (allocate-bytevector (fix:lsh (length u16s) 1))))
-      (do ((u16s u16s (cdr u16s))
-	   (i 0 (fix:+ i 2)))
-	  ((not (pair? u16s)))
-	(bytevector-u8-set! bv i (u16-byte0 (car u16s)))
-	(bytevector-u8-set! bv (fix:+ i 1) (u16-byte1 (car u16s))))
-      bv)))
-
-(define list->bytevector-u16be
-  (list->bytevector-u16-maker u16be-byte0 u16be-byte1))
-
-(define list->bytevector-u16le
-  (list->bytevector-u16-maker u16le-byte0 u16le-byte1))
-
-(define (bytevector-u16be . u16s)
-  (list->bytevector-u16be u16s))
-
-(define (bytevector-u16le . u16s)
-  (list->bytevector-u16le u16s))
-
-(define-integrable (bytevector-u16->list-maker bytes->u16 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-	   (start (fix:start-index start end caller)))
-      (do ((i (fix:- end 2) (fix:- i 2))
-	   (bytes '()
-		  (cons (bytes->u16 (bytevector-u8-ref bv i)
-				    (bytevector-u8-ref bv (fix:+ i 1)))
-			bytes)))
-	  ((not (fix:>= i start)) bytes)))))
-
-(define bytevector-u16be->list
-  (bytevector-u16->list-maker bytes->u16be 'bytevector-u16be->list))
-
-(define bytevector-u16le->list
-  (bytevector-u16->list-maker bytes->u16le 'bytevector-u16le->list))
-
-(define-integrable (vector->bytevector-u16-maker u16-byte0 u16-byte1 caller)
-  (lambda (v #!optional start end)
-    (let* ((end (fix:end-index end (vector-length v) caller))
-	   (start (fix:start-index start end caller))
-	   (bv (allocate-bytevector (fix:lsh (fix:- end start) 1))))
-      (do ((i start (fix:+ i 1))
-	   (j 0 (fix:+ j 2)))
-	  ((not (fix:< i end)))
-	(bytevector-u8-set! bv j (u16-byte0 (vector-ref v i)))
-	(bytevector-u8-set! bv (fix:+ j 1) (u16-byte1 (vector-ref v i))))
-      bv)))
 
-(define vector->bytevector-u16be
-  (vector->bytevector-u16-maker u16be-byte0 u16be-byte1
-				'vector->bytevector-u16be))
-
-(define vector->bytevector-u16le
-  (vector->bytevector-u16-maker u16le-byte0 u16le-byte1
-				'vector->bytevector-u16le))
-
-(define-integrable (bytevector-u16->vector-maker bytes->u16 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-	   (start (fix:start-index start end caller))
-	   (v (make-vector (fix:lsh (fix:- end start) -1))))
-      (do ((i start (fix:+ i 2))
-	   (j 0 (fix:+ j 1)))
-	  ((not (fix:< (fix:+ i 1) end)))
-	(vector-set! bv j
-		     (bytes->u16 (bytevector-u8-ref v i)
-				 (bytevector-u8-ref v (fix:+ i 1)))))
-      v)))
-
-(define bytevector-u16be->vector
-  (bytevector-u16->vector-maker bytes->u16be 'bytevector-u16be->vector))
-
-(define bytevector-u16le->vector
-  (bytevector-u16->vector-maker bytes->u16le 'bytevector-u16le->vector))
+;; Can be removed after 9.3 release:
+(define (vector->bytevector-u16be v #!optional start end)
+  (let* ((end (fix:end-index end (vector-length v) 'vector->bytevector-u16))
+	 (start (fix:start-index start end 'vector->bytevector-u16))
+	 (bv (allocate-bytevector (fix:lsh (fix:- end start) 1))))
+    (do ((i start (fix:+ i 1))
+	 (j 0 (fix:+ j 2)))
+	((not (fix:< i end)))
+      (bytevector-u8-set! bv j (u16be-byte0 (vector-ref v i)))
+      (bytevector-u8-set! bv (fix:+ j 1) (u16be-byte1 (vector-ref v i))))
+    bv))
 
 ;;;; U32 accessors
 
@@ -390,94 +324,6 @@ USA.
   (bytevector-u8-set! bytevector (fix:+ index 2) (u32le-byte2 u32))
   (bytevector-u8-set! bytevector (fix:+ index 3) (u32le-byte3 u32)))
 
-(define-integrable (list->bytevector-u32-maker u32-byte0 u32-byte1 u32-byte2
-					       u32-byte3)
-  (lambda (u32s)
-    (let ((bv (allocate-bytevector (fix:lsh (length u32s) 2))))
-      (do ((u32s u32s (cdr u32s))
-	   (i 0 (fix:+ i 4)))
-	  ((not (pair? u32s)))
-	(bytevector-u8-set! bv i (u32-byte0 (car u32s)))
-	(bytevector-u8-set! bv (fix:+ i 1) (u32-byte1 (car u32s)))
-	(bytevector-u8-set! bv (fix:+ i 2) (u32-byte2 (car u32s)))
-	(bytevector-u8-set! bv (fix:+ i 3) (u32-byte3 (car u32s))))
-      bv)))
-
-(define list->bytevector-u32be
-  (list->bytevector-u32-maker u32be-byte0 u32be-byte1 u32be-byte2 u32be-byte3))
-
-(define list->bytevector-u32le
-  (list->bytevector-u32-maker u32le-byte0 u32le-byte1 u32le-byte2 u32le-byte3))
-
-(define (bytevector-u32be . u32s)
-  (list->bytevector-u32be u32s))
-
-(define (bytevector-u32le . u32s)
-  (list->bytevector-u32le u32s))
-
-(define-integrable (bytevector-u32->list-maker bytes->u32 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-	   (start (fix:start-index start end caller)))
-      (do ((i (fix:- end 4) (fix:- i 4))
-	   (bytes '()
-		  (cons (bytes->u32 (bytevector-u8-ref bv i)
-				    (bytevector-u8-ref bv (fix:+ i 1))
-				    (bytevector-u8-ref bv (fix:+ i 2))
-				    (bytevector-u8-ref bv (fix:+ i 3)))
-			bytes)))
-	  ((not (fix:>= i start)) bytes)))))
-
-(define bytevector-u32be->list
-  (bytevector-u32->list-maker bytes->u32be 'bytevector-u32be->list))
-
-(define bytevector-u32le->list
-  (bytevector-u32->list-maker bytes->u32le 'bytevector-u32le->list))
-
-(define-integrable (vector->bytevector-u32-maker u32-byte0 u32-byte1 u32-byte2
-						 u32-byte3 caller)
-  (lambda (v #!optional start end)
-    (let* ((end (fix:end-index end (vector-length v) caller))
-	   (start (fix:start-index start end caller))
-	   (bv (allocate-bytevector (fix:lsh (fix:- end start) 1))))
-      (do ((i start (fix:+ i 1))
-	   (j 0 (fix:+ j 4)))
-	  ((not (fix:< i end)))
-	(bytevector-u8-set! bv j (u32-byte0 (vector-ref v i)))
-	(bytevector-u8-set! bv (fix:+ j 1) (u32-byte1 (vector-ref v i)))
-	(bytevector-u8-set! bv (fix:+ j 2) (u32-byte2 (vector-ref v i)))
-	(bytevector-u8-set! bv (fix:+ j 3) (u32-byte3 (vector-ref v i))))
-      bv)))
-
-(define vector->bytevector-u32be
-  (vector->bytevector-u32-maker u32be-byte0 u32be-byte1 u32be-byte2 u32be-byte3
-				'vector->bytevector-u32be))
-
-(define vector->bytevector-u32le
-  (vector->bytevector-u32-maker u32le-byte0 u32le-byte1 u32le-byte2 u32le-byte3
-				'vector->bytevector-u32le))
-
-(define-integrable (bytevector-u32->vector-maker bytes->u32 caller)
-  (lambda (bv #!optional start end)
-    (let* ((end (fix:end-index end (bytevector-length bv) caller))
-	   (start (fix:start-index start end caller))
-	   (v (make-vector (fix:lsh (fix:- end start) -2))))
-      (do ((i start (fix:+ i 4))
-	   (j 0 (fix:+ j 1)))
-	  ((not (fix:< (fix:+ i 3) end)))
-	(vector-set! bv j
-		     (bytes->u32 (bytevector-u8-ref v i)
-				 (bytevector-u8-ref v (fix:+ i 1))
-				 (bytevector-u8-ref v (fix:+ i 2))
-				 (bytevector-u8-ref v (fix:+ i 3)))))
-      v)))
-
-(define bytevector-u32be->vector
-  (bytevector-u32->vector-maker bytes->u32be 'bytevector-u32be->vector))
-
-(define bytevector-u32le->vector
-  (bytevector-u32->vector-maker bytes->u32le 'bytevector-u32le->vector))
-
 (define-integrable (string-encoder char-byte-length allocator encode-char!
 				   caller)
   (lambda (string #!optional start end)
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 342b68ed9..9c0b93aa0 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1076,24 +1076,12 @@ USA.
 	  bytevector-fill!
 	  bytevector-hash
 	  bytevector-length
-	  bytevector-u16be
-	  bytevector-u16be->list
-	  bytevector-u16be->vector
 	  bytevector-u16be-ref
 	  bytevector-u16be-set!
-	  bytevector-u16le
-	  bytevector-u16le->list
-	  bytevector-u16le->vector
 	  bytevector-u16le-ref
 	  bytevector-u16le-set!
-	  bytevector-u32be
-	  bytevector-u32be->list
-	  bytevector-u32be->vector
 	  bytevector-u32be-ref
 	  bytevector-u32be-set!
-	  bytevector-u32le
-	  bytevector-u32le->list
-	  bytevector-u32le->vector
 	  bytevector-u32le-ref
 	  bytevector-u32le-set!
 	  bytevector-u8-ref
@@ -1102,10 +1090,6 @@ USA.
 	  bytevector?
 	  hexadecimal->bytevector
 	  list->bytevector
-	  list->bytevector-u16be
-	  list->bytevector-u16le
-	  list->bytevector-u32be
-	  list->bytevector-u32le
 	  make-bytevector
 	  string->utf16be
 	  string->utf16le
@@ -1120,15 +1104,13 @@ USA.
 	  utf32be->string
 	  utf32le->string
 	  utf8->string
-	  vector->bytevector
-	  vector->bytevector-u16be
-	  vector->bytevector-u16le
-	  vector->bytevector-u32be
-	  vector->bytevector-u32le)
+	  vector->bytevector)
   (export (runtime predicate-metadata)
 	  register-mit-bytevector-predicates!)
   (export (runtime symbol)
-	  %legacy-string->bytevector))
+	  %legacy-string->bytevector)
+  (export (runtime ucd-tables)
+	  vector->bytevector-u16be))
 
 (define-package (runtime 1d-property)
   (files "prop1d")