~ chicken-core (chicken-5) efdfd2e6bb72d1242b68fa0dd113fc8328e71767
commit efdfd2e6bb72d1242b68fa0dd113fc8328e71767
Author: Evan Hanson <evhan@foldling.org>
AuthorDate: Thu Jun 30 23:33:57 2016 +1200
Commit: Peter Bex <peter@more-magic.net>
CommitDate: Sat Jul 9 16:26:41 2016 +0200
Restore input- and output-specific port direction error messages
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.
Signed-off-by: Peter Bex <peter@more-magic.net>
diff --git a/chicken.h b/chicken.h
index fe109ffe..3ecdd39d 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 c222fd7e..246f70fe 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 c7a35cb3..1dc4e3c7 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) {
Trap