From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sun, 30 Apr 2017 01:41:45 +0000 (-0700)
Subject: Fix merge.
X-Git-Tag: mit-scheme-pucked-9.2.12~147
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=43ac82bf0a517fd5e4bc2cea7179f6d13f437483;p=mit-scheme.git

Fix merge.
---

diff --git a/src/glib/gio.scm b/src/glib/gio.scm
index 15b3265c6..3baaf37a9 100644
--- a/src/glib/gio.scm
+++ b/src/glib/gio.scm
@@ -30,7 +30,11 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (let* ((uri* (->uri* uri 'open-input-gfile))
 	 (gfile (make-gfile uri*))
 	 (gstream (gfile-read gfile))
-	 (port (make-generic-i/o-port (make-g-stream-source gstream) #f
+	 (port (make-generic-i/o-port (make-binary-port
+				       (make-g-stream-source gstream)
+				       #f
+				       'open-input-gfile)
+				      (default-object)
 				      'open-input-gfile)))
     ;;(port/set-coding port 'ISO-8859-1)
     ;;(port/set-line-ending port 'NEWLINE)
@@ -57,34 +61,27 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 	    (else (loop again (fix:1+ count)))))))
 
 (define (make-g-stream-source gstream)
-  ;; Not unlike make-non-channel-ss in genio.scm.
-  (let ((port #f)
-	(open? #t))
-    (make-source/sink
-     'source
-     #f
-     (named-lambda (g-stream-source/get-port)
-       port)
-     (named-lambda (g-stream-source/set-port! port*)
-       (set! port port*))
-     (named-lambda (g-stream-source/open?)
-       open?)
-     (named-lambda (g-stream-source/close)
-       (if open?
-	   (let ((value (g-input-stream-close gstream)))
-	     (set! open? #f)
-	     value)))
-     (vector
+  (let ((open? #t))
+    (make-non-channel-input-source
       (named-lambda (g-stream-source/has-bytes?)
 	#t)
-      (named-lambda (g-stream-source/read-bytes buffer start end)
-	(g-input-stream-read gstream buffer start end))))))
+      (named-lambda (g-stream-source/read-bytes! buffer start end)
+	(g-input-stream-read gstream buffer start end))
+      (named-lambda (g-stream-source/close)
+	(if open?
+	    (let ((value (g-input-stream-close gstream)))
+	      (set! open? #f)
+	      value))))))
 
 (define (open-output-gfile uri)
   (let* ((uri* (->uri* uri 'open-output-gfile))
 	 (gfile (make-gfile uri*))
 	 (gstream (gfile-replace gfile #f #t 'private))
-	 (port (make-generic-i/o-port #f (make-g-stream-sink gstream)
+	 (port (make-generic-i/o-port (make-binary-port
+				       #f
+				       (make-g-stream-sink gstream)
+				       'open-output-gfile)
+				      (default-object)
 				      'open-output-gfile)))
     ;;(port/set-coding port 'ISO-8859-1)
     ;;(port/set-line-ending port 'NEWLINE)
@@ -92,26 +89,15 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     port))
 
 (define (make-g-stream-sink gstream)
-  ;; Not unlike make-non-channel-ss in genio.scm.
-  (let ((port #f)
-	(open? #t))
-    (make-source/sink
-     'sink
-     #f
-     (named-lambda (g-stream-sink/get-port)
-       port)
-     (named-lambda (g-stream-sink/set-port! port*)
-       (set! port port*))
-     (named-lambda (g-stream-sink/open?)
-       open?)
+  (let ((open? #t))
+    (make-non-channel-output-sink
+     (named-lambda (g-stream-sink/write-bytes buffer start end)
+       (g-output-stream-write gstream buffer start end))
      (named-lambda (g-stream-sink/close)
        (if open?
 	   (let ((value (g-output-stream-close gstream)))
 	     (set! open? #f)
-	     value)))
-     (vector
-      (named-lambda (g-stream-sink/write-bytes buffer start end)
-	(g-output-stream-write gstream buffer start end))))))
+	     value))))))
 
 (define (gdirectory-read uri)
   (let* ((uri* (->uri* uri 'gdirectory-read))
diff --git a/src/glib/glib.pkg b/src/glib/glib.pkg
index 679a3e804..8d82cd95b 100644
--- a/src/glib/glib.pkg
+++ b/src/glib/glib.pkg
@@ -54,7 +54,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (import (runtime generic-i/o-port)
 	  make-generic-i/o-port)
   (import (runtime binary-port)
-	  make-source/sink)
+	  make-binary-port)
   (import (glib main)
 	  maybe-yield-glib)
   (export ()
diff --git a/src/mcrypt/mcrypt.scm b/src/mcrypt/mcrypt.scm
index c091f291f..965cded9f 100644
--- a/src/mcrypt/mcrypt.scm
+++ b/src/mcrypt/mcrypt.scm
@@ -211,7 +211,7 @@ USA.
   (lambda (object)
     (cond ((mcrypt-context? object)
 	   (context-op object))
-	  ((bytevector? object)
+	  ((string? object)
 	   (init!)
 	   (module-op object))
 	  (else
@@ -311,7 +311,7 @@ USA.
 	(let ((context (initialize)))
 	  (let loop ()
 	    (let ((n (read-bytevector! buffer input-port)))
-	      (if (and n (fix:> n 0))
+	      (if (and n (not (eof-object? n)) (fix:> n 0))
 		  (begin
 		    (update context buffer 0 n)
 		    (let ((n* (write-bytevector buffer output-port 0 n)))
diff --git a/src/md5/make.scm b/src/md5/make.scm
index fef938874..ce50d16e2 100644
--- a/src/md5/make.scm
+++ b/src/md5/make.scm
@@ -15,7 +15,4 @@
     (lambda (name)
       (environment-assign! crypto name (environment-lookup md5 name)))
     '(md5-file
-      md5-string
-      md5-substring
-      md5-sum->hexadecimal
-      md5-sum->number)))
\ No newline at end of file
+      md5-string)))
\ No newline at end of file
diff --git a/src/md5/md5.scm b/src/md5/md5.scm
index 199abcdd5..1ec044e5d 100644
--- a/src/md5/md5.scm
+++ b/src/md5/md5.scm
@@ -78,7 +78,7 @@ USA.
 	(let ((context (initialize)))
 	  (let loop ()
 	    (let ((n (read-bytevector! buffer input-port)))
-	      (if (and n (fix:> n 0))
+	      (if (and n (not (eof-object? n)) (fix:> n 0))
 		  (begin
 		    (update context buffer 0 n)
 		    (let ((n* (write-bytevector buffer output-port 0 n)))
diff --git a/src/mhash/make.scm b/src/mhash/make.scm
index d6e478fae..2629a3531 100644
--- a/src/mhash/make.scm
+++ b/src/mhash/make.scm
@@ -32,8 +32,5 @@
       mhash-keygen-uses-hash-algorithm
       mhash-keygen-uses-salt?
       mhash-string
-      mhash-substring
-      mhash-sum->hexadecimal
-      mhash-sum->number
       mhash-type-names
       mhash-update)))
\ No newline at end of file
diff --git a/src/mhash/mhash.scm b/src/mhash/mhash.scm
index d6d959664..fc3fa3fd6 100644
--- a/src/mhash/mhash.scm
+++ b/src/mhash/mhash.scm
@@ -196,10 +196,10 @@ USA.
 
 (define (mhash-update context bytes start end)
   (guarantee-mhash-context context 'mhash-update)
-  (subbytevector bytevector start end 'mhash-update)
+  (guarantee-subbytevector bytes start end 'mhash-update)
   (with-context-locked-open context 'mhash-update
     (lambda (alien)
-      (C-call "do_mhash" alien bytevector start end))))
+      (C-call "do_mhash" alien bytes start end))))
 
 (define (mhash-end context)
   (with-context-locked-open context 'MHASH-END
@@ -280,7 +280,7 @@ USA.
       (error:wrong-type-argument type "mhash type" 'mhash-keygen))
   (let ((keygenid (mhash-keygen-type-id type))
 	(keyword-size (mhash-keygen-type-key-length type))
-	(keyword (string->utf8 passphrase)))
+	(passbytes (string->utf8 passphrase)))
     (let ((params (salted-keygen-params
 		   keygenid (mhash-keygen-type-parameter-vector type) salt))
 	  (keyword (make-bytevector keyword-size))
@@ -470,7 +470,7 @@ USA.
 	(let ((context (initialize)))
 	  (let loop ()
 	    (let ((n (read-bytevector! buffer input-port)))
-	      (if (and n (fix:> n 0))
+	      (if (and n (not (eof-object? n)) (fix:> n 0))
 		  (begin
 		    (update context buffer 0 n)
 		    (let ((n* (write-bytevector buffer output-port 0 n)))
diff --git a/src/runtime/make.scm b/src/runtime/make.scm
index f7b52cee2..07c3e69b0 100644
--- a/src/runtime/make.scm
+++ b/src/runtime/make.scm
@@ -470,7 +470,6 @@ USA.
    (RUNTIME MEMOIZER)
    (RUNTIME UCD-TABLES)
    (RUNTIME UCD-GLUE)
-   (RUNTIME BLOWFISH)
    (RUNTIME PREDICATE-METADATA)
    (RUNTIME PREDICATE-LATTICE)
    (RUNTIME PREDICATE-TAGGING)