From 0000000000000000000000000000000000000000 Mon Sep 17 00:00:00 2001
From: Camm Maguire <camm@debian.org>
Date: Apr, 21 2026 12:11:46 +0000
Subject: [PATCH] <short summary of the patch>

TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

---
The information above should follow the Patch Tagging Guidelines, please
checkout https://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: (upstream|backport|vendor|other), (<patch-url>|commit:<commit-id>)
Bug: <upstream-bugtracker-url>
Bug-<Vendor>: <vendor-bugtracker-url>
Forwarded: (no|not-needed|<patch-forwarded-url>)
Applied-Upstream: <version>, (<commit-url>|commit:<commid-id>)
Reviewed-By: <name and email of someone who approved/reviewed the patch>

--- gcl27-2.7.1.orig/ansi-tests/read-byte.lsp
+++ gcl27-2.7.1/ansi-tests/read-byte.lsp
@@ -79,6 +79,22 @@
 	collect (list i b1 b2))
   nil)
 
+(deftest read-byte.5
+  (let ((s (open "foo.txt"
+		 :direction :output
+		 :if-exists :supersede
+		 :element-type '(unsigned-byte 8))))
+    (values
+     (write-byte 255 s)
+     (close s)
+     (progn
+       (setq s (open "foo.txt"
+		     :direction :input
+		     :element-type '(signed-byte 8)))
+       (read-byte s))
+     (close s)))
+  255 t -1 t)
+
 ;;; Error tests
 
 (deftest read-byte.error.1
--- gcl27-2.7.1.orig/ansi-tests/read-sequence.lsp
+++ gcl27-2.7.1/ansi-tests/read-sequence.lsp
@@ -171,6 +171,12 @@
   (make-array 10 :initial-element nil :fill-pointer 5)
   (:end nil) "abcdefghijk" 5 #(#\a #\b #\c #\d #\e))
 
+;; Fast read-sequence
+
+(def-read-sequence-test read-sequence.fast-char.1
+  (make-array 5 :element-type 'character)
+  (:end nil) "abcdefghijk" 5 "abcde")
+
 ;;; Nil vectors
 
 (deftest read-sequence.nil-vector.1
@@ -231,6 +237,63 @@
 (def-read-sequence-bv-test read-sequence.bv.7 #*00000000000000 (:end 6)
   6 #*01100100000000)
 
+;; Fast read-sequence -> fread cases
+
+(defmacro def-read-sequence-fread-test (name seql tp data args &rest expected)
+  `(deftest ,name
+     ;; Create output file
+     (progn
+       (let (os)
+	 (unwind-protect
+	     (progn
+	       (setq os (open "temp.dat" :direction :output
+			      :element-type ',tp
+			      :if-exists :supersede))
+	       (loop for i in (coerce ,data 'list)
+		     do (if (eq ',tp 'character) (write-char i os) (write-byte i os))))
+	   (when os (close os))))
+       (let (is (seq (make-array ,seql :element-type ',tp)))
+	 (unwind-protect
+	     (progn
+	       (setq is (open "temp.dat" :direction :input
+			      :element-type ',tp))
+	       (values
+		(read-sequence seq is ,@args)
+		seq))
+	   (when is (close is)))))
+     ,@expected))
+
+(def-read-sequence-fread-test
+    read-sequence.fread.1 20
+  character "abcdefghijk" ()
+  11 "abcdefghijk         ")
+
+(def-read-sequence-fread-test
+    read-sequence.fread.2 20
+  character "abcdefghijk" (:start 1)
+  12 " abcdefghijk        ")
+
+(def-read-sequence-fread-test
+    read-sequence.fread.3 20
+  character "abcdefghijk" (:start 1 :end 3)
+  3 " ab                 ")
+
+(def-read-sequence-fread-test
+    read-sequence.fread.4 20
+  character "abcdefghijk" (:end 3)
+  3 "abc                 ")
+
+(def-read-sequence-fread-test
+    read-sequence.fread.5 20
+  fixnum #(1 2 3 4 5 6 7 8 9 10 11)  (:end 3)
+  3 #(1 2 3 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
+
+(def-read-sequence-fread-test
+    read-sequence.fread.6 20
+  (unsigned-byte 16) #(1 2 3 4 5 6 7 8 9 10 11)  (:start 2 :end 6)
+  6 #(0 0 1 2 3 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0))
+
+
 ;;; Error cases
 
 (deftest read-sequence.error.1
--- gcl27-2.7.1.orig/ansi-tests/write-sequence.lsp
+++ gcl27-2.7.1/ansi-tests/write-sequence.lsp
@@ -115,19 +115,19 @@
 
 (defmacro def-write-sequence-bv-test (name input args expected)
   `(deftest ,name
-     (let ((s ,input)
-	   (expected ,expected))
-       (with-open-file
-	(os "tmp.dat" :direction :output
-	    :element-type '(unsigned-byte 8)
-	    :if-exists :supersede)
-	 (assert (eq (write-sequence s os ,@args) s)))
-       (with-open-file
-	(is "tmp.dat" :direction :input
-	    :element-type '(unsigned-byte 8))
-	 (loop for i from 0 below (length expected)
-	       for e = (elt expected i)
-	       always (eql (read-byte is) e))))
+       (let ((s ,input)
+	     (expected ,expected))
+	 (with-open-file
+	     (os "tmp.dat" :direction :output
+		 :element-type '(unsigned-byte 8)
+		 :if-exists :supersede)
+	   (assert (eq (write-sequence s os ,@args) s)))
+	 (with-open-file
+	     (is "tmp.dat" :direction :input
+		 :element-type '(unsigned-byte 8))
+	   (loop for i from 0 below (length expected)
+		 for e = (elt expected i)
+		 always (eql (read-byte is) e))))
      t))
 
 (def-write-sequence-bv-test write-sequence.bv.1 #*00111010
@@ -143,6 +143,43 @@
 (def-write-sequence-bv-test write-sequence.bv.6 #*00111010
   (:start 1 :end nil :end 4) #*0111010)
 
+(defmacro def-write-sequence-tp-test (name tp input args expected)
+  `(deftest ,name
+       (let ((s (coerce ',input `(vector ,',tp)))
+	     (expected ',expected))
+	 (with-open-file
+	     (os "tmp.dat" :direction :output
+		 :element-type ',tp
+		 :if-exists :supersede)
+	   (assert (eq (write-sequence s os ,@args) s)))
+	 (with-open-file
+	     (is "tmp.dat" :direction :input
+		 :element-type ',tp)
+		 (loop for i from 0 below (length expected)
+		       for e = (elt expected i)
+		       always (eql (if (eq ',tp 'character) (read-char is) (read-byte is)) e))))
+     t))
+
+(def-write-sequence-tp-test write-sequence.tp.1 (unsigned-byte 8)
+  (1 2 3 4 5 6 7 8 9 10) () (1 2 3 4 5 6 7 8 9 10))
+(def-write-sequence-tp-test write-sequence.tp.2 (unsigned-byte 16)
+  (1 2 3 4 5 6 7 8 9 10) () (1 2 3 4 5 6 7 8 9 10))
+(def-write-sequence-tp-test write-sequence.tp.3 (signed-byte 32)
+  (1 2 3 4 5 6 7 8 9 10) () (1 2 3 4 5 6 7 8 9 10))
+(def-write-sequence-tp-test write-sequence.tp.4 (signed-byte 64)
+  (1 2 3 4 5 6 7 8 9 10) () (1 2 3 4 5 6 7 8 9 10))
+(def-write-sequence-tp-test write-sequence.tp.5 (unsigned-byte 128)
+  (1 2 3 4 5 6 7 8 9 10) () (1 2 3 4 5 6 7 8 9 10))
+(def-write-sequence-tp-test write-sequence.tp.6 character
+  (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\1) () (#\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\1))
+(def-write-sequence-tp-test write-sequence.tp.7 (unsigned-byte 16)
+  (1 2 3 4 5 6 7 8 9 10) (:start 1) (2 3 4 5 6 7 8 9 10))
+(def-write-sequence-tp-test write-sequence.tp.8 (unsigned-byte 16)
+  (1 2 3 4 5 6 7 8 9 10) (:end 4) (1 2 3))
+(def-write-sequence-tp-test write-sequence.tp.9 (unsigned-byte 16)
+  (1 2 3 4 5 6 7 8 9 10) (:start 1 :end 4) (2 3))
+(def-write-sequence-tp-test write-sequence.tp.10 (unsigned-byte 16)
+  (1 2 3 4 5 6 7 8 9 10) (:start 1 :end nil :end 4) (2 3 4 5 6 7 8 9 10))
 
 ;;; Error tests
 
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpcall.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpcall.lsp
@@ -483,18 +483,16 @@
 
 (defun stub-decl (name args d &optional vp
 		  &aux (i 0))
-  (concatenate
-   'string
+  (ms
    "static " d " " name ;" LnkT" num
    "("
-   (apply 'concatenate 'string
-	  (mapcan (lambda (x)
-		    (if (eq x '*)
-			(list ",...")
-			(list (if (plusp i) ","  "")
-			      (rep-type x)
-			      (progn (incf i) (if vp (concatenate 'string "x" (write-to-string i)) "")))))
-		  (if (eq (car args) '*) (cons t args) args)))
+   (mapcan (lambda (x)
+	     (if (eq x '*)
+		 (list ",...")
+		 (list (if (plusp i) ","  "")
+		       (rep-type x)
+		       (progn (incf i) (if vp (list "x" (write-to-string i)) "")))))
+	   (if (eq (car args) '*) (cons t args) args))
    ")"))
 
 
@@ -503,8 +501,7 @@
 	       (i (max n (- (length args) n)));FIXME
 	       (si (write-to-string i))
 	       (d (declaration-type (rep-type (if (link-arg-p type) type t)))))
-  (concatenate
-   'string
+  (ms
    (stub-decl (concatenate 'string "LnkT" num) args d t)
    "{
       int nargs=" (if va "fcall.argd<0 ? -fcall.argd : fcall.argd" si) ";
@@ -512,14 +509,12 @@
       "
 
    (let ((j 0))
-     (apply 'concatenate 'string
-	    (mapcan (lambda (x &aux (sj (write-to-string (incf j))))
-		      (declare (ignore x))
-		      (list "FOO[" sj "-1]=(object)x" sj ";"))
-		    (make-list i))))
+     (mapcan (lambda (x &aux (sj (write-to-string (incf j))))
+	       (declare (ignore x))
+	       (list "FOO[" sj "-1]=(object)x" sj ";"))
+	     (make-list i)))
    (when va
-     (concatenate
-      'string
+     (list
       "
       {
           va_list ap;
@@ -539,6 +534,7 @@
    "FOO);
 }"))
 
+
 (defun wt-function-link (x)
   (let* ((name (pop x))
 	 (num (pop x))
--- gcl27-2.7.1.orig/cmpnew/gcl_cmpfun.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmpfun.lsp
@@ -427,7 +427,6 @@
 
 ;(si::putprop 'read-byte 'co1read-byte 'co1)
 #-cygwin(si::putprop 'read-char 'co1read-char 'co1)
-(si::putprop 'write-byte 'co1write-byte 'co1)
 (si::putprop 'write-char 'co1write-char 'co1)
 
 (defun fast-read (args read-fun)
@@ -483,15 +482,6 @@
 	     (declare (type ,(result-type stream) ,str))
 	     ,(cfast-write (list (car args) str) write-fun tp)))))))
 
-
-(defun co1write-byte (f args)
-  (declare (ignore f))
-  (let ((tem (cfast-write args 'write-byte 'fixnum)))
-    (when tem 
-      (let ((*space* 10))
-	(c1expr tem)))))
-
-
 (defun co1write-char (f args)
   (declare (ignore f))
   (let* ((tem (cfast-write args 'write-char 'character)))
--- gcl27-2.7.1.orig/cmpnew/gcl_cmptop.lsp
+++ gcl27-2.7.1/cmpnew/gcl_cmptop.lsp
@@ -844,7 +844,7 @@
 			  (cond (f (setq inl (lit-string-merge inl (fourth f) i lna (1- lff)))
 				   (setq lev (min lev 1));FIXME?
 ;				   (when (> lev (seventh f)) (setq lev (seventh f))); (break)
-				   (incf i lff)(copy-list ff));FIXME?
+				   (incf i lff)(incf lna (1- lff))(copy-list ff));FIXME?
 				((incf i)(list x))))
 			nargs))
 	 (form (list 'lit info key inl nargs nil lev oargs nil (make-vs info))))
--- gcl27-2.7.1.orig/git.tag
+++ gcl27-2.7.1/git.tag
@@ -1 +1 @@
-"Version_2_7_2pre15"
+"Version_2_7_2pre16"
--- gcl27-2.7.1.orig/lsp/gcl_iolib.lsp
+++ gcl27-2.7.1/lsp/gcl_iolib.lsp
@@ -347,18 +347,41 @@
      ))
 
 
-(defun restrict-stream-element-type (tp)
-  (cond ((member tp '(unsigned-byte signed-byte)) tp)
-	((or (member tp '(character :default)) (subtypep tp 'character)) 'character)
+(defun encapsulate-stream-element-type (tp)
+  (cond ((subtypep tp 'character) 'character)
 	((subtypep tp 'integer)
 	 (let* ((ntp (tp-bnds (cmp-norm-tp tp)))
 		(min (car ntp))(max (cdr ntp))
 		(s (if (or (eq min '*) (< min 0)) 'signed-byte 'unsigned-byte))
 		(lim (unless (or (eq min '*) (eq max '*)) (max (integer-length min) (integer-length max))))
 		(lim (if (and lim (eq s 'signed-byte)) (1+ lim) lim)))
-	   (if lim `(,s ,lim) s)))
+	   (if lim `(,s ,lim) s)))))
+
+(defconstant +array-stream-types+ (coerce (mapcar 'encapsulate-stream-element-type +array-types+) '(vector t)))
+
+(defun restrict-stream-element-type (tp &aux etp);standardize....
+  (cond ((member tp '(:default character)) 'character)
+	((eq tp 'unsigned-byte) '(unsigned-byte 8))
+	((eq tp 'signed-byte) '(signed-byte 8))
+	((typep tp '(cons (member unsigned-byte signed-byte) (cons (integer 0) null)))
+	 (let ((tp (list (car tp) (* char-length (ceiling (cadr tp) char-length)))))
+	   (or (find tp +array-stream-types+ :test 'equal) tp)))
+	((subtypep tp 'character) 'character)
+	((setq etp (encapsulate-stream-element-type tp))
+	 (restrict-stream-element-type etp))
 	((check-type tp (member character integer)))))
 
+(defun stream-fp (strm outp)
+  (when (open-stream-p strm)
+    (typecase strm
+      (file-synonym-stream (stream-fp (symbol-value (synonym-stream-symbol strm)) outp))
+      (two-way-stream (stream-fp
+		       (if outp (two-way-stream-output-stream strm) (two-way-stream-input-stream strm))
+		       outp))
+      (file-io-stream (c-stream-fp strm))
+      (file-input-stream (unless outp (c-stream-fp strm)))
+      (file-output-stream (when outp (c-stream-fp strm))))))
+
 (defun load-pathname-exists (z)
   (or (probe-file z)
       (when *allow-gzipped-file*
@@ -417,54 +440,110 @@
   (declare (optimize (safety 1)))
   (parse-integer-int s start end radix junk-allowed))
 
-(defun write-byte (j s &aux (i j))
+(defun stream-element-type (s)
   (declare (optimize (safety 1)))
-  (check-type j integer)
-  (check-type s stream)
-  (dotimes (k (get-byte-stream-nchars s) j)
-    (write-char (code-char (logand i #.(1- (ash 1 char-length)))) s)
-    (setq i (ash i #.(- char-length)))))
+  (check-type s stream);etypecase
+  (typecase s
+    ((or broadcast-stream concatenated-stream)
+     (let ((o (c-stream-object0 s)))
+       (when o (stream-element-type (car o)))))
+    ((or two-way-stream echo-stream)
+     (stream-element-type (c-stream-object0 s)))
+    (synonym-stream
+     (stream-element-type (symbol-value (c-stream-object0 s))))
+    (file-stream;define socket
+     (c-stream-object0 s))
+    (t 'character)))
 
+(deftype binary-stream-element-type nil 'list)
+(defconstant +char-shft+ (1- (integer-length char-length)))
 
-(defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0))
+(defun read-byte (s &optional (eof-error-p t) eof-value &aux (i 0)(tp (stream-element-type s)))
   (declare (optimize (safety 1)))
   (check-type s stream)
-  (dotimes (k (get-byte-stream-nchars s) i)
-    (setq i (logior i (ash (let ((ch (read-char s eof-error-p eof-value)))
-			     (if (eq ch eof-value) (return ch) (char-code ch)))
-			   (* k char-length))))))
+  (check-type tp binary-stream-element-type)
+  (let* ((n (if tp (ash (cadr tp) (- +char-shft+)) 1)))
+    (dotimes (k n (let ((nb (ash n +char-shft+)))
+		  (if (when (eq (car tp) 'signed-byte) (logbitp (1- nb) i)) (- i (ash 1 nb)) i)))
+      (setq i (logior i (ash (let ((ch (read-char s eof-error-p eof-value)))
+			       (if (eq ch eof-value) (return ch) (char-code ch)))
+			     (ash k +char-shft+)))))))
+
+(defun write-byte (j s &aux (i j) (tp (stream-element-type s)))
+  (declare (optimize (safety 1)))
+  (check-type j integer)
+  (check-type tp binary-stream-element-type)
+  (let ((n (ash (cadr tp) (- +char-shft+))))
+    (dotimes (k n j)
+      (write-char (code-char (logand i #.(1- (ash 1 char-length)))) s)
+      (setq i (ash i #.(- char-length))))))
+
+#-pre-gcl
+(defdlfun (:fixnum "fread") :fixnum :fixnum :fixnum :fixnum)
+
+(defun read-sequence-using-fread (seq strm tp start end &aux (fp (stream-fp strm nil)))
+  #+pre-gcl
+  (declare (ignore seq tp start end fp))
+  #-pre-gcl
+  (when fp
+    (when (eq tp (aref +array-stream-types+ (c-array-elttype seq)))
+      (let* ((n (ash 1 (1- (c-array-eltsize seq))))(ln (length seq))(end (or end ln)))
+	(when (<= start end ln)
+	  (c+ start
+	      (|libc|:|fread|
+		     (c+ (c-array-self seq) (c* n start)) n (c- end start) fp)))))))
+
+
 
 
 (defun read-sequence (seq strm &key (start 0) end
 		      &aux (l (listp seq))(seqp (when l (nthcdr start seq)))
-			(cp (eq (stream-element-type strm) 'character)))
+			(tp (stream-element-type strm)))
   (declare (optimize (safety 1)));FIXME
   (check-type seq sequence)
   (check-type strm stream)
-  (check-type start (integer 0))
-  (check-type end (or null (integer 0)))
-  (labels ((set-cons (x z) (check-type x cons) (setf (car x) z) (cdr x)))
-    (the seqbnd
-	 (reduce (lambda (y x &aux (z (if cp (read-char strm nil 'eof) (read-byte strm nil 'eof))))
-		   (declare (seqind y)(ignorable x))
-		   (when (eq z 'eof) (return-from read-sequence y))
-		   (if l (setq seqp (set-cons seqp z)) (setf (aref seq y) z))
-		   (1+ y))
-		 seq :initial-value start :start start :end end))))
+  (check-type start seqind)
+  (check-type end (or null seqind))
+  (the seqbnd
+       (or (unless l (read-sequence-using-fread seq strm tp start end))
+	   (labels ((set-cons (x z) (check-type x cons) (setf (car x) z) (cdr x))
+		    (mread nil (if (eq tp 'character) (read-char strm nil 'eof) (read-byte strm nil 'eof))))
+	     (reduce (lambda (y x &aux (z (mread)))
+		       (declare (seqind y)(ignorable x))
+		       (when (eq z 'eof) (return-from read-sequence y))
+		       (if l (setq seqp (set-cons seqp z)) (setf (aref seq y) z))
+		       (1+ y))
+		     seq :initial-value start :start start :end end)))))
+
+#-pre-gcl
+(defdlfun (:fixnum "fwrite") :fixnum :fixnum :fixnum :fixnum)
+
+(defun write-sequence-using-fwrite (seq strm tp start end &aux (fp (stream-fp strm t)))
+  #+pre-gcl
+  (declare (ignore seq tp start end fp))
+  #-pre-gcl
+  (when fp
+    (when (eq tp (aref +array-stream-types+ (c-array-elttype seq)))
+      (let* ((n (ash 1 (1- (c-array-eltsize seq))))(ln (length seq))(end (or end ln)))
+	(when (<= start end ln)
+	  (c+ start
+	      (|libc|:|fwrite|
+		     (c+ (c-array-self seq) (c* n start)) n (c- end start) fp)))))))
 
 
 (defun write-sequence (seq strm &key (start 0) end
-			   &aux (cp (eq (stream-element-type strm) 'character)))
+		       &aux (tp (stream-element-type strm)))
   (declare (optimize (safety 1)))
   (check-type seq sequence)
   (check-type strm stream)
   (check-type start (integer 0))
   (check-type end (or null (integer 0)))
-  (reduce (lambda (y x)
-		   (declare (seqind y))
-		   (if cp (write-char x strm) (write-byte x strm))
-		   (1+ y))
-	 seq :initial-value start :start start :end end)
+  (or (unless (listp seq) (write-sequence-using-fwrite seq strm tp start end))
+      (reduce (lambda (y x)
+		(declare (seqind y))
+		(if (eq tp 'character) (write-char x strm) (write-byte x strm))
+		(1+ y))
+	      seq :initial-value start :start start :end end))
   seq)
 
 (defun open (f &key (direction :input)
@@ -481,6 +560,11 @@
 		      if-exists iesp if-does-not-exist idnesp external-format)))
     (when (typep s 'stream) (c-set-stream-object1 s pf) s)))
 
+(defun open-stream-p (strm)
+  (declare (optimize (safety 1)))
+  (check-type strm stream)
+  (not (logbitp #.(let ((s (open "/dev/null")))(close s) (1- (integer-length (c-stream-flags s))))
+		(c-stream-flags strm))))
 
 (defun file-length (x)
   (declare (optimize (safety 1)))
--- gcl27-2.7.1.orig/o/error.c
+++ gcl27-2.7.1/o/error.c
@@ -400,9 +400,9 @@ void
 check_arg_failed(int n)
 {
   if (n<vs_top-vs_base)
-    FEtoo_few_arguments(vs_base,vs_top);
-  else
     FEtoo_many_arguments(vs_base,vs_top);
+  else
+    FEtoo_few_arguments(vs_base,vs_top);
 }
 
 void
--- gcl27-2.7.1.orig/o/file.d
+++ gcl27-2.7.1/o/file.d
@@ -301,59 +301,6 @@ BEGIN:
 	}
 }
 
-static object
-stream_element_type(object strm) {
-
-	object x;
-
-BEGIN:
-	switch (strm->sm.sm_mode) {
-	case smm_input:
-	case smm_output:
-	case smm_io: 
-	case smm_probe:
-		return(strm->sm.sm_object0);
-
-	case smm_socket:
-	    return (sLcharacter);
-	    
-	case smm_file_synonym:
-	case smm_synonym:
-		strm = symbol_value(strm->sm.sm_object0);
-		if (type_of(strm) != t_stream)
-			FEwrong_type_argument(sLstream, strm);
-		goto BEGIN;
-
-	case smm_broadcast:
-		x = strm->sm.sm_object0;
-		if (endp(x))
-			return(Ct);
-		return(stream_element_type(x->c.c_car));
-
-	case smm_concatenated:
-		x = strm->sm.sm_object0;
-		if (endp(x))
-			return(Ct);
-		return(stream_element_type(x->c.c_car));
-
-	case smm_two_way:
-		return(stream_element_type(STREAM_INPUT_STREAM(strm)));
-
-	case smm_echo:
-		return(stream_element_type(STREAM_INPUT_STREAM(strm)));
-
-	case smm_string_input:
-		return(sLcharacter);
-
-	case smm_string_output:
-		return(sLcharacter);
-
-	default:
-		FEerror("Illegal stream mode for ~S.",1,strm);
-		return(FALSE);
-	}
-}
-
 void
 setup_stream_buffer(object x) {
 #ifdef NO_SETBUF
@@ -1972,14 +1919,6 @@ LFD(Loutput_stream_p)()
 		vs_base[0] = Cnil;
 }
 
-LFD(Lstream_element_type)()
-{
-	check_arg(1);
-
-	check_type_stream(&vs_base[0]);
-	vs_base[0] = stream_element_type(vs_base[0]);
-}
-
 @(defun close (strm &key abort)
 @
 	check_type_stream(&strm);
@@ -2856,7 +2795,6 @@ gcl_init_file_function()
 	make_function("STREAMP", Lstreamp);
 	make_function("INPUT-STREAM-P", Linput_stream_p);
 	make_function("OUTPUT-STREAM-P", Loutput_stream_p);
-	make_function("STREAM-ELEMENT-TYPE", Lstream_element_type);
 	make_function("CLOSE", Lclose);
 
 /* 	make_si_function("OPEN1", Lopen1); */
