Remove unused error codes, add syntax error code.

Add syntax-error SCode object.

diff --git a/src/microcode/errors.h b/src/microcode/errors.h
index 12f996d168f2d6a3c9a6fcbcfe3f7747c45ed91b..528ea7251a476eb75217238051dd56309c4b7713 100644 (file)
--- a/src/microcode/errors.h
+++ b/src/microcode/errors.h
@@ -40,8 +40,8 @@ USA.
 #define ERR_IN_SYSTEM_CALL                     0x04
 #define ERR_WITH_ARGUMENT                      0x05
 #define ERR_BAD_FRAME                          0x06
-#define ERR_BROKEN_COMPILED_VARIABLE           0x07
-#define ERR_UNDEFINED_USER_TYPE                        0x08
+/* #define ERR_BROKEN_COMPILED_VARIABLE                0x07 */
+/* #define ERR_UNDEFINED_USER_TYPE             0x08 */
 #define ERR_UNDEFINED_PRIMITIVE                        0x09
 #define ERR_EXTERNAL_RETURN                    0x0A
 #define ERR_EXECUTE_MANIFEST_VECTOR            0x0B
@@ -54,7 +54,7 @@ USA.
 #define ERR_ARG_3_BAD_RANGE                    0x12
 #define ERR_MACRO_BINDING                      0x13
 #define ERR_FASDUMP_OBJECT_TOO_LARGE           0x14
-/* #define ERR_BAD_INTERRUPT_CODE              0x15 */
+#define ERR_SYNTAX_ERROR                       0x15
 /* #define ERR_NO_ERRORS                       0x16 */
 #define ERR_FASL_FILE_TOO_BIG                  0x17
 #define ERR_FASL_FILE_BAD_DATA                 0x18
@@ -62,9 +62,9 @@ USA.
 /* #define ERR_WRITE_INTO_PURE_SPACE           0x1A */
 /* #define ERR_LOSING_SPARE_HEAP               0x1B */
 /* #define ERR_NO_HASH_TABLE                   0x1C */
-#define ERR_BAD_SET                             0x1D
-#define ERR_ARG_1_FAILED_COERCION                      0x1E
-#define ERR_ARG_2_FAILED_COERCION                      0x1F
+/* #define ERR_BAD_SET                         0x1D */
+/* #define ERR_ARG_1_FAILED_COERCION           0x1E */
+/* #define ERR_ARG_2_FAILED_COERCION           0x1F */
 #define ERR_OUT_OF_FILE_HANDLES                        0x20
 /* #define ERR_SHELL_DIED                      0x21 */
 #define ERR_ARG_4_BAD_RANGE                    0x22
@@ -86,14 +86,14 @@ USA.
 #define ERR_FLOATING_OVERFLOW                  0x32
 #define ERR_UNIMPLEMENTED_PRIMITIVE            0x33
 #define ERR_ILLEGAL_REFERENCE_TRAP             0x34
-#define ERR_BROKEN_VARIABLE_CACHE              0x35
+/* #define ERR_BROKEN_VARIABLE_CACHE           0x35 */
 #define ERR_WRONG_ARITY_PRIMITIVES             0x36
-#define ERR_IO_ERROR                           0x37
+/* #define ERR_IO_ERROR                                0x37 */
 #define ERR_FASDUMP_ENVIRONMENT                        0x38
 #define ERR_FASLOAD_BAND                       0x39
 #define ERR_FASLOAD_COMPILED_MISMATCH          0x3A
-#define ERR_UNKNOWN_PRIMITIVE_CONTINUATION     0x3B
-#define ERR_ILLEGAL_CONTINUATION               0x3C
+/* #define ERR_UNKNOWN_PRIMITIVE_CONTINUATION  0x3B */
+/* #define ERR_ILLEGAL_CONTINUATION            0x3C */
 #define ERR_STACK_HAS_SLIPPED                  0x3D
 #define ERR_CANNOT_RECURSE                     0x3E
 #define ERR_PROCESS_TERMINATED                 0x3F
@@ -111,8 +111,8 @@ USA.
 /* 0x04 */             "system-call",                                  \
 /* 0x05 */             "error-with-argument",                          \
 /* 0x06 */             "bad-frame",                                    \
-/* 0x07 */             "broken-compiled-variable",                     \
-/* 0x08 */             "undefined-user-type",                          \
+/* 0x07 */             0,                                              \
+/* 0x08 */             0,                                              \
 /* 0x09 */             "undefined-primitive-operation",                \
 /* 0x0a */             "external-return",                              \
 /* 0x0b */             "execute-manifest-vector",                      \
@@ -125,7 +125,7 @@ USA.
 /* 0x12 */             "bad-range-argument-2",                         \
 /* 0x13 */             "macro-binding",                                \
 /* 0x14 */             "fasdump-object-too-large",                     \
-/* 0x15 */             0,                                              \
+/* 0x15 */             "syntax-error",                                 \
 /* 0x16 */             0,                                              \
 /* 0x17 */             "fasl-file-too-big",                            \
 /* 0x18 */             "fasl-file-bad-data",                           \
@@ -133,9 +133,9 @@ USA.
 /* 0x1a */             0,                                              \
 /* 0x1b */             0,                                              \
 /* 0x1c */             0,                                              \
-/* 0x1d */             "bad-assignment",                               \
-/* 0x1e */             "failed-arg-1-coercion",                        \
-/* 0x1f */             "failed-arg-2-coercion",                        \
+/* 0x1d */             0,                                              \
+/* 0x1e */             0,                                              \
+/* 0x1f */             0,                                              \
 /* 0x20 */             "out-of-file-handles",                          \
 /* 0x21 */             0,                                              \
 /* 0x22 */             "bad-range-argument-3",                         \
@@ -157,14 +157,14 @@ USA.
 /* 0x32 */             "floating-overflow",                            \
 /* 0x33 */             "unimplemented-primitive",                      \
 /* 0x34 */             "illegal-reference-trap",                       \
-/* 0x35 */             "broken-variable-cache",                        \
+/* 0x35 */             0,                                              \
 /* 0x36 */             "wrong-arity-primitives",                       \
-/* 0x37 */             "io-error",                                     \
+/* 0x37 */             0,                                              \
 /* 0x38 */             "fasdump-environment",                          \
 /* 0x39 */             "fasload-band",                                 \
 /* 0x3a */             "fasload-compiled-mismatch",                    \
-/* 0x3b */             "unknown-primitive-continuation",               \
-/* 0x3c */             "illegal-continuation",                         \
+/* 0x3b */             0,                                              \
+/* 0x3c */             0,                                              \
 /* 0x3d */             "stack-has-slipped",                            \
 /* 0x3e */             "cannot-recurse",                               \
 /* 0x3f */             "process-terminated",                           \

diff --git a/src/microcode/gcloop.c b/src/microcode/gcloop.c
index 6629031d986c7afd78ace21ef1d941919c38c601..2195373e5ba44ab124000aeb1fee5ceb76a6c6a9 100644 (file)
--- a/src/microcode/gcloop.c
+++ b/src/microcode/gcloop.c
@@ -1293,7 +1293,7 @@ gc_type_t gc_type_map [N_TYPE_CODES] =
   GC_VECTOR,                   /* TC_EPHEMERON */
   GC_TRIPLE,                   /* TC_VARIABLE */
   GC_NON_POINTER,              /* TC_THE_ENVIRONMENT */
-  GC_UNDEFINED,                        /* 0x2E */
+  GC_PAIR,                     /* TC_SYNTAX_ERROR */
   GC_VECTOR,                   /* TC_VECTOR_1B,TC_BIT_STRING */
   GC_NON_POINTER,              /* TC_PCOMB0 */
   GC_VECTOR,                   /* TC_VECTOR_16B */

diff --git a/src/microcode/interp.c b/src/microcode/interp.c
index fca00daa4fac1db785f18334ccfc18d30b0a45d0..ff20323c27e20f49d4125234200dd859337b8dd8 100644 (file)
--- a/src/microcode/interp.c
+++ b/src/microcode/interp.c
@@ -569,6 +569,9 @@ Interpret (int pop_return_p)
       PUSH_ENV ();
       PUSH_NTH_THEN (RC_SEQ_3_DO_2, SEQUENCE_1);
 
+    case TC_SYNTAX_ERROR:
+      EVAL_ERROR (ERR_SYNTAX_ERROR);
+
     case TC_THE_ENVIRONMENT:
       SET_VAL (GET_ENV);
       break;

diff --git a/src/microcode/types.h b/src/microcode/types.h
index b39224b20686e7da3cfeb3d956ee8934a19009bf..5f52954de416a2d0f216dbd527f657c9c6fd5c32 100644 (file)
--- a/src/microcode/types.h
+++ b/src/microcode/types.h
@@ -72,7 +72,7 @@ USA.
 #define TC_EPHEMERON                   0x2B
 #define TC_VARIABLE                    0x2C
 #define TC_THE_ENVIRONMENT             0x2D
-/* #define TC_UNUSED                   0x2E */
+#define TC_SYNTAX_ERROR                        0x2E
 #define TC_VECTOR_1B                   0x2F
 #define TC_PCOMB0                      0x30
 #define TC_VECTOR_16B                  0x31
@@ -150,7 +150,7 @@ USA.
   /* 0x2b */                   "ephemeron",                            \
   /* 0x2c */                   "variable",                             \
   /* 0x2d */                   "the-environment",                      \
-  /* 0x2e */                   0,                                      \
+  /* 0x2e */                   "syntax-error",                         \
   /* 0x2f */                   "vector-1b",                            \
   /* 0x30 */                   "primitive-combination-0",              \
   /* 0x31 */                   "vector-16b",                           \

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 205e98aec5bdd06d97b1e7536012e6a8fc7a0e3d..cfc35ca98f434d6df7090e5bf3aebe8be1780740 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3590,6 +3590,7 @@ USA.
          make-definition
          make-delay
          make-quotation
+         make-syntax-error
          make-the-environment
          make-variable
          quotation-expression
@@ -3599,6 +3600,9 @@ USA.
          set-comment-text!
          set-declaration-expression!
          set-declaration-text!
+         syntax-error?
+         syntax-error-message
+         syntax-error-datum
          the-environment?
          variable-components
          variable-name

diff --git a/src/runtime/scode.scm b/src/runtime/scode.scm
index 0e941ca3f3dd2b3526b1deeea649c3dbdf1f65f9..92efdd04f8bb4bc3e8ca762dd9e48940de47cb02 100644 (file)
--- a/src/runtime/scode.scm
+++ b/src/runtime/scode.scm
@@ -93,6 +93,24 @@ USA.
   (guarantee-quotation quotation 'QUOTATION-EXPRESSION)
   (&singleton-element quotation))
 
+;;;; Syntax error
+
+(define (make-syntax-error message datum)
+  (&typed-pair-cons (ucode-type syntax-error) message datum))
+
+(define (syntax-error? object)
+  (object-type? (ucode-type syntax-error) object))
+
+(define-guarantee syntax-error "SCode syntax error")
+
+(define (syntax-error-message syntax-error)
+  (guarantee-syntax-error syntax-error 'syntax-error-message)
+  (system-pair-car syntax-error))
+
+(define (syntax-error-datum syntax-error)
+  (guarantee-syntax-error syntax-error 'syntax-error-datum)
+  (system-pair-cdr syntax-error))
+
 ;;;; Variable
 
 (define (make-variable name)

diff --git a/src/runtime/uerror.scm b/src/runtime/uerror.scm
index 7387ad1773a07158fbe2e6094bf2a1f169f29449..c07b159a361b3cc36f2b0ff94397886d6b6e7648 100644 (file)
--- a/src/runtime/uerror.scm
+++ b/src/runtime/uerror.scm
@@ -43,6 +43,7 @@ USA.
 (define condition-type:primitive-io-error)
 (define condition-type:primitive-procedure-error)
 (define condition-type:process-terminated-error)
+(define condition-type:syntax-error)
 (define condition-type:system-call-error)
 (define condition-type:unimplemented-primitive)
 (define condition-type:unimplemented-primitive-for-os)
@@ -687,17 +688,6 @@ USA.
       (write-operator (access-condition condition 'OPERATOR) port)
       (write-string " signalled an anonymous I/O error." port))))
 
-(define-error-handler 'IO-ERROR
-  (let ((signal
-        (condition-signaller condition-type:primitive-io-error
-                             '(OPERATOR OPERANDS))))
-    (lambda (continuation)
-      (let ((frame (continuation/first-subproblem continuation)))
-       (if (apply-frame? frame)
-           (signal continuation
-                   (apply-frame/operator frame)
-                   (apply-frame/operands frame)))))))
-
 (set! condition-type:out-of-file-handles
   (make-condition-type 'OUT-OF-FILE-HANDLES
       condition-type:primitive-procedure-error
@@ -913,6 +903,25 @@ USA.
       (write (access-condition condition 'DATUM) port)
       (write-string " is not applicable." port))))
 
+(set! condition-type:syntax-error
+  (make-condition-type 'SYNTAX-ERROR condition-type:error
+      '(MESSAGE DATUM)
+      (lambda (condition port)
+       (write-string "Syntax error: " port)
+       (write-string (access-condition condition 'MESSAGE) port)
+       (write (access-condition condition 'DATUM) port))))
+
+(define-error-handler 'SYNTAX-ERROR
+  (let ((signal
+        (condition-signaller condition-type:syntax-error
+                             '(MESSAGE DATUM))))
+    (lambda (continuation)
+      (let ((frame (continuation/first-subproblem continuation)))
+       (let ((expression (eval-frame/expression frame)))
+         (signal continuation
+                 (syntax-error-message expression)
+                 (syntax-error-datum expression)))))))
+
 (define-error-handler 'UNDEFINED-PROCEDURE
   (let ((signal
         (condition-signaller condition-type:inapplicable-object