clisp-cvs digest, Vol 1 #542 - 1 msg

[<cli...@li...>]

Send clisp-cvs mailing list submissions to
	cli...@li...

To subscribe or unsubscribe via the World Wide Web, visit
	https://lists.sourceforge.net/lists/listinfo/clisp-cvs
or, via email, send a message with subject or body 'help' to
	cli...@li...

You can reach the person managing the list at
	cli...@li...

When replying, please edit your Subject line so it is more specific
than "Re: Contents of clisp-cvs digest..."


CLISP CVS commits for today

Today's Topics:

   1. clisp/src stream.d,1.437,1.438 sequence.d,1.77,1.78 lispbibl.d,1.511,1.512 io.d,1.229,1.230 error.d,1.110,1.111 debug.d,1.70,1.71 constsym.d,1.244,1.245 ChangeLog,1.3123,1.3124 (Sam Steingold)

--__--__--

Message: 1
From: Sam Steingold <sd...@us...>
To: cli...@li...
Subject: clisp/src stream.d,1.437,1.438 sequence.d,1.77,1.78 lispbibl.d,1.511,1.512 io.d,1.229,1.230 error.d,1.110,1.111 debug.d,1.70,1.71 constsym.d,1.244,1.245 ChangeLog,1.3123,1.3124
Date: Wed, 02 Jun 2004 21:32:37 +0000
Reply-To: cli...@li...

Update of /cvsroot/clisp/clisp/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30235/src

Modified Files:
	stream.d sequence.d lispbibl.d io.d error.d debug.d constsym.d 
	ChangeLog 
Log Message:
more consistent macro/function naming, more error recovery


Index: stream.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/stream.d,v
retrieving revision 1.437
retrieving revision 1.438
diff -u -d -r1.437 -r1.438
--- stream.d	26 May 2004 01:54:39 -0000	1.437
+++ stream.d	2 Jun 2004 21:32:30 -0000	1.438
@@ -941,28 +941,40 @@
   fehler(stream_error,GETTEXT("integer ~S is out of range, cannot be output onto ~S"));
 }
 
-# barf if the object is not a stream
-#define check_stream(obj) \
-  (streamp(obj) ? (object)(obj) : (fehler_stream(obj),unbound))
-# barf if the object is not a stream of the specific type
-#define check_streamtype(obj,type)                                        \
-  if (!streamp(obj)) fehler_stream(obj); else fehler_streamtype(obj,type)
-# barf if the object is not a built-in stream
-#define check_builtin_stream(obj)                               \
-  (builtin_stream_p(obj) ? (obj)                                \
-   : (fehler_streamtype(obj,O(type_builtin_stream)), unbound))
-# barf of the object is not an integer
-#define check_wr_int(stream,obj)                                \
-  (integerp(obj)?(object)(obj):(fehler_write(stream,obj,S(integer)),unbound))
+/* Error message and get a replacement for an argument
+   which isn't a stream of the requested stream-type:
+ get_streamtype_replacement(obj,type);
+ > obj: the faulty argument
+ > type: requested stream-type
+ can trigger GC */
+local object get_streamtype_replacement (object obj, object type) {
+  pushSTACK(NIL);  /* no PLACE */
+  pushSTACK(obj);  /* TYPE-ERROR slot DATUM */
+  pushSTACK(type); /* TYPE-ERROR slot EXPECTED-TYPE */
+  pushSTACK(type); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name);
+  check_value(type_error,GETTEXT("~S: argument ~S is not a stream of type ~S"));
+  return value1;
+}
 
-# UP: checks, if Arguments are Streams.
-# test_stream_args(args_pointer,argcount);
-# > args_pointer: Pointer to the Arguments
-# > argcount: number of Arguments
-local void test_stream_args (gcv_object_t* args_pointer, uintC argcount) {
+/* barf if the object is not a stream of the specific type */
+#define CHECK_streamtype(obj,type,test)                         \
+  while(!(test)) obj = get_streamtype_replacement(obj,type)
+/* barf if the object is not a built-in stream */
+#define CHECK_builtin_stream(obj)                               \
+  CHECK_streamtype(obj,O(type_builtin_stream),(builtin_stream_p(obj)))
+/* barf of the object is not an integer */
+#define ASSERT_wr_int(stream,obj)                               \
+  if (!integerp(obj)) fehler_write(stream,obj,S(integer))
+
+/* UP: checks, if Arguments are Streams.
+ check_stream_args(args_pointer,argcount);
+ > args_pointer: Pointer to the Arguments
+ > argcount: number of Arguments
+ can trigger GC */
+local void check_stream_args (gcv_object_t* args_pointer, uintC argcount) {
   while (argcount--) {
-    var object next_arg = NEXT(args_pointer);
-    check_stream(next_arg);
+    var gcv_object_t *next_arg_ptr = &NEXT(args_pointer);
+    *next_arg_ptr = check_stream(*next_arg_ptr);
   };
 }
 
@@ -1311,10 +1323,9 @@
 LISPFUNNR(synonym_stream_symbol,1)
 { /* (SYNONYM-STREAM-SYMBOL stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!(builtin_stream_p(stream)
-        && (TheStream(stream)->strmtype == strmtype_synonym))) {
-    check_streamtype(stream,S(synonym_stream));
-  }
+  CHECK_streamtype(stream,S(synonym_stream),
+                   (builtin_stream_p(stream)
+                    && (TheStream(stream)->strmtype == strmtype_synonym)));
   VALUES1(TheStream(stream)->strm_synonym_symbol);
 }
 
@@ -1496,10 +1507,9 @@
 LISPFUNNR(broadcast_stream_streams,1)
 { /* (BROADCAST-STREAM-STREAMS stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!(builtin_stream_p(stream)
-        && (TheStream(stream)->strmtype == strmtype_broad))) {
-    check_streamtype(stream,S(broadcast_stream));
-  }
+  CHECK_streamtype(stream,S(broadcast_stream),
+                   (builtin_stream_p(stream)
+                    && (TheStream(stream)->strmtype == strmtype_broad)));
   # copy List of Streams as a precaution
   VALUES1(copy_list(TheStream(stream)->strm_broad_list));
 }
@@ -1747,10 +1757,9 @@
 LISPFUNNR(concatenated_stream_streams,1)
 { /* (CONCATENATED-STREAM-STREAMS stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!(builtin_stream_p(stream)
-        && (TheStream(stream)->strmtype == strmtype_concat))) {
-    check_streamtype(stream,S(concatenated_stream));
-  }
+  CHECK_streamtype(stream,S(concatenated_stream),
+                   (builtin_stream_p(stream)
+                    && (TheStream(stream)->strmtype == strmtype_concat)));
   # copy List of Streams as a precaution
   VALUES1(copy_list(TheStream(stream)->strm_concat_list));
 }
@@ -1958,7 +1967,7 @@
 LISPFUNNR(make_two_way_stream,2)
 { /* (MAKE-TWO-WAY-STREAM input-stream output-stream), CLTL p. 329 */
   # check that both are Streams:
-  test_stream_args(args_end_pointer STACKop 2, 2);
+  check_stream_args(args_end_pointer STACKop 2, 2);
   var object output_stream = popSTACK();
   var object input_stream = popSTACK();
   test_input_stream(input_stream);
@@ -1980,16 +1989,14 @@
 LISPFUNNR(two_way_stream_input_stream,1)
 { /* (TWO-WAY-STREAM-INPUT-STREAM stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!stream_twoway_p(stream))
-    check_streamtype(stream,S(two_way_stream));
+  CHECK_streamtype(stream,S(two_way_stream),stream_twoway_p(stream));
   VALUES1(TheStream(stream)->strm_twoway_input);
 }
 
 LISPFUNNR(two_way_stream_output_stream,1)
 { /* (TWO-WAY-STREAM-OUTPUT-STREAM stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!stream_twoway_p(stream))
-    check_streamtype(stream,S(two_way_stream));
+  CHECK_streamtype(stream,S(two_way_stream),stream_twoway_p(stream));
   VALUES1(TheStream(stream)->strm_twoway_output);
 }
 
@@ -2085,7 +2092,7 @@
 LISPFUNNR(make_echo_stream,2)
 { /* (MAKE-ECHO-STREAM input-stream output-stream), CLTL p. 330 */
   # check that both are Streams:
-  test_stream_args(args_end_pointer STACKop 2, 2);
+  check_stream_args(args_end_pointer STACKop 2, 2);
   var object output_stream = popSTACK();
   var object input_stream = popSTACK();
   test_input_stream(input_stream);
@@ -2107,16 +2114,14 @@
 LISPFUNNR(echo_stream_input_stream,1)
 { /* (ECHO-STREAM-INPUT-STREAM stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!stream_echo_p(stream))
-    check_streamtype(stream,S(echo_stream));
+  CHECK_streamtype(stream,S(echo_stream),stream_echo_p(stream));
   VALUES1(TheStream(stream)->strm_twoway_input);
 }
 
 LISPFUNNR(echo_stream_output_stream,1)
 { /* (ECHO-STREAM-OUTPUT-STREAM stream), CLtL2 p. 507 */
   var object stream = popSTACK();
-  if (!stream_echo_p(stream))
-    check_streamtype(stream,S(echo_stream));
+  CHECK_streamtype(stream,S(echo_stream),stream_echo_p(stream));
   VALUES1(TheStream(stream)->strm_twoway_output);
 }
 
@@ -2933,17 +2938,10 @@
 
 LISPFUNN(generic_stream_controller,1) {
   var object stream = popSTACK();
-  if (!(builtin_stream_p(stream)
-        && eq(TheStream(stream)->strm_rd_by,P(rd_by_generic))
-        && eq(TheStream(stream)->strm_wr_by,P(wr_by_generic)))) {
-    if (!streamp(stream)) {
-      fehler_stream(stream);
-    } else {
-      pushSTACK(stream);
-      pushSTACK(TheSubr(subr_self)->name);
-      fehler(error,GETTEXT("~S: stream must be a generic-stream, not ~S"));
-    }
-  }
+  CHECK_streamtype(stream,S(generic_stream),
+                   (builtin_stream_p(stream)
+                    && eq(TheStream(stream)->strm_rd_by,P(rd_by_generic))
+                    && eq(TheStream(stream)->strm_wr_by,P(wr_by_generic))));
   VALUES1(TheStream(stream)->strm_controller_object);
 }
 
@@ -2966,8 +2964,7 @@
 }
 
 LISPFUNN(generic_stream_p,1) {
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   VALUES_IF(builtin_stream_p(stream)
             && eq(TheStream(stream)->strm_rd_by,P(rd_by_generic))
             && eq(TheStream(stream)->strm_wr_by,P(wr_by_generic)));
@@ -4299,7 +4296,7 @@
 
 local void bitbuff_ixu_sub (object stream, object bitbuffer,
                             uintL bitsize, uintL bytesize, object obj) {
-  check_wr_int(stream,obj);
+  ASSERT_wr_int(stream,obj);
   if (!positivep(obj))
     fehler_bad_integer(stream,obj);
   # obj is an integer >=0
@@ -4377,7 +4374,7 @@
 
 local void bitbuff_ixs_sub (object stream, object bitbuffer,
                             uintL bitsize, uintL bytesize, object obj) {
-  check_wr_int(stream,obj);
+  ASSERT_wr_int(stream,obj);
   # obj is an integer
   # transfer obj into the bitbuffer:
   {
@@ -5302,7 +5299,7 @@
 
 # WRITE-BYTE - Pseudo-Function for Handle-Streams, Type au, bitsize = 8 :
 local void wr_by_iau8_unbuffered (object stream, object obj) {
-  check_wr_int(stream,obj);
+  ASSERT_wr_int(stream,obj);
   if (!(posfixnump(obj) && (posfixnum_to_L(obj) < bit(8))))
     fehler_bad_integer(stream,obj);
   UnbufferedStreamLow_write(stream)(stream,(uintB)posfixnum_to_L(obj));
@@ -7172,7 +7169,7 @@
 
 # WRITE-BYTE - Pseudo-Function for File-Streams of Integers, Type au, bitsize = 8 :
 local void wr_by_iau8_buffered (object stream, object obj) {
-  check_wr_int(stream,obj);
+  ASSERT_wr_int(stream,obj);
   if (!(posfixnump(obj) && (posfixnum_to_L(obj) < bit(8))))
     fehler_bad_integer(stream,obj);
   write_byte_buffered(stream,(uintB)posfixnum_to_L(obj));
@@ -9757,8 +9754,7 @@
 LISPFUN(terminal_raw,seclass_default,2,1,norest,nokey,0,NIL) {
   var object errorp = popSTACK();
   var object flag = popSTACK();
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   stream = resolve_synonym_stream(stream);
   value1 = NIL;
   if (builtin_stream_p(stream)
@@ -13271,24 +13267,17 @@
 # Destination:
 #   stream: Handle- or Socket-Stream
 
-# Argument-Checks:
-# Returns the Index in *index_, the count in *count_, the data-vector in the
-# Stack instead of the vector, and cleans up the Stack by 2.
+/* Argument-Checks:
+ Returns the Index in *index_, the count in *count_, the data-vector in the
+ Stack instead of the vector, and cleans up the Stack by 2.
+ can trigger GC */
 local void test_n_bytes_args (uintL* index_, uintL* count_) {
-  {
-    var object stream = STACK_3;
-    if (!(builtin_stream_p(stream)
-          && eq(TheStream(stream)->strm_rd_by,P(rd_by_iau8_unbuffered))
-          && eq(TheStream(stream)->strm_wr_by,P(wr_by_iau8_unbuffered)))) {
-      if (!streamp(stream)) {
-        fehler_stream(stream);
-      } else {
-        pushSTACK(stream);
-        pushSTACK(TheSubr(subr_self)->name);
-        fehler(error,GETTEXT("~S: stream must be a socket-stream, not ~S"));
-      }
-    }
-  }
+  CHECK_streamtype(STACK_3,S(x11_socket_stream),
+                   (builtin_stream_p(STACK_3)
+                    && eq(TheStream(STACK_3)->strm_rd_by,
+                          P(rd_by_iau8_unbuffered))
+                    && eq(TheStream(STACK_3)->strm_wr_by,
+                          P(wr_by_iau8_unbuffered))));
   {
     var object vector = STACK_2;
     if (!bit_vector_p(Atype_8Bit,vector)) {
@@ -13778,22 +13767,22 @@
   fehler(type_error,GETTEXT("~S: argument ~S is not a SOCKET-STREAM"));
 }
 
-# check whether the object is a handle stream or a socket-server
-# and return its socket-like handle(s)
+/* check whether the object is a handle stream or a socket-server
+ and return its socket-like handle(s) */
 local void stream_handles (object obj, bool check_open, bool* char_p,
                            SOCKET* in_sock, SOCKET* out_sock) {
   if (posfixnump(obj)) {
     if (in_sock)   *in_sock = (SOCKET)posfixnum_to_L(obj);
     if (out_sock) *out_sock = (SOCKET)posfixnum_to_L(obj);
     if (char_p) *char_p = false;
+    return;
   }
   if (socket_server_p(obj)) {
     if (check_open) test_socket_server(obj,true);
     if (in_sock) *in_sock = TheSocket(TheSocketServer(obj)->socket_handle);
     return;
   }
-  check_stream(obj);
-  if (!(TheStream(obj)->strmflags & strmflags_open_B)) {
+  if (!(streamp(obj) && TheStream(obj)->strmflags & strmflags_open_B)) {
     pushSTACK(obj);       # TYPE-ERROR slot DATUM
     pushSTACK(S(stream)); # TYPE-ERROR slot EXPECTED-TYPE
     pushSTACK(obj);
@@ -14626,21 +14615,19 @@
 LISPFUNNR(built_in_stream_open_p,1)
 { /* (SYS::BUILT-IN-STREAM-OPEN-P stream) */
   var object stream = popSTACK();
-  check_builtin_stream(stream);
+  CHECK_builtin_stream(stream);
   VALUES_IF(TheStream(stream)->strmflags & strmflags_open_B); /* open? */
 }
 
 LISPFUNNR(input_stream_p,1)
 { /* (INPUT-STREAM-P stream), CLTL p. 332, CLtL2 p. 505 */
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   VALUES_IF(input_stream_p(stream));
 }
 
 LISPFUNNR(output_stream_p,1)
 { /* (OUTPUT-STREAM-P stream), CLTL p. 332, CLtL2 p. 505 */
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   VALUES_IF(output_stream_p(stream));
 }
 
@@ -14700,8 +14687,8 @@
 # or (more specific) (UNSIGNED-BYTE n) or (SIGNED-BYTE n).
 LISPFUNNR(built_in_stream_element_type,1) {
   var object stream = popSTACK();
-  check_builtin_stream(stream);
   var object eltype;
+  CHECK_builtin_stream(stream);
  start:
   switch (TheStream(stream)->strmtype) {
     case strmtype_synonym: # Synonym-Stream: follow further
@@ -14862,8 +14849,8 @@
 # (SYSTEM::BUILT-IN-STREAM-SET-ELEMENT-TYPE stream element-type)
 LISPFUNN(built_in_stream_set_element_type,2) {
   var object stream = STACK_1;
-  check_builtin_stream(stream);
   var decoded_el_t eltype;
+  CHECK_builtin_stream(stream);
   test_eltype_arg(&STACK_0,&eltype);
   pushSTACK(canon_eltype(&eltype));
   # Stack contents: stream, element-type, canon-element-type.
@@ -14989,8 +14976,7 @@
 
 LISPFUNNR(stream_external_format,1)
 { /* (STREAM-EXTERNAL-FORMAT stream) */
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
  start:
   if (builtin_stream_p(stream))
     switch (TheStream(stream)->strmtype) {
@@ -15275,8 +15261,7 @@
 # (INTERACTIVE-STREAM-P stream), CLTL2 p. 507/508
 # determines, if stream is interactive.
 LISPFUNN(interactive_stream_p,1) {
-  var object arg = popSTACK();
-  check_stream(arg);
+  var object arg = check_stream(popSTACK());
   VALUES_IF(interactive_stream_p(arg));
 }
 
@@ -15397,7 +15382,7 @@
 LISPFUN(built_in_stream_close,seclass_default,1,0,norest,key,1, (kw(abort)) ) {
   skipSTACK(1); # ignore the :ABORT argument
   var object stream = STACK_0; # Argument
-  check_builtin_stream(stream); # must be a Stream
+  CHECK_builtin_stream(stream); # must be a Stream
   builtin_stream_close(&STACK_0);
   skipSTACK(1);
   VALUES1(T); # T as result
@@ -16173,8 +16158,7 @@
 
 # (READ-BYTE-LOOKAHEAD stream)
 LISPFUNN(read_byte_lookahead,1) {
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   # Query the status:
   var signean status = listen_byte(stream);
   if (ls_wait_p(status))
@@ -16188,8 +16172,7 @@
 
 # (READ-BYTE-WILL-HANG-P stream)
 LISPFUNN(read_byte_will_hang_p,1) {
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   # Query the status:
   var signean status = listen_byte(stream);
   VALUES_IF(ls_wait_p(status));
@@ -16347,7 +16330,8 @@
 # (WRITE-BYTE integer stream), CLTL p. 385
 LISPFUNN(write_byte,2) {
   var object stream = check_stream(STACK_0);
-  var object obj = check_wr_int(stream,STACK_1);
+  var object obj = STACK_1;
+  ASSERT_wr_int(stream,obj);
   # write Integer:
   write_byte(stream,obj);
   VALUES1(STACK_1); skipSTACK(2); /* return obj */
@@ -16364,9 +16348,10 @@
   # check Endianness:
   var bool endianness = test_endianness_arg(STACK_0);
   # check Integer:
-  var object obj = check_wr_int(stream,STACK_3);
   var uintL bitsize = eltype.size;
   var uintL bytesize = bitsize/8;
+  var object obj = STACK_3;
+  ASSERT_wr_int(stream,obj);
   var DYNAMIC_8BIT_VECTOR(bitbuffer,bytesize);
   pushSTACK(bitbuffer);
   # Stack layout: obj, stream, element-type, endianness, bitbuffer.
@@ -16843,8 +16828,7 @@
 # (SYS::LINE-NUMBER stream) returns the current line-number (if stream
 # is a Character-File-Input-Stream, which was only used for reading).
 LISPFUNN(line_number,1) {
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(popSTACK());
   VALUES1(stream_line_number(stream));
 }
 
@@ -16895,9 +16879,8 @@
 # T means #. is allowed regardless of the value of *READ-EVAL*, NIL
 # (the default) means that *READ-EVAL* is respected.
 LISPFUN(allow_read_eval,seclass_default,1,1,norest,nokey,0,NIL) {
-  var object flag = popSTACK();
-  var object stream = popSTACK();
-  check_stream(stream);
+  var object stream = check_stream(STACK_1);
+  var object flag = STACK_0;
   if (eq(flag,unbound)) {
     value1 = (stream_get_read_eval(stream) ? T : NIL);
   } else {
@@ -16907,7 +16890,7 @@
       stream_set_read_eval(stream,true); value1 = T;
     }
   }
-  mv_count=1;
+  skipSTACK(2); mv_count=1;
 }
 
 # (SYS::%DEFGRAY fundamental-stream-classes)

Index: io.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/io.d,v
retrieving revision 1.229
retrieving revision 1.230
diff -u -d -r1.229 -r1.230
--- io.d	2 Jun 2004 10:27:47 -0000	1.229
+++ io.d	2 Jun 2004 21:32:34 -0000	1.230
@@ -719,25 +719,26 @@
   skipSTACK(3);
 }
 
-# UP: checks the arguments disp-char and sub-char.
-# > STACK: STACK_1 = disp-char, STACK_0 = sub-char
-# > readtable: Readtable
-# < result: the dispatch-macro-table for disp-char,
-#             nullobj if sub-char is a digit.
+/* UP: checks the arguments disp-char and sub-char.
+ > STACK: STACK_2 = disp-char, STACK_1 = sub-char
+ > readtable: Readtable
+ < result: the dispatch-macro-table for disp-char,
+             nullobj if sub-char is a digit.
+ can trigger GC */
 local object test_disp_sub_char (object readtable) {
-  var object sub_ch = STACK_0; # sub-char
-  var object disp_ch = STACK_1; # disp-char
-  if (!charp(disp_ch)) # disp-char must be a character
-    fehler_char(disp_ch);
-  if (!charp(sub_ch)) # sub-char must be a character
-    fehler_char(sub_ch);
+  var object sub_ch = check_char(STACK_1);  /* sub-char */
+ retry_disp_ch:
+  var object disp_ch = check_char(STACK_2); /* disp-char */
   var chart disp_c = char_code(disp_ch);
   var object entry =
     perchar_table_get(TheReadtable(readtable)->readtable_macro_table,disp_c);
   if (!simple_vector_p(entry)) {
+    pushSTACK(NIL);             /* no PLACE */
     pushSTACK(disp_ch);
     pushSTACK(TheSubr(subr_self)->name);
-    fehler(error,GETTEXT("~S: ~S is not a dispatch macro character"));
+    check_value(error,GETTEXT("~S: ~S is not a dispatch macro character"));
+    STACK_2 = value1;
+    goto retry_disp_ch;
   }
   # disp-char is a dispatching-macro-character, entry is the vector.
   var cint sub_c = as_cint(up_case(char_code(sub_ch))); # convert sub-char into upper case
@@ -753,8 +754,8 @@
   /* check function and convert it into an object of Type FUNCTION: */
   STACK_1 = coerce_function(STACK_1);
   var object readtable = test_readtable_arg(popSTACK()); /* Readtable */
-  var object function = popSTACK(); /* function */
   var object dm_table = test_disp_sub_char(readtable);
+  var object function = popSTACK(); /* function */
   if (eq(dm_table,nullobj)) {
     /* STACK_0 = sub-char, TYPE-ERROR slot DATUM */
     pushSTACK(O(type_not_digit)); /* TYPE-ERROR slot EXPECTED-TYPE */
@@ -771,11 +772,11 @@
 LISPFUN(get_dispatch_macro_character,seclass_read,2,1,norest,nokey,0,NIL)
 { /* (GET-DISPATCH-MACRO-CHARACTER disp-char sub-char [readtable]),
      CLTL p. 364 */
-  var object readtable = test_readtable_null_arg(popSTACK()); /* readtable */
+  var object readtable = test_readtable_null_arg(STACK_0); /* readtable */
   var object dm_table = test_disp_sub_char(readtable);
   VALUES1(eq(dm_table,nullobj) ? NIL /* NIL or Function as value */
-          : perchar_table_get(dm_table,up_case(char_code(STACK_0))));
-  skipSTACK(2);
+          : perchar_table_get(dm_table,up_case(char_code(STACK_1))));
+  skipSTACK(3);
 }
 
 #define RTCase(rt) ((uintW)posfixnum_to_L(TheReadtable(rt)->readtable_case))
@@ -2454,19 +2455,20 @@
   }
 }
 
-# Macro: checks the Stream-Argument of a SUBRs.
-# stream_ = test_stream_arg(stream);
-# > stream: Stream-Argument in STACK
-# < stream_: &stream
-#define test_stream_arg(stream)  \
-    (!streamp(stream) ? (fehler_stream(stream), (gcv_object_t*)NULL) : &(stream))
+/* stream_ = check_stream_arg(stream_);
+ > stream_: Stream-Argument in STACK
+ < stream_: &stream
+ can trigger GC */
+static inline gcv_object_t* check_stream_arg (gcv_object_t *stream_) {
+  *stream_ = check_stream(*stream_); return stream_;
+}
 
 # (set-macro-character #\(
 #   #'(lambda (stream char)
 #       (read-delimited-list #\) stream t :dot-allowed t)
 # )   )
 LISPFUNN(lpar_reader,2) { # reads (
-  var gcv_object_t* stream_ = test_stream_arg(STACK_1);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_1);
   # read List after '(' until ')', Dot allowed:
   VALUES1(read_delimited_list(stream_,ascii_char(')'),dot_value));
   skipSTACK(2);
@@ -2478,7 +2480,7 @@
 #       (error "~S of ~S: ~S at the beginning of object" 'read stream char)
 # )   )
 LISPFUNN(rpar_reader,2) { # reads )
-  var gcv_object_t* stream_ = test_stream_arg(STACK_1);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_1);
   pushSTACK(*stream_); # STREAM-ERROR slot STREAM
   pushSTACK(STACK_(0+1)); # char
   pushSTACK(*stream_); # stream
@@ -2508,7 +2510,7 @@
 #         (if *read-suppress* nil (coerce buffer 'simple-string))
 # )   ) )
 LISPFUNN(string_reader,2) { # reads "
-  var gcv_object_t* stream_ = test_stream_arg(STACK_1);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_1);
   var object delim_char = STACK_0;
   if (terminal_stream_p(*stream_)) {
     dynamic_bind(S(terminal_read_open_object),S(string));
@@ -2611,7 +2613,7 @@
 #       (list 'QUOTE (read stream t nil t))
 # )   )
 LISPFUNN(quote_reader,2) { # reads '
-  var gcv_object_t* stream_ = test_stream_arg(STACK_1);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_1);
   STACK_0 = S(quote); return_Values list2_reader(stream_);
 }
 
@@ -2624,7 +2626,7 @@
 #       (values)
 # )   )
 LISPFUNN(line_comment_reader,2) { # reads ;
-  var gcv_object_t* stream_ = test_stream_arg(STACK_1);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_1);
   loop {
     var object ch = read_char(stream_); # read character
     if (eq(ch,eof_value) || eq(ch,ascii_char(NL)))
@@ -2648,14 +2650,15 @@
          GETTEXT("~S from ~S: no number allowed between #"" and ~C"));
 }
 
-# UP: checks the absence of Infix-Argument n
-# test_no_infix()
-# > stack layout: Stream, sub-char, n.
-# < result: &stream
-# increases STACK by 1
-# modifies STACK
+/* UP: checks the absence of Infix-Argument n
+ test_no_infix()
+ > stack layout: Stream, sub-char, n.
+ < result: &stream
+ increases STACK by 1
+ modifies STACK
+ can trigger GC */
 local gcv_object_t* test_no_infix (void) {
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   var object n = popSTACK();
   if ((!nullp(n)) && nullpSv(read_suppress))
     # if n/=NIL and *READ-SUPPRESS*=NIL : report error
@@ -2801,7 +2804,7 @@
 # )   ) ) ) )
 LISPFUNN(char_reader,3) { # reads #\\
   # stack layout: Stream, sub-char, n.
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   # read Token, with Dummy-Character '\' as start of Token:
   read_token_1(stream_,ascii_char('\\'),syntax_single_esc);
   # finished at once, when *READ-SUPPRESS* /= NIL:
@@ -2953,7 +2956,7 @@
   # < mv_space/mv_count: values
   # can trigger GC
 local Values radix_1 (uintWL base) {
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   read_token(stream_); # read Token
   # finished at once when *READ-SUPPRESS* /= NIL:
   if (!nullpSv(read_suppress)) {
@@ -2998,7 +3001,7 @@
 #         (progn (read-token stream) nil)
 # )   ) )
 LISPFUNN(radix_reader,3) { # reads #R
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   read_token(stream_); # read Token
   # finished at once when *READ-SUPPRESS* /= NIL:
   if (!nullpSv(read_suppress)) {
@@ -3084,7 +3087,7 @@
 #           (make-symbol token)
 # )   ) ) )
 LISPFUNN(uninterned_reader,3) { # reads #:
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   # when *READ-SUPPRESS* /= NIL, read form and return NIL:
   if (!nullpSv(read_suppress)) {
     read_recursive(stream_);
@@ -3165,7 +3168,7 @@
 #               bv
 # )   ) ) ) ) )
 LISPFUNN(bit_vector_reader,3) { # reads #*
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   read_token(stream_); # read Token
   # finished at once, if *READ-SUPPRESS* /= NIL:
   if (!nullpSv(read_suppress)) {
@@ -3267,7 +3270,7 @@
 #               v
 # )   ) ) ) ) )
 LISPFUNN(vector_reader,3) { # reads #(
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   # read List until parenthese, Dot is not allowed:
   var object elements = read_delimited_list(stream_,ascii_char(')'),eof_value);
   # already finished when *READ-SUPPRESS* /= NIL:
@@ -3348,7 +3351,7 @@
 #             (make-array (nreverse dims) :element-type eltype :initial-contents cont)
 # )   ) ) ) )
 LISPFUNN(array_reader,3) { # reads #A
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   # stack layout: stream, sub-char, n.
   if (!nullpSv(read_suppress)) { /* *READ-SUPPRESS* /= NIL ? */
     # yes -> skip next Object:
@@ -3458,7 +3461,7 @@
 #             (eval h)
 # )   ) ) ) )
 LISPFUNN(read_eval_reader,3) { # reads #.
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   var object obj = read_recursive_no_dot(stream_); # read Form
   # if *READ-SUPPRESS* /= NIL ==> finished immediately:
   if (!nullpSv(read_suppress)) {
@@ -3487,7 +3490,7 @@
 #             (if sys::*compiling* (make-load-time-eval h) (eval h))
 # )   ) ) ) )
 LISPFUNN(load_eval_reader,3) { # reads #,
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   var object obj = read_recursive_no_dot(stream_); # read Form
   # finished immediately, when *READ-SUPPRESS* /= NIL:
   if (!nullpSv(read_suppress)) {
@@ -3617,7 +3620,7 @@
   } else {
     # lookup = label, not jeopardized by GC.
     # (push (setq h (cons label label)) sys::*read-reference-table*) :
-    var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+    var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
     {
       var object new_cons = allocate_cons();
       Car(new_cons) = Cdr(new_cons) = lookup; # h = (cons label label)
@@ -3671,7 +3674,7 @@
 #               'read stream
 # )   ) )
 LISPFUNN(not_readable_reader,3) { # reads #<
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   pushSTACK(*stream_); # STREAM-ERROR slot STREAM
   pushSTACK(*stream_); # Stream
   pushSTACK(S(read));
@@ -3686,7 +3689,7 @@
 #                 'read stream '*print-level*
 # ) )   ) )
 LISPFUNN(syntax_error_reader,3) { # reads #) and #whitespace
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   pushSTACK(*stream_); # STREAM-ERROR slot STREAM
   pushSTACK(S(print_level));
   pushSTACK(*stream_); # Stream
@@ -4109,7 +4112,7 @@
 }
 
 LISPFUNN(closure_reader,3) { # read #Y
-  var gcv_object_t* stream_ = test_stream_arg(STACK_2);
+  var gcv_object_t* stream_ = check_stream_arg(&STACK_2);
   # when n=0 read an Encoding:
   if (eq(STACK_0,Fixnum_0)) {
     dynamic_bind(S(read_suppress),NIL); # bind *READ-SUPPRESS* to NIL
@@ -4304,22 +4307,21 @@
 
 # ------------------------ LISP-Functions of the Reader -----------------------
 
-# UP: checks an Input-Stream-Argument.
-# Default is the value of *STANDARD-INPUT*.
-# test_istream(&stream);
-# > stream: Input-Stream-Argument
-# < stream: Input-Stream (a Stream)
-local void test_istream (gcv_object_t* stream_) {
+/* UP: checks an Input-Stream-Argument.
+ Default is the value of *STANDARD-INPUT*.
+ check_istream(&stream);
+ > stream: Input-Stream-Argument
+ < stream: Input-Stream (a Stream)
+ can trigger GC*/
+local void check_istream (gcv_object_t* stream_) {
   var object stream = *stream_;
   if (missingp(stream)) {
-    # instead of #<UNBOUND> or NIL: value of *STANDARD-INPUT*
+    /* instead of #<UNBOUND> or NIL: value of *STANDARD-INPUT* */
     *stream_ = var_stream(S(standard_input),strmflags_rd_ch_B);
-  } else if (eq(stream,T)) { # instead of T: value of *TERMINAL-IO*
+  } else if (eq(stream,T)) {  /* instead of T: value of *TERMINAL-IO* */
     *stream_ = var_stream(S(terminal_io),strmflags_rd_ch_B);
-  } else {
-    if (!streamp(stream))
-      fehler_stream(stream);
-  }
+  } else
+    *stream_ = check_stream(stream);
 }
 
 # EOF-Handling, ends Reader-Functions.
@@ -4345,15 +4347,15 @@
   }
 }
 
-# UP: for READ and READ-PRESERVING-WHITESPACE
-# read_w(whitespace-p)
-# > whitespace-p: indicates, if whitespace has to be consumed afterwards
-# > stack layout: input-stream, eof-error-p, eof-value, recursive-p.
-# < STACK: cleaned up
-# < mv_space/mv_count: values
+/* UP: for READ and READ-PRESERVING-WHITESPACE
+ read_w(whitespace-p)
+ > whitespace-p: indicates, if whitespace has to be consumed afterwards
+ > stack layout: input-stream, eof-error-p, eof-value, recursive-p.
+ < STACK: cleaned up
+ < mv_space/mv_count: values
+ can trigger GC */
 local Values read_w (object whitespace_p) {
-  # check input-stream:
-  test_istream(&STACK_3);
+  check_istream(&STACK_3);      /* check input-stream */
   # check for recursive-p-Argument:
   var object recursive_p = STACK_0;
   if (missingp(recursive_p)) { /* non-recursive call */
@@ -4384,11 +4386,8 @@
 # (READ-DELIMITED-LIST char [input-stream [recursive-p]]), CLTL p. 377
 LISPFUN(read_delimited_list,seclass_default,1,2,norest,nokey,0,NIL) {
   # check char:
-  var object ch = STACK_2;
-  if (!charp(ch))
-    fehler_char(ch);
-  # check input-stream:
-  test_istream(&STACK_1);
+  var object ch = check_char(STACK_2);
+  check_istream(&STACK_1);      /* check input-stream */
   # check for recursive-p-Argument:
   var object recursive_p = popSTACK();
   # stack layout: char, input-stream.
@@ -4417,9 +4416,8 @@
 # This implementation always returns a simple string, if end-of-stream
 # is not encountered immediately.  Code in debug.d depends on this.
 LISPFUN(read_line,seclass_default,0,4,norest,nokey,0,NIL) {
-  # check input-stream:
   var gcv_object_t* stream_ = &STACK_3;
-  test_istream(stream_);
+  check_istream(stream_);       /* check input-stream */
   get_buffers(); # two empty Buffers on Stack
   if (!read_line(stream_,&STACK_1)) { # read line
     # End of Line
@@ -4450,9 +4448,8 @@
 # (READ-CHAR [input-stream [eof-error-p [eof-value [recursive-p]]]]),
 # CLTL p. 379
 LISPFUN(read_char,seclass_default,0,4,norest,nokey,0,NIL) {
-  # check input-stream:
   var gcv_object_t* stream_ = &STACK_3;
-  test_istream(stream_);
+  check_istream(stream_);             /* check input-stream */
   var object ch = read_char(stream_); # read Character
   if (eq(ch,eof_value)) {
     return_Values eof_handling(1);
@@ -4463,12 +4460,9 @@
 
 # (UNREAD-CHAR char [input-stream]), CLTL p. 379
 LISPFUN(unread_char,seclass_default,1,1,norest,nokey,0,NIL) {
-  # check input-stream:
   var gcv_object_t* stream_ = &STACK_0;
-  test_istream(stream_);
-  var object ch = STACK_1; # char
-  if (!charp(ch)) # must be a character
-    fehler_char(ch);
+  check_istream(stream_);              /* check input-stream */
+  var object ch = check_char(STACK_1); # char
   unread_char(stream_,ch); # push back char to Stream
   VALUES1(NIL); skipSTACK(2);
 }
@@ -4476,9 +4470,8 @@
 # (PEEK-CHAR [peek-type [input-stream [eof-error-p [eof-value [recursive-p]]]]]),
 # CLTL p. 379
 LISPFUN(peek_char,seclass_default,0,5,norest,nokey,0,NIL) {
-  # check input-stream:
   var gcv_object_t* stream_ = &STACK_3;
-  test_istream(stream_);
+  check_istream(stream_);       /* check input-stream */
   # distinction of cases by peek-type:
   var object peek_type = STACK_4;
   if (missingp(peek_type)) {
@@ -4519,7 +4512,7 @@
 
 # (LISTEN [input-stream]), CLTL p. 380
 LISPFUN(listen,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_istream(&STACK_0); # check input-stream
+  check_istream(&STACK_0);      /* check input-stream */
   VALUES_IF(ls_avail_p(listen_char(popSTACK())));
 }
 
@@ -4528,16 +4521,15 @@
 # character, but accomplishes this without actually calling READ-CHAR-NO-HANG,
 # thus avoiding the need for UNREAD-CHAR and preventing side effects.
 LISPFUNN(read_char_will_hang_p,1) {
-  test_istream(&STACK_0); # check input-stream
+  check_istream(&STACK_0);      /* check input-stream */
   VALUES_IF(ls_wait_p(listen_char(popSTACK())));
 }
 
 # (READ-CHAR-NO-HANG [input-stream [eof-error-p [eof-value [recursive-p]]]]),
 # CLTL p. 380
 LISPFUN(read_char_no_hang,seclass_default,0,4,norest,nokey,0,NIL) {
-  # check input-stream:
   var gcv_object_t* stream_ = &STACK_3;
-  test_istream(stream_);
+  check_istream(stream_);       /* check input-stream */
   var object stream = *stream_;
   if (builtin_stream_p(stream)
       ? !(TheStream(stream)->strmflags & bit(strmflags_rd_ch_bit_B))
@@ -4561,7 +4553,7 @@
 
 # (CLEAR-INPUT [input-stream]), CLTL p. 380
 LISPFUN(clear_input,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_istream(&STACK_0); # check input-stream
+  check_istream(&STACK_0);      /* check input-stream */
   clear_input(popSTACK());
   VALUES1(NIL);
 }
@@ -4644,20 +4636,20 @@
   var uintL base;
   {
     var object arg = popSTACK();
-    if (!boundp(arg)) {
-      base = 10; # Default 10
-    } else {
-      if (!(posfixnump(arg)
-            && (base = posfixnum_to_L(arg), ((base >= 2) && (base <= 36))))) {
-        pushSTACK(arg);           # TYPE-ERROR slot DATUM
-        pushSTACK(O(type_radix)); # TYPE-ERROR slot EXPECTED-TYPE
-        pushSTACK(arg); # base
+    if (!boundp(arg))
+      base = 10;                /* Default 10 */
+    else
+      while (!(posfixnump(arg)
+               && (base = posfixnum_to_L(arg), ((base >= 2) && (base <= 36))))) {
+        pushSTACK(NIL);           /* no PLACE */
+        pushSTACK(arg);           /* TYPE-ERROR slot DATUM */
+        pushSTACK(O(type_radix)); /* TYPE-ERROR slot EXPECTED-TYPE */
+        pushSTACK(arg);           /* base */
         pushSTACK(S(Kradix));
         pushSTACK(TheSubr(subr_self)->name);
-        fehler(type_error,
-               GETTEXT("~S: ~S argument should be an integer between 2 and 36, not ~S"));
+        check_value(type_error,GETTEXT("~S: ~S argument ~S is not an integer between 2 and 36"));
+        arg = value1;
       }
-    }
   }
   # base = value of :radix-argument.
   # check string, :start and :end:
@@ -8152,8 +8144,7 @@
 LISPFUNN(print_structure,2) {
   /* stack layout: structure, stream. */
   STACK_1 = check_structure(STACK_1);
-  if (!streamp(STACK_0))
-    fehler_stream(STACK_0);
+  STACK_0 = check_stream(STACK_0);
   pr_enter(&STACK_0,STACK_1,&pr_structure_default);
   skipSTACK(2);
   VALUES1(NIL);
@@ -9766,19 +9757,18 @@
 
 /* UP: Check the output-stream argument.
  The value of *STANDARD-OUTPUT* is the default.
- test_ostream(&stream);
+ check_ostream(&stream);
  > stream_: output-stream argument
- < stream_: output-stream (a Stream) */
-local void test_ostream (gcv_object_t* stream_) {
+ < stream_: output-stream (a Stream)
+ can trigger GC */
+local void check_ostream (gcv_object_t* stream_) {
   var object stream = *stream_;  /* output-stream argument */
   if (missingp(stream)) { /* #<UNBOUND> or NIL -> value of *STANDARD-OUTPUT* */
     *stream_ = var_stream(S(standard_output),strmflags_wr_ch_B);
   } else if (eq(stream,T)) { /* T -> value of *TERMINAL-IO* */
     *stream_ = var_stream(S(terminal_io),strmflags_wr_ch_B);
-  } else { /* should be a stream */
-    if (!streamp(stream))
-      fehler_stream(stream);
-  }
+  } else /* should be a stream */
+    *stream_ = check_stream(stream);
 }
 
 LISPFUNN(whitespacep,1) { # (SYS::WHITESPACEP CHAR)
@@ -9794,7 +9784,7 @@
 
 # (SYS::WRITE-SPACES num &optional stream)
 LISPFUN(write_spaces,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);
+  check_ostream(&STACK_0);
   if (!posfixnump(STACK_1)) fehler_posfixnum(STACK_1);
   spaces(&STACK_0,STACK_1);
   VALUES1(NIL); skipSTACK(2);
@@ -9807,7 +9797,7 @@
 # n          ---a real.
 # stream     ---an output stream designator. The default is standard output.
 LISPFUN(pprint_indent,seclass_default,2,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);
+  check_ostream(&STACK_0);
   /* check the indentation increment */
   STACK_1 = check_real(STACK_1);
   var int offset=0;
@@ -9869,7 +9859,7 @@
 # kind  ---one of :linear, :fill, :miser, or :mandatory.
 # stream---a stream designator. The default is standard output.
 LISPFUN(pprint_newline,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);
+  check_ostream(&STACK_0);
   var pprint_newline_t ppn_type = PPRINT_NEWLINE_MANDATORY;
   if (eq(S(Klinear),STACK_1))         ppn_type = PPRINT_NEWLINE_LINEAR;
   else if (eq(S(Kfill),STACK_1))      ppn_type = PPRINT_NEWLINE_FILL;
@@ -9934,7 +9924,7 @@
 
 # (%PPRINT-LOGICAL-BLOCK function object stream)
 LISPFUNN(ppprint_logical_block,3) {
-  test_ostream(&STACK_0);
+  check_ostream(&STACK_0);
   if (listp(STACK_1)) {
     var gcv_object_t* stream_ = &STACK_0;
     var object obj = STACK_1;
@@ -9951,7 +9941,7 @@
 # return the appropriate read label or NIL
 # called from PPRINT-POP
 LISPFUNN(pcirclep,2) {
-  test_ostream(&STACK_0);
+  check_ostream(&STACK_0);
   # var circle_info_t ci;
   if (!circle_p(STACK_1,NULL) || !PPHELP_STREAM_P(STACK_0)) # &ci
     VALUES1(NIL);
@@ -9968,7 +9958,7 @@
 #                  &optional (colnum 1) (colinc 1))
 # see format.lisp
 LISPFUN(format_tabulate,seclass_default,3,2,norest,nokey,0,NIL) {
-  test_ostream(&STACK_4);
+  check_ostream(&STACK_4);
  #define COL_ARG(x) (missingp(x) ? Fixnum_1 : \
                      (posfixnump(x) ? (object)x : \
                      (fehler_posfixnum(x),nullobj)))
@@ -10066,7 +10056,7 @@
          kw(lines),kw(miser_width),kw(pprint_dispatch),
          kw(right_margin),kw(stream))) {
   # stack layout: object, Print-Variablen-Arguments, Stream-Argument.
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   write_up(); # execute WRITE
   skipSTACK(print_vars_anz+1);
   VALUES1(popSTACK()); /* object as value */
@@ -10093,7 +10083,7 @@
 
 # (PRIN1 object [stream]), CLTL p. 383
 LISPFUN(prin1,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   prin1_up(); # execute PRIN1
   skipSTACK(1);
   VALUES1(popSTACK()); /* object as value */
@@ -10110,7 +10100,7 @@
 # )
 # (PRINT object [stream]), CLTL p. 383
 LISPFUN(print,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   terpri(&STACK_0); # new line
   prin1_up(); # execute PRIN1
   write_ascii_char(&STACK_0,' '); # add Space
@@ -10128,7 +10118,7 @@
 # )
 # (PPRINT object [stream]), CLTL p. 383
 LISPFUN(pprint,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   terpri(&STACK_0); # new line
   var object obj = STACK_1;
   var gcv_object_t* stream_ = &STACK_0;
@@ -10165,7 +10155,7 @@
 
 # (PRINC object [stream]), CLTL p. 383
 LISPFUN(princ,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   princ_up(); # execute PRINC
   skipSTACK(1);
   VALUES1(popSTACK()); /* object as value */
@@ -10218,10 +10208,8 @@
 
 # (WRITE-CHAR character [stream]), CLTL p. 384
 LISPFUN(write_char,seclass_default,1,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
-  var object ch = STACK_1; # character-Argument
-  if (!charp(ch))
-    fehler_char(ch);
+  check_ostream(&STACK_0);       /* check Output-Stream */
+  var object ch = check_char(STACK_1); # character-Argument
   write_char(&STACK_0,ch);
   VALUES1(ch); /* ch (not jeopardized by GC) as value */
   skipSTACK(2);
@@ -10233,7 +10221,7 @@
 # < stack layout: Stream, String.
 # can trigger GC
 local void write_string_up (void) {
-  test_ostream(&STACK_2);       /* check Output-Stream */
+  check_ostream(&STACK_2);       /* check Output-Stream */
   swap(object,STACK_2,STACK_3); /* swap string and stream */
   # stack layout: stream, string, :START-Argument, :END-Argument.
   # check borders:
@@ -10259,14 +10247,14 @@
 
 # (TERPRI [stream]), CLTL p. 384
 LISPFUN(terpri,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   terpri(&STACK_0); # new line
   VALUES1(NIL); skipSTACK(1);
 }
 
 # (FRESH-LINE [stream]), CLTL p. 384
 LISPFUN(fresh_line,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   if (eq(get_line_position(STACK_0),Fixnum_0)) { # Line-Position = 0 ?
     VALUES1(NIL);
   } else {
@@ -10278,21 +10266,21 @@
 
 # (FINISH-OUTPUT [stream]), CLTL p. 384
 LISPFUN(finish_output,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   finish_output(popSTACK()); # bring Output to the destination
   VALUES1(NIL);
 }
 
 # (FORCE-OUTPUT [stream]), CLTL p. 384
 LISPFUN(force_output,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   force_output(popSTACK()); # bring output to destination
   VALUES1(NIL);
 }
 
 # (CLEAR-OUTPUT [stream]), CLTL p. 384
 LISPFUN(clear_output,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   clear_output(popSTACK()); # delete output
   VALUES1(NIL);
 }
@@ -10316,7 +10304,7 @@
   }
   if (!nullp(STACK_2))
     flag_fun = true;
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   CHECK_PRINT_READABLY(STACK_1);
   var gcv_object_t* stream_ = &STACK_0;
   UNREADABLE_START;
@@ -10347,7 +10335,7 @@
 # (SYS::LINE-POSITION [stream]), Auxiliary function for FORMAT ~T,
 # returns the position of an (Output-)Stream in the current line, or NIL.
 LISPFUN(line_position,seclass_default,0,1,norest,nokey,0,NIL) {
-  test_ostream(&STACK_0);       /* check Output-Stream */
+  check_ostream(&STACK_0);       /* check Output-Stream */
   VALUES1(get_line_position(popSTACK()));
 }
 

Index: ChangeLog
===================================================================
RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v
retrieving revision 1.3123
retrieving revision 1.3124
diff -u -d -r1.3123 -r1.3124
--- ChangeLog	2 Jun 2004 17:28:54 -0000	1.3123
+++ ChangeLog	2 Jun 2004 21:32:34 -0000	1.3124
@@ -1,5 +1,55 @@
 2004-06-02  Sam Steingold  <sd...@gn...>
 
+	more consistent macro/function naming, more error recovery
+	* stream.d (check_stream, check_streamtype, check_wr_int): removed
+	(get_streamtype_replacement): new function
+	(CHECK_streamtype, CHECK_builtin_stream, ASSERT_wr_int): new macros
+	(test_stream_args): remove, replace with ...
+	(check_stream_args): new function
+	(SYNONYM-STREAM-SYMBOL, BROADCAST-STREAM-STREAMS)
+	(CONCATENATED-STREAM-STREAMS, GENERIC-STREAM-CONTROLLER)
+	(TWO-WAY-STREAM-INPUT-STREAM, TWO-WAY-STREAM-OUTPUT-STREAM)
+	(ECHO-STREAM-INPUT-STREAM, ECHO-STREAM-OUTPUT-STREAM)
+	(test_n_bytes_args): use CHECK_streamtype
+	(stream_handles): fixed a bug: missing `return' in fixnum case
+	(MAKE-TWO-WAY-STREAM, MAKE-ECHO-STREAM): use check_stream_args()
+	(GENERIC-STREAM-P, TERMINAL-RAW, INPUT-STREAM-P, OUTPUT-STREAM-P)
+	(STREAM-EXTERNAL-FORMAT, INTERACTIVE-STREAM-P, READ-BYTE-LOOKAHEAD)
+	(READ-BYTE-WILL-HANG-P, WRITE-BYTE, LINE-NUMBER, ALLOW-READ-EVAL):
+	updated for the check_stream() changes
+	(BUILT-IN-STREAM-ELEMENT-TYPE): use CHECK_builtin_stream()
+	(bitbuff_ixu_sub, bitbuff_ixs_sub, wr_by_iau8_unbuffered)
+	(wr_by_iau8_buffered, WRITE-BYTE, WRITE-INTEGER): use CHECK_wr_int()
+	* io.d (test_disp_sub_char): completely recoverable, shift STACK args
+	(SET-DISPATCH-MACRO-CHARACTER, GET-DISPATCH-MACRO-CHARACTER): update
+	(test_stream_arg): remove, replace with ...
+	(check_stream_arg): new function
+	(RPAR-READER, STRING-READER, QUOTE-READER, LINE-COMMENT-READER)
+	(test_no_infix, CHAR-READER, radix_1, RADIX-READER, UNINTERNED-READER)
+	(BIT-VECTOR-READER, VECTOR-READER, ARRAY-READER, READ-EVAL-READER)
+	(LOAD-EVAL-READER, LABEL-DEFINITION-READER, NOT-READABLE-READER)
+	(SYNTAX-ERROR-READER, CLOSURE-READER, PPRINT-NEWLINE, %CIRCLEP)
+	(%PPRINT-LOGICAL-BLOCK, FORMAT-TABULATE, WRITE, PRIN1, PRINT, PPRINT)
+	(PRINC, WRITE-CHAR, write_string_up, TERPRI, FRESH-LINE, FINISH-OUTPUT)
+	(FORCE-OUTPUT, CLEAR-OUTPUT, WRITE-UNREADABLE, LINE-POSITION): use it
+	(test_istream, test_ostream): remove, replace with ..
+	(check_istream, check_ostream): new functions
+	(read_w, READ-DELIMITED-LIST, READ-LINE, READ-CHAR, UNREAD-CHAR)
+	(PEEK-CHAR, LISTEN, READ-CHAR-WILL-HANG-P, READ-CHAR-NO-HANG)
+	(CLEAR-INPUT): use check_istream()
+	(PARSE-INTEGER): recover from bad radix
+	(PRINT-STRUCTURE): use check_stream()
+	(WRITE-SPACES, PPRINT-INDENT, ): use check_ostream()
+	* error.d, lispbibl.d (check_stream_replacement): added
+	(fehler_stream, fehler_streamtype): removed
+	* debug.d (DESCRIBE-FRAME): use check_stream()
+	instead of fehler_stream()
+	* sequence.d (READ-CHAR-SEQUENCE, WRITE-CHAR-SEQUENCE)
+	(READ-BYTE-SEQUENCE, WRITE-BYTE-SEQUENCE): ditto
+	* constsym.d (x11_socket_stream, generic_stream): added
+
+2004-06-02  Sam Steingold  <sd...@gn...>
+
 	* list.d (up2_test, up2_test_not, up_test, up_test_not, up_if)
 	(up_if_not): simplify return statement
 

Index: debug.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/debug.d,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -d -r1.70 -r1.71
--- debug.d	28 Apr 2004 11:43:54 -0000	1.70
+++ debug.d	2 Jun 2004 21:32:34 -0000	1.71
@@ -1382,8 +1382,7 @@
 # Pointer zeigt, detailliert aus.
   {
     var gcv_object_t* FRAME = test_framepointer_arg(); # Pointer in den Stack
-    if (!streamp(STACK_0))
-      fehler_stream(STACK_0);
+    STACK_0 = check_stream(STACK_0);
     {
       var p_backtrace_t bt = back_trace;
       unwind_back_trace(bt,FRAME);

Index: constsym.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/constsym.d,v
retrieving revision 1.244
retrieving revision 1.245
diff -u -d -r1.244 -r1.245
--- constsym.d	2 Jun 2004 10:22:12 -0000	1.244
+++ constsym.d	2 Jun 2004 21:32:34 -0000	1.245
@@ -930,6 +930,7 @@
 LISPSYM(make_x11socket_stream,"MAKE-SOCKET-STREAM",system)
 LISPSYM(read_n_bytes,"READ-N-BYTES",system)
 LISPSYM(write_n_bytes,"WRITE-N-BYTES",system)
+LISPSYM(x11_socket_stream,"X11-SOCKET-STREAM",system)
 #endif
 #ifdef SOCKET_STREAMS
 LISPSYM(socket_server,"SOCKET-SERVER",socket)
@@ -1424,6 +1425,7 @@
 LISPSYM(generic_stream_rdby,"GENERIC-STREAM-READ-BYTE",gstream)
 LISPSYM(generic_stream_wrby,"GENERIC-STREAM-WRITE-BYTE",gstream)
 LISPSYM(generic_stream_close,"GENERIC-STREAM-CLOSE",gstream)
+LISPSYM(generic_stream,"GENERIC-STREAM",gstream)
 #endif
 #ifdef KEYBOARD
 LISPSYM(Kchar,"CHAR",keyword) /* make-input-character-argument for STREAM */

Index: error.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/error.d,v
retrieving revision 1.110
retrieving revision 1.111
diff -u -d -r1.110 -r1.111
--- error.d	1 Jun 2004 10:32:56 -0000	1.110
+++ error.d	2 Jun 2004 21:32:34 -0000	1.111
@@ -1082,24 +1082,20 @@
 }
 
 /* error-message, if an argument is not a Stream:
- fehler_stream(obj);
- > obj: the erroneous argument */
-nonreturning_function(global, fehler_stream, (object obj)) {
-  pushSTACK(obj);       /* TYPE-ERROR slot DATUM */
-  pushSTACK(S(stream)); /* TYPE-ERROR slot EXPECTED-TYPE */
-  pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name);
-  fehler(type_error,GETTEXT("~S: argument ~S is not a stream"));
-}
-
-/* error-message, if an argument is not a Stream of required stream type:
- fehler_streamtype(obj,type);
- > obj: the erroneous argument
- > type: required stream-type */
-nonreturning_function(global, fehler_streamtype, (object obj, object type)) {
-  pushSTACK(obj);  /* TYPE-ERROR slot DATUM */
-  pushSTACK(type); /* TYPE-ERROR slot EXPECTED-TYPE */
-  pushSTACK(type); pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name);
-  fehler(type_error,GETTEXT("~S: argument ~S should be a stream of type ~S"));
+ check_stream_replacement(obj);
+ > obj: not a stream
+ < obj: a stream
+ can trigger GC */
+global object check_stream_replacement (object obj) {
+  do {
+    pushSTACK(NIL);             /* no PLACE */
+    pushSTACK(obj);             /* TYPE-ERROR slot DATUM */
+    pushSTACK(S(stream));       /* TYPE-ERROR slot EXPECTED-TYPE */
+    pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name);
+    check_value(type_error,GETTEXT("~S: argument ~S is not a stream"));
+    obj = value1;
+  } while (!streamp(obj));
+  return obj;
 }
 
 /* Report an error when the argument is not an encoding:

Index: lispbibl.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/lispbibl.d,v
retrieving revision 1.511
retrieving revision 1.512
diff -u -d -r1.511 -r1.512
--- lispbibl.d	2 Jun 2004 10:22:11 -0000	1.511
+++ lispbibl.d	2 Jun 2004 21:32:34 -0000	1.512
@@ -12806,19 +12806,6 @@
  > obj: the erroneous argument */
 nonreturning_function(extern, fehler_class, (object obj));
 
-# Error message, if an argument isn't a stream:
-# fehler_stream(obj);
-# > obj: the faulty argument
-nonreturning_function(extern, fehler_stream, (object obj));
-# is used by IO, STREAM, DEBUG
-
-# Error message, if an argument isn't a stream of the requested stream-type:
-# fehler_streamtype(obj,type);
-# > obj: the faulty argument
-# > type: requested stream-type
-nonreturning_function(extern, fehler_streamtype, (object obj, object type));
-# is used by STREAM
-
 /* Report an error when the argument is not an encoding:
  check_encoding(obj,&default,keyword_p)
  > obj: the (possibly) bad argument
@@ -13395,6 +13382,21 @@
 
 # ###################### STRMBIBL for STREAM.D ############################# #
 
+/* Error message, if an argument isn't a stream:
+ check_stream_replacement(obj);
+ > obj: not a stream
+ < obj: a stream
+ can trigger GC */
+extern object check_stream_replacement (object obj);
+#ifndef COMPILE_STANDALONE
+static inline object check_stream (object obj) {
+  if (!streamp(obj))
+    obj = check_stream_replacement(obj);
+  return obj;
+}
+#endif
+/* is used by IO, STREAM, DEBUG */
+
 /* parse timeout argument
  sec = posfixnum or (SEC . USEC) or (SEC USEC) or float or ratio or nil/unbound
  usec = posfixnum or nil/unbound

Index: sequence.d
===================================================================
RCS file: /cvsroot/clisp/clisp/src/sequence.d,v
retrieving revision 1.77
retrieving revision 1.78
diff -u -d -r1.77 -r1.78
--- sequence.d	3 May 2004 09:45:19 -0000	1.77
+++ sequence.d	2 Jun 2004 21:32:33 -0000	1.78
@@ -4875,9 +4875,7 @@
     # sequence überprüfen:
     pushSTACK(get_valid_seq_type(STACK_3));
     # Stackaufbau: sequence, stream, start, end, typdescr.
-    # Stream überprüfen:
-    if (!streamp(STACK_3))
-      fehler_stream(STACK_3);
+    STACK_3 = check_stream(STACK_3);
     # Defaultwert für start ist 0:
     start_default_0(STACK_2);
     # Defaultwert für end ist die Länge der Sequence:
@@ -4927,8 +4925,7 @@
     # sequence überprüfen:
     pushSTACK(get_valid_seq_type(STACK_3));
     # Stackaufbau: sequence, stream, start, end, typdescr.
-    # Stream überprüfen:
-    if (!streamp(STACK_3)) { fehler_stream(STACK_3); }
+    STACK_3 = check_stream(STACK_3);
     # Defaultwert für start ist 0:
     start_default_0(STACK_2);
     # Defaultwert für end ist die Länge der Sequence:
@@ -4976,7 +4973,7 @@
   var bool no_hang = !missingp(STACK_0); skipSTACK(1);
   pushSTACK(get_valid_seq_type(STACK_3)); /* check sequence */
   /* stack layout: sequence, stream, start, end, typdescr. */
-  if (!streamp(STACK_3)) fehler_stream(STACK_3); /* check stream */
+  STACK_3 = check_stream(STACK_3);
   start_default_0(STACK_2); /* default value for start is 0 */
   end_default_len(STACK_1,STACK_4,STACK_0); /* end defaults to length */
   test_start_end(&O(kwpair_start),&STACK_1); /* check start and end */
@@ -5025,8 +5022,7 @@
   var bool no_hang = !missingp(STACK_0); skipSTACK(1);
   pushSTACK(get_valid_seq_type(STACK_3)); /* sequence check */
   /* stack layout: sequence, stream, start, end, typdescr. */
-  if (!streamp(STACK_3)) /* check stream */
-    fehler_stream(STACK_3);
+  STACK_3 = check_stream(STACK_3);
   start_default_0(STACK_2); /* default value for start is 0 */
   end_default_len(STACK_1,STACK_4,STACK_0); /* end defaults to length */
   test_start_end(&O(kwpair_start),&STACK_1); /* check start and end */




--__--__--

_______________________________________________
clisp-cvs mailing list
cli...@li...
https://lists.sourceforge.net/lists/listinfo/clisp-cvs


End of clisp-cvs Digest