-- Copyright 1993-1998, by the Cecil Project
-- Department of Computer Science and Engineering, University of Washington
-- See the LICENSE file for license information.


-- evaluation_env's support Cecil program access to its runtime state, for
-- debugging and fast expression evaluation purposes.

abstract object evaluation_env;
  signature lexically_enclosing_env(evaluation_env,
				    if_none:&():evaluation_env):evaluation_env;

  -- these two search the current environment and its lexically enclosing
  -- environments, to find the matching binding of the variable
  method lookup(e@:evaluation_env, s:string, num_params:int,
		if_absent:&():dynamic, if_error:&(string):dynamic):dynamic {
      e.fetch(s, num_params, {
	  lookup(e.lexically_enclosing_env({ ^ eval(if_absent) }),
		 s, num_params, if_absent, if_error)
      }, if_error) }

  method lookup_assign(e@:evaluation_env, s:string, num_params:int,
		       value:dynamic,
		       if_absent:&():void, if_error:&(string):void):void {
      e.assign(s, num_params, value, {
	  lookup_assign(e.lexically_enclosing_env({ ^ eval(if_absent) }),
			s, num_params, value, if_absent, if_error);
      }, if_error);
  }

  -- this finds which environment, if any, defines the variable
  method find_defining_env(e@:evaluation_env, s:string, num_params:int,
			   if_absent:&():evaluation_env,
			   if_error:&(string):evaluation_env):evaluation_env {
      if(e.defines_var(s, num_params, &(s:string){ ^ eval(if_error, s) }), { 
	  e 
      }, {
	  find_defining_env(e.lexically_enclosing_env({ ^ eval(if_absent) }),
			    s, num_params, if_absent, if_error)
      }) }

  -- these three search the current environment only
  signature fetch(evaluation_env, s:string, num_params:int,
		  if_absent:&():dynamic, if_error:&(string):dynamic):dynamic;

  signature assign(evaluation_env, s:string, num_params:int, value:dynamic, 
		   if_absent:&():void, if_error:&(string):void):void;

  signature defines_var(evaluation_env, s:string, num_params:int, 
			if_error:&(string):bool):bool;

  -- this adds a new var decl to the current environment
  method add_var_decl(e@:evaluation_env, name:string, is_constant:bool,
		      value:dynamic, if_error:&(string):none):void {
      eval(if_error,
	   "sorry, cannot add a variable declaration to this environment");
  }


-- a fixed, empty environment that does not support additions
concrete object empty_env isa evaluation_env;
  method lexically_enclosing_env(@:empty_env,
				 if_none:&():evaluation_env):evaluation_env {
      eval(if_none) }
  method fetch(r@:empty_env, s:string, num_params:int,
	       if_absent:&():dynamic, if_error:&(string):dynamic):dynamic {
      eval(if_absent) }
  method assign(r@:empty_env, s:string, num_params:int, value:dynamic, 
		if_absent:&():void, if_error:&(string):void):void {
      eval(if_absent) }
  method defines_var(r@:empty_env, s:string, num_params:int,
		     if_error:&(string):bool):bool { false }
  

prim c_++ {

#ifdef INDEXED_FIELDS
#include "env.h"
#else
extern "C++" {
#include "env.h"
}
#endif

#include <string.h>

#ifdef INDEXED_FIELDS
static int runtime_env_field_offset = -1;
static void lookup_runtime_env_field_offset(OOP p) {
    FieldEntry* e = p->map()->findField("env@anon:runtime_env:");
    if (e == NULL) {
      fatal("expected to find a 'value' field in runtime__env_obj");
    }
    runtime_env_field_offset = e->offset;
}
// note that the env field of a runtime_env object must be an untagged
// CecilEnv* or a tagged CecilHeapEnv*; a user-defined frame is not allowed
inline CecilEnv* getRuntimeEnv(OOP r) {
  if (runtime_env_field_offset == -1) lookup_runtime_env_field_offset(r);
  return GF_OOP(r, runtime_env_field_offset, EnvOOP)->asEnv();
}
#else
inline CecilEnv* getRuntimeEnv(OOP r) {
    return r->asRuntimeEnv()->env->asEnv();
}
#endif
};

-- global_env represents the global Cecil runtime scope

-- want to refer to this from a C++ primitive, so we have to do the
-- extern declaration by hand to get asm codegen to work.  Ugh.
prim c_++: "extern DECL_EXTERN_OBJ(global__env);";

concrete representation global_env isa evaluation_env;
  method print_string(e@:global_env):string { "global_env" }

  method lexically_enclosing_env(@:global_env,
				 if_none:&():evaluation_env):evaluation_env {
      eval(if_none) }

-- to support debugging, etc., we have an "overflow" environment for new
-- global variable declarations that are checked in addition to the regular
-- global variable decls.
-- initially, this is a fixed empty environment, but programs with the
-- evaluator loaded can modify this to be any other evaluation_env object.
  var field extensions(e@:global_env):evaluation_env := empty_env;

  method add_var_decl(e@:global_env, name:string, is_constant:bool,
		      value:dynamic, if_error:&(string):none):void {
      e.extensions.add_var_decl(name, is_constant, value, if_error);
  }

-- lookup a variable binding, in the current env
method fetch(r@:global_env, s:string, num_params:int,
	     if_absent:&():dynamic, if_error:&(string):dynamic):dynamic {
    fetch_internal(r, s, num_params,
		   { r.extensions.fetch(s, num_params, if_absent, if_error) },
		   if_error) }

method fetch_internal(r@:global_env, s:string, num_params:int,
		      if_absent:&():dynamic,
		      if_error:&(string):dynamic):dynamic {
    fetch_internal(r, s.as_vstring, num_params, if_absent, if_error) }

method fetch_internal(r@:global_env, s@:vstring, num_params@:int,
		      if_absent:&():dynamic,
		      if_error:&(string):dynamic):dynamic 
                      (** sends(r1 = eval([if_absent]),
				r2 = eval([if_error],[i_vstring])),
		          return_type(r1,r2,unknown),
		          formals_escape(f,f,f,f,f)**) {
  prim c_++: "
    char* name = VEC_ELEMS(s, char);
    int name_len = NUM_ELEMS(s);
    bool isAbstract;
    bool isConstant;
    bool found;
    OOP* obj = findGlobalObject(name, name_len, num_params->asInt(), 
                                isAbstract, isConstant, found);
    if (found) {
      if(isAbstract) {
	// referencing an abstract or template object
	OOP msg = NEW_STRING(\"accessing abstract object\");
        TAIL_SEND(eval, 0, 2, (if_error, msg), 
                  \"1#fetch_internal(@global_env,@vstring,@int,d,e)\");
      } else if (*obj == UNINITIALIZED_OOP) {
	// referencing an uninitialized variable
	OOP msg = NEW_STRING(\"accessing uninitialized variable\");
        TAIL_SEND(eval, 0, 2, (if_error, msg), 
                  \"2#fetch_internal(@global_env,@vstring,@int,d,e)\");
      } else if (*obj == DELAYED_OOP) {
	// referencing a delayed value
	OOP msg = NEW_STRING(\"accessing delayed value\");
        TAIL_SEND(eval, 0, 2, (if_error, msg),
                  \"3#fetch_internal(@global_env,@vstring,@int,d,e)\");
      } else {
#ifdef DISPATCHERS
        RETURN(*obj);
#else
        BP(*obj);
#endif
      }
    } else {
      // didn't find matching name
      TAIL_SEND(eval, 0, 1, (if_absent),
                \"4#fetch_internal(@global_env,@vstring,@int,d,e)\");
    }
" }

-- modify a variable binding, in the current env
method assign(r@:global_env, s:string, num_params:int, value:dynamic, 
	      if_absent:&():void, if_error:&(string):void):void {
    assign_internal(r, s, num_params, value,
		    { r.extensions.assign(s, num_params, value,
					  if_absent, if_error); },
		    if_error);
}

method assign_internal(r@:global_env, s:string, num_params:int, value:dynamic, 
		       if_absent:&():void, if_error:&(string):void):void {
    assign_internal(r, s.as_vstring, num_params, value, if_absent, if_error);
}

method assign_internal(r@:global_env, s@:vstring, num_params@:int,
		       value:dynamic,
		       if_absent:&():void, if_error:&(string):void):void 
                       (** return_type(void),
			   sends(eval([if_absent]),
				 eval([if_error],[i_vstring])),
			   formals_escape(f,f,f,t,f,f) **) {
    prim c_++: "
char* name = VEC_ELEMS(s, char);
int name_len = NUM_ELEMS(s);
bool found;
bool isAbstract;
bool isConstant;
OOP* obj = findGlobalObject(name, name_len, num_params->asInt(), 
                           isAbstract, isConstant, found);
if (found) {
  if (isConstant || isAbstract) {
    // assigning to a constant
    OOP msg = NEW_STRING(\"assigning to a constant\");
    TAIL_SEND(eval, 0, 2, (if_error, msg), 
              \"1#assign_internal(@global_env,@vstring,@int,d,e,f)\");
  } else {
    *obj = value;
#ifdef DISPATCHERS
    RETURN(BASE(void));
#else
    BP(BASE(void));
#endif
  }
} else {
    // didn't find matching name
    TAIL_SEND(eval, 0, 1, (if_absent),
              \"2#assign_internal(@global_env,@vstring,@int,d,e,f)\");
}
" }


method defines_var(r@:global_env, s:string, num_params:int,
		   if_error:&(string):bool):bool {
    defines_var_internal(r, s, num_params, &(s:string){ ^ eval(if_error, s) }) |
      { r.extensions.defines_var(s, num_params, if_error) } }

method defines_var_internal(r@:global_env, s:string, num_params:int,
			    if_error:&(string):bool):bool {
    defines_var_internal(r, s.as_vstring, num_params, if_error) }

method defines_var_internal(r@:global_env, s@:vstring, num_params@:int,
			    if_error:&(string):bool):bool 
                      (** sends(r = eval([if_error],[i_vstring])),
		          return_type(r,true,false),
		          formals_escape(f,f,f,f)**) {
  prim c_++: "
    char* name = VEC_ELEMS(s, char);
    int name_len = NUM_ELEMS(s);
    bool isAbstract;
    bool isConstant;
    bool found;
    OOP* obj = findGlobalObject(name, name_len, num_params->asInt(), 
                                isAbstract, isConstant, found);
    if (found && isAbstract) {
	// referencing an abstract or template object
	OOP msg = NEW_STRING(\"accessing abstract object\");
        TAIL_SEND(eval, 0, 2, (if_error, msg), 
                  \"1#defines_var_internal(@global_env,@vstring,@int,d)\");
    }
#ifdef DISPATCHERS
    RETURN(found ? BASE(true) : BASE(false));
#else
    BP(found ? BASE(true) : BASE(false));
#endif
" }


-- like fetch, but allow abstract objects to be referenced
-- (used only carefully by the evaluator when processing specializers and
--  directees)
method runtime_object_reference(r@:global_env, s@:string, num_params@:int,
				if_absent:&():dynamic):dynamic {
    runtime_object_reference(r, s.as_vstring, num_params, if_absent) }

method runtime_object_reference(r@:global_env, s@:vstring, num_params@:int,
				if_absent:&():dynamic):dynamic 
                              (** sends(r1 = eval([if_absent])),
			          return_type(r1, unknown),
			          formals_escape(f,f,f,f) **) {
    -- The same as fetch for global_env, except that it can return an abstract
    -- object.  Such an object should not be used in any context except to
    -- pass back to other primitives that expect such objects (e.g. to extend
    -- the method table
  prim c_++: "
    char* name = VEC_ELEMS(s, char);
    int name_len = NUM_ELEMS(s);
    bool isAbstract;
    bool isConstant;
    bool found;
    OOP* obj = findGlobalObject(name, name_len, num_params->asInt(),
			        isAbstract, isConstant, found);
    if (found) {
#ifdef DISPATCHERS
      RETURN(*obj);
#else
      BP(*obj);
#endif
    } else {
      // didn't find matching name
      TAIL_SEND(eval, 0, 1, (if_absent), 
                \"1#runtime_object_reference(@global_env,@vstring,@int,d)\");
    }
" }


-- create an anonymous child of a single parent object
method create_anon_object(r@:global_env, s@:string, num_params@:int,
			  if_absent:&():dynamic):dynamic {
    create_anon_object(r, s.as_vstring, num_params, if_absent) }

method create_anon_object(r@:global_env, s@:vstring, num_params@:int,
			  if_absent:&():dynamic):dynamic 
                               (** sends(r1 = eval([if_absent])),
				   return_type(r1, unknown),
				   formals_escape(f,f,f,f) **) {
  prim c_++: "
    char* name = VEC_ELEMS(s, char);
    int name_len = NUM_ELEMS(s);
    bool isAbstract;
    bool isConstant;
    bool found;
    CecilMap* map =
        findAnonymousMap(name, name_len, num_params->asInt(), found);
    if (found && map->object_creation_routine != NULL) {
      // create an anonymous child of this object
#ifdef DISPATCHERS
      RETURN((*map->object_creation_routine)());
#else
      BP((*map->object_creation_routine)());
#endif
    } else {
      // didn't find matching name
      TAIL_SEND(eval, 0, 1, (if_absent), 
                \"1#create_anon_object(@global_env,@vstring,@int,d)\");
    }
" }


-- runtime_env's represent Cecil runtime scopes on the stack

extend runtime_env isa evaluation_env;

-- return the runtime_env representing the caller's environment
method current_env():runtime_env (** return_type(runtime_env), sends() **) {
    prim c_++ {
        OOP env = NEW_RT_ENV(IF_DEBUG_ELSE(currentEnv->asEnv()->dynamicEnv,
					   GLOBAL_ENV));
#ifdef DISPATCHERS
	RETURN(env);
#else
	BP(env);
#endif
    }
}


-- return the caller of the method that invokes my_caller()
method my_caller(if_none:&():`T):runtime_env|T {
    current_env().caller({ ^ eval(if_none) }).caller(if_none) }

method my_caller():runtime_env|global_env {
    current_env().caller({ ^ global_env }).caller({ global_env }) }


-- return the calling env, or invoke & return if_none if no caller
method caller(r@:runtime_env, if_none:&():`T):runtime_env|T
                      (** sends(r1 = eval([if_none])),
		          return_type(r1, runtime_env),
		          formals_escape(f,f) **) {
    prim c_++: "
#ifdef DEBUG_SUPPORT
CecilEnv* env = getRuntimeEnv(r);
EnvOOP callingEnv = env ? env->dynamicEnv : GLOBAL_ENV;
#else
EnvOOP callingEnv = GLOBAL_ENV;
#endif
if (callingEnv == GLOBAL_ENV) {
    TAIL_SEND(eval, 0, 1, (if_none), \"1#caller(@runtime_env,b\");
} else {
#ifdef DISPATCHERS
    RETURN(NEW_RT_ENV(callingEnv));
#else
    BP(NEW_RT_ENV(callingEnv));
#endif
}
" }


-- return the lexically-enclosing env, or global_env if outermost stack env
method lexically_enclosing_env(r@:runtime_env,
			       if_none:&():evaluation_env):evaluation_env 
            (** return_type(runtime_env,global_env), sends(),
	        formals_escape(f,f) **){
    prim c_++: "
  CecilEnv* env = getRuntimeEnv(r);
  EnvOOP enclosingEnv = env ? env->staticEnv : GLOBAL_ENV;
  OOP res = enclosingEnv == GLOBAL_ENV ? BASE(global__env) :
 	    NEW_RT_ENV(enclosingEnv);
#ifdef DISPATCHERS
  RETURN(res);
#else
  BP(res);
#endif
" }


-- lookup a variable binding, in the current env
method fetch(r@:runtime_env, s:string, num_params:int,
	     if_absent:&():dynamic, if_error:&(string):dynamic):dynamic {
    fetch(r, s.as_vstring, num_params, if_absent, if_error) }

method fetch(r@:runtime_env, s@:vstring, num_params@:int,
	     if_absent:&():dynamic, if_error:&(string):dynamic):dynamic 
          (** sends(r1 = eval([if_absent]), r2 = eval([if_error],[i_vstring])),
	      return_type(r1,r2,unknown),
	      formals_escape(f,f,f,f,f)  **) {

    prim c_++: "
#ifdef DEBUG_SUPPORT
CecilEnv* env = getRuntimeEnv(r);
if (env) {
char* name = VEC_ELEMS(s, char);
int name_len = NUM_ELEMS(s);
CecilDebugInfo* var_info = env->debugInfo();
int num_vars = env->debugInfoSize();
for (int i = 0; i < num_vars; i++) {
    CecilDebugInfo& info = var_info[i];
    if(strncmp(info.name, name, name_len) == 0 && 
       info.name[name_len] == '\\0'
#ifdef DEBUG_INFO_PARAMS
       && info.numParams == num_params->asInt()
#endif
       ) {
        // found it!
	if (info.isAbstract) {
	    // referencing an abstract or template object
	    OOP msg = NEW_STRING(\"accessing abstract object\");
            TAIL_SEND(eval, 0, 2, (if_error, msg),
                      \"1#fetch(@runtime_env,@vstring,@int,d,e)\");
	} else {
#ifdef ENV_REPS
            if (info.rep != OOPRep) {
		// referencing a non-OOP variable
		OOP msg = NEW_STRING(\"accessing a non-OOP variable\");
                TAIL_SEND(eval, 0, 2, (if_error, msg),
                          \"2#fetch(@runtime_env,@vstring,@int,d,e)\");
	    } else {
	        OOP obj;
	        DebugInfoKind k = info.kind();
	        if (k == StackVarKind) {
		    obj = ATENV(env,info.kind_data.offset,OOP);
#ifdef DEBUG_TAGS
	        } else if (k == ConstantKind) {
	            obj = info.kind_data.constant_OOP;
#endif
	        } else {
	            fatal(\"unexpected DebugInfoKind\");
	        }
#else
	        OOP obj = ATENV(env, i);
#endif
                if (obj == UNINITIALIZED_OOP) {
		    // referencing an uninitialized variable
		    OOP msg = NEW_STRING(\"accessing uninitialized variable\");
		    TAIL_SEND(eval, 0, 2, (if_error, msg),
                              \"3#fetch(@runtime_env,@vstring,@int,d,e)\");
		} else if (obj == DELAYED_OOP) {
		    // referencing a delayed value
		    OOP msg = NEW_STRING(\"accessing delayed value\");
		    TAIL_SEND(eval, 0, 2, (if_error, msg),
                              \"4#fetch(@runtime_env,@vstring,@int,d,e)\");
		} else {
#ifdef DISPATCHERS
		    RETURN(obj);
#else
		    BP(obj);
#endif
		}
#ifdef ENV_REPS
	    }
#endif
	}
    }
}
}
#endif
{
    // didn't find matching name
    TAIL_SEND(eval, 0, 1, (if_absent),
              \"5#fetch(@runtime_env,@vstring,@int,d,e)\");
}
" }


-- modify a variable binding
method assign(r@:runtime_env, s:string, num_params:int, value:dynamic, 
	      if_absent:&():void, if_error:&(string):void):void {
    assign(r, s.as_vstring, num_params, value, if_absent, if_error);
}

method assign(r@:runtime_env, s@:vstring, num_params@:int, value:dynamic, 
	      if_absent:&():void, if_error:&(string):void):void 
               (** return_type(void), 
		sends(eval([if_absent]), eval([if_error],[i_vstring])),
		formals_escape(f,f,f,t,f,f) **) {

    prim c_++: "
CecilEnv* env = getRuntimeEnv(r);
#ifdef DEBUG_SUPPORT
if (env) {
char* name = VEC_ELEMS(s, char);
int name_len = NUM_ELEMS(s);
CecilDebugInfo* var_info = env->debugInfo();
int num_vars = env->debugInfoSize();
for (int i = 0; i < num_vars; i++) {
    CecilDebugInfo& info = var_info[i];
    if(strncmp(info.name, name, name_len) == 0 && 
       info.name[name_len] == '\\0'
#ifdef DEBUG_INFO_PARAMS
       && info.numParams == num_params->asInt()
#endif
       ) {
        // found it!
	if (info.isConstant) {
	    // assigning to a constant
	    OOP msg = NEW_STRING(\"assigning to a constant\");
            TAIL_SEND(eval, 0, 2, (if_error, msg),
                      \"1#assign(@runtime_env,@vstring,@int,d,e,f)\");
	} else {
#ifdef ENV_REPS
            if (info.rep != OOPRep) {
		// assigning to a non-OOP variable
		OOP msg = NEW_STRING(\"assigning to a non-OOP variable\");
                TAIL_SEND(eval, 0, 2, (if_error, msg),
                          \"2#assign(@runtime_env,@vstring,@int,d,e,f)\");
	    } else {
		OOP* obj;
	        DebugInfoKind k = info.kind();
	        if (k == StackVarKind) {
		    obj = &ATENV(env,info.kind_data.offset,OOP);
#ifdef DEBUG_TAGS
	        } else if (k == ConstantKind) {
		    // assigning to a constant (after optimization)
		    OOP msg = NEW_STRING(\"assigning to a variable optimized to be a constant\");
	            TAIL_SEND(eval, 0, 2, (if_error, msg),
	                      \"3#assign(@runtime_env,@vstring,@int,d,e,f)\");
#endif
	        } else {
	            fatal(\"unexpected DebugInfoKind\");
	        }
#else
	        OOP* obj = &ATENV(env, i);
#endif
  		*obj = value;
#ifdef DISPATCHERS
		RETURN(BASE(void));
#else
		BP(BASE(void));
#endif
#ifdef ENV_REPS
	    }
#endif
	}
    }
}
}
#endif
{
    // didn't find matching name
    TAIL_SEND(eval, 0, 1, (if_absent),
              \"4#assign(@runtime_env,@vstring,@int,d,e,f)\");
}
" }

method defines_var(r@:runtime_env, s:string, num_params:int,
		   if_error:&(string):bool):bool {
    defines_var(r, s.as_vstring, num_params, if_error) }

method defines_var(r@:runtime_env, s@:vstring, num_params@:int,
		   if_error:&(string):bool):bool 
                      (** sends(r = eval([if_error],[i_vstring])),
		          return_type(r,true,false),
		          formals_escape(f,f,f,f)**) {
    prim c_++: "
    CecilEnv* env = getRuntimeEnv(r);
#ifdef DEBUG_SUPPORT
    if (env) {
        char* name = VEC_ELEMS(s, char);
        int name_len = NUM_ELEMS(s);
        CecilDebugInfo* var_info = env->debugInfo();
        int num_vars = env->debugInfoSize();
        for (int i = 0; i < num_vars; i++) {
            CecilDebugInfo& info = var_info[i];
            if(strncmp(info.name, name, name_len) == 0 && 
               info.name[name_len] == '\\0'
#ifdef DEBUG_INFO_PARAMS
               && info.numParams == num_params->asInt()
#endif
               ) {
                    // found it!
#ifdef DISPATCHERS
                    RETURN(BASE(true));
#else
                    BP(BASE(true));
#endif
            }
        }
    }
#endif
    // didn't find matching name
#ifdef DISPATCHERS
    RETURN(BASE(false));
#else
    BP(BASE(false));
#endif
" }



-- the type of objects that can be used as environments when performing
-- interpreted sends, etc.
type extension_evaluation_env subtypes evaluation_env;
  signature lexically_enclosing_env(extension_evaluation_env):evaluation_env;
  signature calling_env(extension_evaluation_env):evaluation_env;
  signature procedure_name(extension_evaluation_env):vstring;
  signature procedure_name(extension_evaluation_env):vstring;
  signature source_file_name(extension_evaluation_env):vstring;
  signature line_num(extension_evaluation_env):int;
  signature num_formals(extension_evaluation_env):int;
  signature num_locals(extension_evaluation_env):int;
  signature var_name(extension_evaluation_env, int):vstring;
  signature print_short_var_value(extension_evaluation_env, int):void;
  signature print_full_var_value(extension_evaluation_env, int):void;


-- the type of objects that can be installed as runtime extension methods
type runtime_extension_method;
  signature runtime_extension(meth:runtime_extension_method, 
			      args:vector[dynamic], 
			      has_interrupt:bool):void;


-- This routine allows the method table to be extended at runtime with 
-- method objects that are then interpreted.  The client supplies a 
-- msg name, the number of params, and a vector of specializers to define
-- the header of the object.  They also supply an object that is to be
-- used as the first argument of a 'runtime_extension' message.  The second
-- argument will contain a vector of the actuals of the call.
method extend_method_table(meth_name_oop:string, num_params@:int, 
			   specializers:ordered_collection[dynamic],
			   method_object:runtime_extension_method,
			   if_error:&():bool):bool {
    extend_method_table(meth_name_oop.as_vstring, num_params, 
			specializers.as_vector, method_object, if_error) }

prim c_++ {
#include "selectors.h"
};

method extend_method_table(meth_name_oop@:vstring, num_params@:int, 
			   specializers@:vector[dynamic], 
			   method_object:runtime_extension_method,
			   if_error:&():bool
			   ):bool(** sends(r1 = eval([if_error])),
				     return_type(r1,true,false),
				     formals_escape(f,f,f,t,f) **) {
    prim c_++: "
      char* meth_name = AS_C_STRING(meth_name_oop);
      int num_args = NUM_ELEMS(specializers);
      OOP* vs = VEC_ELEMS(specializers,OOP);
      OOP buffer[30];
      OOPList* specializersOOPList = (OOPList*) &buffer;
      for (int i = 0; i < num_args; i++) {
	  (*specializersOOPList)[i] = vs[i];
      }
      RegisteredOOPList specializersOOPList_(specializersOOPList, num_args);

      // Find selector, or allocate a new one if needed
      int selector = findSelector(meth_name, num_params->asInt(), 
                                  num_args, true);

      bool replaced;
      if (!extendMethodTable(selector, specializersOOPList, 
                             method_object, replaced)) {
        // Bummer.  Didn't work
        TAIL_SEND(eval, 0, 1, (if_error),
                  \"1#extend_method_table(@vstring,@int,@vector[A],d,e)\");
      } else {
#ifdef DISPATCHERS
        RETURN(replaced ? BASE(true) : BASE(false));
#else
        BP(replaced ? BASE(true) : BASE(false));
#endif
      }
" }