[Chicken-hackers] [PATCH] Restore input- and output-specific port direction error messages

[Evan Hanson]

Replaces the specific "port direction" error messages for standard,
unidirectional input and output ports, with the more generic message
being used only when the required port direction is neither of those
most common cases.
---
 chicken.h   | 29 +++++++++++++++--------------
 library.scm | 28 +++++++++++++++-------------
 runtime.c   | 19 ++++++++++++++++++-
 3 files changed, 48 insertions(+), 28 deletions(-)

diff --git a/chicken.h b/chicken.h
index fe109ff..3ecdd39 100644
--- a/chicken.h
+++ b/chicken.h
@@ -674,20 +674,21 @@ static inline int isinf_ld (long double x)
 #define C_BAD_ARGUMENT_TYPE_NO_LOCATIVE_ERROR         38
 #define C_BAD_ARGUMENT_TYPE_NO_PORT_ERROR             39
 #define C_BAD_ARGUMENT_TYPE_PORT_DIRECTION_ERROR      40
-/* unused                                             41 */
-#define C_PORT_CLOSED_ERROR                           42
-#define C_ASCIIZ_REPRESENTATION_ERROR                 43
-#define C_MEMORY_VIOLATION_ERROR                      44
-#define C_FLOATING_POINT_EXCEPTION_ERROR              45
-#define C_ILLEGAL_INSTRUCTION_ERROR                   46
-#define C_BUS_ERROR                                   47
-#define C_BAD_ARGUMENT_TYPE_NO_EXACT_ERROR            48
-#define C_BAD_ARGUMENT_TYPE_NO_INEXACT_ERROR          49
-#define C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR             50
-#define C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR 51
-#define C_BAD_ARGUMENT_TYPE_NO_EXACT_INTEGER_ERROR    52
-#define C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION        53
-#define C_BAD_ARGUMENT_TYPE_COMPLEX_ABS               54
+#define C_BAD_ARGUMENT_TYPE_PORT_NO_INPUT_ERROR       41
+#define C_BAD_ARGUMENT_TYPE_PORT_NO_OUTPUT_ERROR      42
+#define C_PORT_CLOSED_ERROR                           43
+#define C_ASCIIZ_REPRESENTATION_ERROR                 44
+#define C_MEMORY_VIOLATION_ERROR                      45
+#define C_FLOATING_POINT_EXCEPTION_ERROR              46
+#define C_ILLEGAL_INSTRUCTION_ERROR                   47
+#define C_BUS_ERROR                                   48
+#define C_BAD_ARGUMENT_TYPE_NO_EXACT_ERROR            49
+#define C_BAD_ARGUMENT_TYPE_NO_INEXACT_ERROR          50
+#define C_BAD_ARGUMENT_TYPE_NO_REAL_ERROR             51
+#define C_BAD_ARGUMENT_TYPE_COMPLEX_NO_ORDERING_ERROR 52
+#define C_BAD_ARGUMENT_TYPE_NO_EXACT_INTEGER_ERROR    53
+#define C_BAD_ARGUMENT_TYPE_FOREIGN_LIMITATION        54
+#define C_BAD_ARGUMENT_TYPE_COMPLEX_ABS               55
 
 /* Platform information */
 #if defined(C_BIG_ENDIAN)
diff --git a/library.scm b/library.scm
index c222fd7..246f70f 100644
--- a/library.scm
+++ b/library.scm
@@ -4914,19 +4914,21 @@ EOF
        ((38) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not a locative" args))
        ((39) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not a port" args))
        ((40) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not a port of the correct type" args))
-       ((42) (apply ##sys#signal-hook #:file-error loc "port already closed" 
args))
-       ((43) (apply ##sys#signal-hook #:type-error loc "cannot represent 
string with NUL bytes as C string" args))
-       ((44) (apply ##sys#signal-hook #:memory-error loc "segmentation 
violation" args))
-       ((45) (apply ##sys#signal-hook #:arithmetic-error loc "floating-point 
exception" args))
-       ((46) (apply ##sys#signal-hook #:runtime-error loc "illegal 
instruction" args))
-       ((47) (apply ##sys#signal-hook #:memory-error loc "bus error" args))
-       ((48) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an exact number" args))
-       ((49) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an inexact number" args))
-       ((50) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not a real" args))
-       ((51) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
complex number has no ordering" args))
-       ((52) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an exact integer" args))
-       ((53) (apply ##sys#signal-hook #:type-error loc "number does not fit in 
foreign type" args))
-       ((54) (apply ##sys#signal-hook #:type-error loc "cannot compute 
absolute value of complex number" args))
+       ((41) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an input-port" args))
+       ((42) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an output-port" args))
+       ((43) (apply ##sys#signal-hook #:file-error loc "port already closed" 
args))
+       ((44) (apply ##sys#signal-hook #:type-error loc "cannot represent 
string with NUL bytes as C string" args))
+       ((45) (apply ##sys#signal-hook #:memory-error loc "segmentation 
violation" args))
+       ((46) (apply ##sys#signal-hook #:arithmetic-error loc "floating-point 
exception" args))
+       ((47) (apply ##sys#signal-hook #:runtime-error loc "illegal 
instruction" args))
+       ((48) (apply ##sys#signal-hook #:memory-error loc "bus error" args))
+       ((49) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an exact number" args))
+       ((50) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an inexact number" args))
+       ((51) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not a real" args))
+       ((52) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
complex number has no ordering" args))
+       ((53) (apply ##sys#signal-hook #:type-error loc "bad argument type - 
not an exact integer" args))
+       ((54) (apply ##sys#signal-hook #:type-error loc "number does not fit in 
foreign type" args))
+       ((55) (apply ##sys#signal-hook #:type-error loc "cannot compute 
absolute value of complex number" args))
        (else (apply ##sys#signal-hook #:runtime-error loc "unknown internal 
error" args)) ) ) ) )
 
 
diff --git a/runtime.c b/runtime.c
index c7a35cb..1dc4e3c 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1887,6 +1887,16 @@ void barf(int code, char *loc, ...)
     c = 1;
     break;
 
+  case C_BAD_ARGUMENT_TYPE_PORT_NO_INPUT_ERROR:
+    msg = C_text("bad argument type - not an input-port");
+    c = 1;
+    break;
+
+  case C_BAD_ARGUMENT_TYPE_PORT_NO_OUTPUT_ERROR:
+    msg = C_text("bad argument type - not an output-port");
+    c = 1;
+    break;
+
   case C_PORT_CLOSED_ERROR:
     msg = C_text("port already closed");
     c = 1;
@@ -7067,7 +7077,14 @@ C_regparm C_word C_fcall C_i_check_port_2(C_word x, 
C_word dir, C_word open, C_w
 
   if((C_block_item(x, 1) & dir) != dir) {      /* slot #1: I/O direction mask 
*/
     error_location = loc;
-    barf(C_BAD_ARGUMENT_TYPE_PORT_DIRECTION_ERROR, NULL, x);
+    switch (dir) {
+    case C_fix(1):
+      barf(C_BAD_ARGUMENT_TYPE_PORT_NO_INPUT_ERROR, NULL, x);
+    case C_fix(2):
+      barf(C_BAD_ARGUMENT_TYPE_PORT_NO_OUTPUT_ERROR, NULL, x);
+    default:
+      barf(C_BAD_ARGUMENT_TYPE_PORT_DIRECTION_ERROR, NULL, x);
+    }
   }
 
   if(open == C_SCHEME_TRUE) {
-- 
2.1.4