From d18dd95c1f20b4548de4bf2049f18e58937b43da Mon Sep 17 00:00:00 2001
From: Gareth Rees <gdr@ravenbrook.com>
Date: Fri, 2 Nov 2012 19:12:58 +0000
Subject: [PATCH] Integrate error implementation from scheme-malloc.c.

Copied from Perforce
 Change: 180293
 ServerID: perforce.ravenbrook.com
---
 mps/example/scheme/scheme.c | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/mps/example/scheme/scheme.c b/mps/example/scheme/scheme.c
index 29e68f396d3..c56092a8139 100644
--- a/mps/example/scheme/scheme.c
+++ b/mps/example/scheme/scheme.c
@@ -2949,6 +2949,17 @@ static obj_t entry_eval(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
 }
 
 
+static obj_t entry_error(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
+{
+  obj_t msg;
+  eval_args(operator->operator.name, env, op_env, operands, 1, &msg);
+  unless(TYPE(msg) == TYPE_STRING)
+    error("%s: argument must be a string", operator->operator.name);
+  error(msg->string.string);
+  return obj_undefined;
+}
+
+
 static obj_t entry_symbol_to_string(obj_t env, obj_t op_env, obj_t operator, obj_t operands)
 {
   obj_t symbol;
@@ -3584,6 +3595,7 @@ static struct {char *name; entry_t entry;} funtab[] = {
   {"list->vector", entry_list_to_vector},
   {"vector-fill!", entry_vector_fill},
   {"eval", entry_eval},
+  {"error", entry_error},
   {"symbol->string", entry_symbol_to_string},
   {"string->symbol", entry_string_to_symbol},
   {"string?", entry_stringp},