/* Part of XPCE --- The SWI-Prolog GUI toolkit Author: Jan Wielemaker and Anjo Anjewierden E-mail: jan@swi.psy.uva.nl WWW: http://www.swi.psy.uva.nl/projects/xpce/ Copyright (c) 1985-2002, University of Amsterdam All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #ifdef __WINDOWS__ #define USE_WIN32_CRITICAL_SECTION #endif #define _GNU_SOURCE 1 /* for recursive mutexes */ #define INLINE_UTILITIES 1 #include #include #include /* Win32 native locking */ #ifdef USE_WIN32_CRITICAL_SECTION #define HAS_LOCK 1 static CRITICAL_SECTION mutex; int lock_count; DWORD lock_owner; int pceMTTryLock(int lock) { if ( XPCE_mt == TRUE ) { if ( TryEnterCriticalSection(&mutex) ) /* NT 4 and later! */ { if ( lock_count++ == 0 ) lock_owner = GetCurrentThreadId(); return TRUE; } else return FALSE; } return TRUE; } static inline void LOCK() { if ( XPCE_mt == TRUE ) { EnterCriticalSection(&mutex); if ( lock_count++ == 0 ) lock_owner = GetCurrentThreadId(); } } static inline void UNLOCK() { if ( XPCE_mt == TRUE ) { if ( --lock_count == 0 ) lock_owner = 0; LeaveCriticalSection(&mutex); } } #define Code SWI_Code #include static foreign_t pce_lock_owner(term_t owner, term_t count) { if ( PL_unify_integer(owner, lock_owner) && PL_unify_integer(count, lock_count) ) return TRUE; return FALSE; } int pceMTinit() { InitializeCriticalSection(&mutex); XPCE_mt = TRUE; PL_register_foreign("pce_lock_owner", 2, pce_lock_owner, 0); succeed; } #endif /*USE_WIN32_CRITICAL_SECTION*/ /* POSIX thread based locking */ #if defined(_REENTRANT) && !defined(HAS_LOCK) #define HAS_LOCK 1 #define var pthread_sys_var /* avoid AIX name conflict */ #include #undef var #ifdef PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP static pthread_mutex_t mutex = PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP; #define LOCK() \ if ( XPCE_mt ) pthread_mutex_lock(&mutex) #define UNLOCK() \ if ( XPCE_mt ) pthread_mutex_unlock(&mutex) int pceMTTryLock(int lock) { if ( XPCE_mt == TRUE ) { if ( pthread_mutex_trylock(&mutex) != 0 ) return FALSE; } return TRUE; } #else /*PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP*/ typedef struct _mutex_t { pthread_t owner; int count; pthread_mutex_t lock; } recursive_mutex_t; #define RECURSIVE_MUTEX_INIT { 0, 0, PTHREAD_MUTEX_INITIALIZER } static recursive_mutex_t mutex = RECURSIVE_MUTEX_INIT; static inline void LOCK() { if ( XPCE_mt ) { if ( mutex.owner != pthread_self() ) { pthread_mutex_lock(&(mutex.lock)); mutex.owner = pthread_self(); mutex.count = 1; } else mutex.count++; } } static inline void UNLOCK() { if ( XPCE_mt ) { if ( mutex.owner == pthread_self() ) { if ( --mutex.count < 1 ) { mutex.owner = 0; pthread_mutex_unlock(&(mutex.lock)); } } else assert(0); } } int pceMTTryLock(int lock) { if ( XPCE_mt ) { if ( mutex.owner != pthread_self() ) { if ( pthread_mutex_trylock(&(mutex.lock)) != 0 ) return FALSE; mutex.owner = pthread_self(); mutex.count = 1; } else mutex.count++; } return TRUE; } #endif /*PTHREAD_RECURSIVE_MUTEX_INITIALIZER_NP*/ int pceMTinit() { XPCE_mt = TRUE; succeed; } #endif /*_REENTRANT*/ /* No threading */ #ifndef HAS_LOCK #define LOCK() #define UNLOCK() int /* signal we can't do this */ pceMTinit() { fail; } int pceMTTryLock(int lock) { return TRUE; } #endif void pceMTLock(int lock) { LOCK(); } void pceMTUnlock(int lock) { UNLOCK(); } #define pushGoal(g) { LOCK(); \ (g)->parent = CurrentGoal; \ CurrentGoal = g; \ } #define popGoal(g) { CurrentGoal = (g)->parent; \ UNLOCK(); \ } int pceSetErrorGoal(PceGoal g, int err, ...) { va_list args; if ( g->errcode != PCE_ERR_OK ) fail; g->errcode = err; va_start(args, err); switch(err) { case PCE_ERR_OK: case PCE_ERR_NO_BEHAVIOUR: case PCE_ERR_TOO_MANY_ARGS: break; case PCE_ERR_ARGTYPE: case PCE_ERR_RETTYPE: case PCE_ERR_ANONARG_AFTER_NAMED: g->errc1 = va_arg(args, PceObject); /* argument value */ break; case PCE_ERR_NO_NAMED_ARGUMENT: g->errc1 = va_arg(args, PceObject); /* argument name */ break; case PCE_ERR_MISSING_ARGUMENT: g->errc1 = va_arg(args, PceObject); /* index of missing arg */ break; case PCE_ERR_CODE_AS_GETMETHOD: g->errc1 = va_arg(args, PceObject); /* offending code object */ break; case PCE_ERR_PERMISSION: g->errc1 = va_arg(args, PceObject); /* offending operation */ break; case PCE_ERR_FUNCTION_FAILED: g->errc1 = va_arg(args, PceObject); /* failing function */ break; case PCE_ERR_ERROR: break; } va_end(args); fail; } static Method getMethodMethodList(Any list, Name sel) { if ( instanceOfObject(list, ClassMethod) ) { Method m = list; if ( m->name == sel ) answer(m); fail; } else if ( instanceOfObject(list, ClassChain) ) { Chain ch = list; Cell cell; Method m; for_cell(cell, ch) { if ( (m = getMethodMethodList(cell->value, sel)) ) answer(m); } fail; } else { errorPce(list, NAME_unexpectedType, CtoType("method|chain")); fail; } } static Method getCatchAllMethodGoal(PceGoal g) { Class cl = g->class; Method m, *mp; if ( !cl ) cl = classOfObject(g->receiver); mp = ((g->flags & PCE_GF_SEND) ? (Method *)&cl->send_catch_all : (Method *)&cl->get_catch_all); m = *mp; if ( isDefault(m) ) { if ( g->flags & PCE_GF_SEND ) m = getSendMethodClass(cl, NAME_catchAll); else m = getGetMethodClass(cl, NAME_catchAll); if ( m ) { setDFlag(m, D_TYPENOWARN); assignField((Instance)cl, (Any *)mp, m); } else assignField((Instance)cl, (Any *)mp, NIL); } if ( notNil(m) ) return m; return NULL; } static status resolveImplementationGoal(PceGoal g) { Any m; Any obj = g->receiver; int issend = (g->flags & PCE_GF_SEND); if ( isInteger(obj) ) g->receiver = obj = answerObject(ClassNumber, obj, EAV); if ( !g->class ) { if ( onFlag(obj, F_ACTIVE|F_ATTRIBUTE|F_SENDMETHOD|F_GETMETHOD) ) { while( isFunction(obj) ) { m = (issend ? getSendMethodFunction(obj, g->selector) : getGetMethodFunction(obj, g->selector)); if ( m ) { g->implementation = m; succeed; } if ( (obj = getExecuteFunction((Function) obj)) ) { if ( isInteger(obj) ) obj = answerObject(ClassNumber, obj, EAV); g->receiver = obj; } else return pceSetErrorGoal(g, PCE_ERR_FUNCTION_FAILED, obj); } if ( onFlag(obj, F_SENDMETHOD|F_GETMETHOD) ) { Chain ch; if ( issend ) ch = getAllSendMethodsObject(obj, OFF); else ch = getAllGetMethodsObject(obj, OFF); if ( ch && (m = getMethodMethodList(ch, g->selector)) ) { g->implementation = m; succeed; } } if ( onFlag(obj, F_ATTRIBUTE) ) { Chain ch = getAllAttributesObject(obj, ON); Cell cell; for_cell(cell, ch) { Attribute att = cell->value; if ( att->name == g->selector ) { g->implementation = att; succeed; } } } } g->class = classOfObject(obj); } if ( issend ) m = getSendMethodClass(g->class, g->selector); else m = getGetMethodClass(g->class, g->selector); if ( m ) { g->implementation = m; succeed; } else { Chain delegate = g->class->delegate; Cell cell; Class old = g->class; for_cell(cell, delegate) { Variable var = cell->value; Any val; if ( (val = getGetVariable(var, obj)) ) { g->receiver = val; g->class = NULL; if ( resolveImplementationGoal(g) && !(g->flags & PCE_GF_CATCHALL) ) succeed; g->flags &= ~PCE_GF_CATCHALL; g->errcode = PCE_ERR_OK; } } g->class = old; g->receiver = obj; } if ( (m=getCatchAllMethodGoal(g)) ) { g->flags |= PCE_GF_CATCHALL; g->implementation = m; succeed; } g->implementation = NIL; /* so isProperGoal() succeeds */ g->errcode = PCE_ERR_NO_BEHAVIOUR; /* cause this need not be fatal */ /*return pceSetErrorGoal(g, PCE_ERR_NO_BEHAVIOUR);*/ fail; } status pceResolveImplementation(PceGoal g) { g->va_allocated = 0; g->va_type = NULL; g->argn = 0; if ( !resolveImplementationGoal(g) ) fail; pushGoal(g); if ( objectIsInstanceOf(g->implementation, ClassMethod) ) { Method m = g->implementation; g->argc = valInt(m->types->size); g->types = (PceType *)m->types->elements; if ( g->argc > 0 && g->types[g->argc-1]->vector == ON ) { g->va_type = g->types[g->argc-1]; g->argc--; g->va_argc = 0; } if ( g->flags & PCE_GF_GET ) { GetMethod gm = (GetMethod)m; g->return_type = gm->return_type; } if ( onDFlag(m, D_HOSTMETHOD) ) g->flags |= PCE_GF_HOST; } else /* TBD: reorganise hierarchy! */ { if ( g->flags & PCE_GF_SEND ) { g->argc = 1; if ( objectIsInstanceOf(g->implementation, ClassObjOfVariable) ) { Variable v = g->implementation; g->types = &v->type; } else if ( objectIsInstanceOf(g->implementation, ClassClassVariable) ) { ClassVariable cv = g->implementation; g->types = &cv->type; } else /* Attribute */ { g->types = &TypeAny; } } else { g->argc = 0; } } succeed; } void pceInitArgumentsGoal(PceGoal g) { int an = g->argc; PceObject *ap; if ( an <= PCE_GOAL_DIRECT_ARGS ) ap = g->_av; else { ap = alloc(an*sizeof(PceObject)); g->flags |= PCE_GF_ALLOCATED; } g->argv = ap; while( --an >= 0 ) *ap++ = NULL; if ( (g->flags & PCE_GF_CATCHALL) && !(g->flags & PCE_GF_HOSTARGS) ) pcePushArgument(g, g->selector); } void pceVaAddArgGoal(PceGoal g, Any value) { if ( g->va_argc >= g->va_allocated ) { if ( g->va_allocated ) { int nsize = g->va_allocated*2; Any *nav = alloc(nsize * sizeof(Any)); cpdata(nav, g->va_argv, Any, g->va_allocated); unalloc(g->va_allocated*sizeof(Any), g->va_argv); g->va_argv = nav; g->va_allocated = nsize; } else { g->va_allocated = 8; g->va_argv = alloc(g->va_allocated * sizeof(Any)); g->flags |= PCE_GF_VA_ALLOCATED; } } g->va_argv[g->va_argc++] = value; } void pcePushGoal(PceGoal g) { pushGoal(g); } void pceFreeGoal(PceGoal g) { if ( g == CurrentGoal ) { popGoal(g); if ( g->flags & (PCE_GF_ALLOCATED|PCE_GF_VA_ALLOCATED) ) { if ( g->flags & PCE_GF_ALLOCATED ) unalloc(g->argc * sizeof(Any), g->argv); if ( g->flags & PCE_GF_VA_ALLOCATED ) unalloc(g->va_allocated*sizeof(Any), g->va_argv); } } } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - pcePushArgument(PceGoal g, Any argument) Push anonymous argument. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ int pcePushArgument(PceGoal g, Any arg) { if ( g->argn >= 0 ) { if ( g->argn < g->argc ) { Type t = g->types[g->argn]; Any v = checkType(arg, t, g->receiver); if ( v ) { g->argv[g->argn++] = v; succeed; } else { err_argtype: if ( offDFlag(g->implementation, D_TYPENOWARN) ) pceSetErrorGoal(g, PCE_ERR_ARGTYPE, arg); fail; } } else { if ( g->va_type ) { Any v = checkType(arg, g->va_type, g->receiver); if ( v ) { pceVaAddArgGoal(g, v); succeed; } else goto err_argtype; } else { if ( offDFlag(g->implementation, D_TYPENOWARN) ) pceSetErrorGoal(g, PCE_ERR_TOO_MANY_ARGS); fail; } } } else return pceSetErrorGoal(g, PCE_ERR_ANONARG_AFTER_NAMED, arg); } int pcePushNamedArgument(PceGoal g, PceName name, Any arg) { int i; if ( !name ) return pcePushArgument(g, arg); if ( g->argn >= g->argc && g->va_type ) return pcePushArgument(g, answerObject(ClassBinding, name, arg, EAV)); for(i=0; iargc; i++) { if ( g->types[i]->argument_name == name ) { Any v = checkType(arg, g->types[i], g->receiver); g->argn = -1; if ( v ) { g->argv[i] = v; succeed; } else { if ( offDFlag(g->implementation, D_TYPENOWARN) ) { g->argn = i; pceSetErrorGoal(g, PCE_ERR_ARGTYPE, arg); } fail; } } } pceSetErrorGoal(g, PCE_ERR_NO_NAMED_ARGUMENT, name); return FALSE; } static inline int fillDefaultsGoal(PceGoal g) { int n = g->argc; int i; for(i=0; iargv[i] ) { PceObject val; if ( (val = checkType(DEFAULT, g->types[i], g->receiver)) ) g->argv[i] = val; else { if ( offDFlag(g->implementation, D_TYPENOWARN) ) pceSetErrorGoal(g, PCE_ERR_MISSING_ARGUMENT, toInt(i)); fail; } } } succeed; } /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - status pceExecuteGoal(g) Execute the goal. For get-goals, the return-value is stored in g->rval. Success/failure of the goal is indicated using the return value of this function. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */ #ifdef O_RUNTIME #define DEBUGGER(g) #else #define DEBUGGER(g) if ( PCEdebugging ) g #endif typedef Any (*ExecFunc0)(Any r, int vaac, Any *vaav); typedef Any (*ExecFunc1)(Any r, Any, int vaac, Any *vaav); typedef Any (*ExecFunc2)(Any r, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc3)(Any r, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc4)(Any r, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc5)(Any r, Any, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc6)(Any r, Any, Any, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc7)(Any r, Any, Any, Any, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc8)(Any r, Any, Any, Any, Any, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc9)(Any r, Any, Any, Any, Any, Any, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*ExecFunc10)(Any r, Any, Any, Any, Any, Any, Any, Any, Any, Any, Any, int vaac, Any *vaav); typedef Any (*GetFunc0)(Any r); typedef Any (*GetFunc1)(Any r, Any); typedef Any (*GetFunc2)(Any r, Any, Any); typedef Any (*GetFunc3)(Any r, Any, Any, Any); typedef Any (*GetFunc4)(Any r, Any, Any, Any, Any); typedef Any (*GetFunc5)(Any r, Any, Any, Any, Any, Any); typedef Any (*GetFunc6)(Any r, Any, Any, Any, Any, Any, Any); typedef Any (*GetFunc7)(Any r, Any, Any, Any, Any, Any, Any, Any); typedef Any (*GetFunc8)(Any r, Any, Any, Any, Any, Any, Any, Any, Any); typedef Any (*GetFunc9)(Any r, Any, Any, Any, Any, Any, Any, Any, Any, Any); typedef Any (*GetFunc10)(Any r, Any, Any, Any, Any, Any, Any, Any, Any, Any, Any); typedef Any (*GetFunc11)(Any r, Any, Any, Any, Any, Any, Any, Any, Any, Any, Any, Any); status pceExecuteGoal(PceGoal g) { if ( !fillDefaultsGoal(g) ) { pceReportErrorGoal(g); fail; } if ( objectIsInstanceOf(g->implementation, ClassMethod) ) { status rval; Method m = g->implementation; void *prof_node; DEBUGGER(pcePrintEnterGoal(g)); if ( PceProfile.call ) prof_node = (*PceProfile.call)(g->implementation, PceProfile.handle); else prof_node = NULL; if ( m->function ) { Any r = g->receiver; Func f = m->function; Any *a = g->argv; Any fval; if ( g->va_type ) { int vaac = g->va_argc; Any *vaav = g->va_argv; switch(g->argc) { case 0: fval = (*(ExecFunc0)f)(r, vaac, vaav); break; case 1: fval = (*(ExecFunc1)f)(r, a[0], vaac, vaav); break; case 2: fval = (*(ExecFunc2)f)(r, a[0], a[1], vaac, vaav); break; case 3: fval = (*(ExecFunc3)f)(r, a[0], a[1], a[2], vaac, vaav); break; case 4: fval = (*(ExecFunc4)f)(r, a[0], a[1], a[2], a[3], vaac, vaav); break; case 5: fval = (*(ExecFunc5)f)(r, a[0], a[1], a[2], a[3], a[4], vaac, vaav); break; case 6: fval = (*(ExecFunc6)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], vaac, vaav); break; case 7: fval = (*(ExecFunc7)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], vaac, vaav); break; case 8: fval = (*(ExecFunc8)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], vaac, vaav); break; case 9: fval = (*(ExecFunc9)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], vaac, vaav); break; case 10: fval = (*(ExecFunc10)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], vaac, vaav); break; default: fval = (Any)FAIL; assert(0); } } else { switch(g->argc) { case 0: fval = (*(GetFunc0)f)(r); break; case 1: fval = (*(GetFunc1)f)(r, a[0]); break; case 2: fval = (*(GetFunc2)f)(r, a[0], a[1]); break; case 3: fval = (*(GetFunc3)f)(r, a[0], a[1], a[2]); break; case 4: fval = (*(GetFunc4)f)(r, a[0], a[1], a[2], a[3]); break; case 5: fval = (*(GetFunc5)f)(r, a[0], a[1], a[2], a[3], a[4]); break; case 6: fval = (*(GetFunc6)f)(r, a[0], a[1], a[2], a[3], a[4], a[5]); break; case 7: fval = (*(GetFunc7)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6]); break; case 8: fval = (*(GetFunc8)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7]); break; case 9: fval = (*(GetFunc9)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); break; case 10: fval = (*(GetFunc10)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9]); break; case 11: fval = (*(GetFunc11)f)(r, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8], a[9], a[10]); break; default: fval = (Any)FAIL; assert(0); } } /* end of function-implemation */ if ( fval ) { if ( g->flags & PCE_GF_GET ) g->rval = fval; rval = SUCCEED; } else rval = FAIL; } else /* not a C-function */ { if ( objectIsInstanceOf(m->message, ClassCode) ) { /* A function object */ if ( objectIsInstanceOf(m->message, ClassFunction) ) { Any fval; Function f = (Function)m->message; if ( g->va_type ) { Any cv = createCodeVectorv(g->va_argc, g->va_argv); ArgVector(av, g->argc+1); int i; for(i=0; iargc; i++) av[i] = g->argv[i]; av[i] = cv; addCodeReference(cv); withReceiver(g->receiver, m->context, fval = getForwardFunctionv(f, i, av)); delCodeReference(cv); doneCodeVector(cv); } else { withReceiver(g->receiver, m->context, fval = getForwardFunctionv(f, g->argc, g->argv)); } if ( fval ) { if ( g->flags & PCE_GF_GET ) g->rval = fval; rval = SUCCEED; } else rval = FAIL; } else /* a procedure (code) object */ { if ( g->flags & PCE_GF_GET ) { pceSetErrorGoal(g, PCE_ERR_CODE_AS_GETMETHOD, m->message); rval = FAIL; goto out; } if ( g->va_type ) { Any cv = createCodeVectorv(g->va_argc, g->va_argv); ArgVector(av, g->argc+1); int i; for(i=0; iargc; i++) av[i] = g->argv[i]; av[i] = cv; addCodeReference(cv); withReceiver(g->receiver, m->context, rval = forwardCodev(m->message, i, av)); delCodeReference(cv); doneCodeVector(cv); } else { withReceiver(g->receiver, m->context, rval = forwardCodev(m->message, g->argc, g->argv)); } } } else rval = hostCall(g); } out: if ( prof_node && PceProfile.exit ) (*PceProfile.exit)(prof_node); DEBUGGER(pcePrintReturnGoal(g, rval)); return rval; /* end of method-implemtation */ } else if ( objectIsInstanceOf(g->implementation, ClassObjOfVariable) ) { Variable var = g->implementation; Any *field = &(((Instance)g->receiver)->slots[valInt(var->offset)]); if ( g->flags & PCE_GF_SEND ) assignField(g->receiver, field, g->argv[0]); else { if ( isClassDefault(*field) ) { Any v = getGetVariable(var, g->receiver); if ( v ) g->rval = v; else { DEBUGGER(pcePrintReturnGoal(g, FAIL)); fail; } } else g->rval = *field; DEBUGGER(pcePrintReturnGoal(g, SUCCEED)); } succeed; } else if ( objectIsInstanceOf(g->implementation, ClassClassVariable) ) { ClassVariable cv = g->implementation; if ( g->flags & PCE_GF_SEND ) { return pceSetErrorGoal(g, PCE_ERR_PERMISSION, NAME_write); } else { g->rval = getValueClassVariable(cv); DEBUGGER(pcePrintReturnGoal(g, SUCCEED)); succeed; } } else if ( objectIsInstanceOf(g->implementation, ClassAttribute) ) { Attribute a = g->implementation; DEBUGGER(pcePrintReturnGoal(g, SUCCEED)); if ( g->flags & PCE_GF_SEND ) assign(a, value, g->argv[0]); else g->rval = a->value; succeed; } assert(0); fail; } static int getNamedArgument(Any obj, Name *an, Any *av) { if ( isObject(obj) && onFlag(obj, F_ISBINDING) ) { Binding b = obj; *an = b->name; *av = b->value; succeed; } fail; } void pceReportErrorGoal(PceGoal g) { int pushed; if ( g->flags & PCE_GF_THROW ) /* already an exception pending! */ return; if ( CurrentGoal != g ) /* if there is no implementation */ { pushGoal(g); pushed = TRUE; } else pushed = FALSE; switch(g->errcode) { case PCE_ERR_OK: break; case PCE_ERR_NO_BEHAVIOUR: { Name arrow = ((g->flags & PCE_GF_SEND) ? CtoName("->") : CtoName("<-")); g->argc = 0; /* make the goal argument sane */ g->va_type = 0; errorPce(g->receiver, NAME_noBehaviour, arrow, g->selector); break; } case PCE_ERR_ARGTYPE: { int an = g->argn; Type t = g->types[an]; errorTypeMismatch(g->receiver, g->implementation, an+1, t, g->errc1); break; } case PCE_ERR_RETTYPE: errorPce(g->implementation, NAME_badReturnValue, g->errc1, g->return_type); break; case PCE_ERR_TOO_MANY_ARGS: errorPce(g->implementation, NAME_argumentCount, toInt(g->argc)); break; case PCE_ERR_ANONARG_AFTER_NAMED: errorPce(g->implementation, NAME_unboundAfterBoundArgument); break; case PCE_ERR_NO_NAMED_ARGUMENT: errorPce(g->implementation, NAME_noNamedArgument, g->errc1); break; case PCE_ERR_MISSING_ARGUMENT: { int an = valInt(g->errc1); Type t = g->types[an]; Name argname; if ( instanceOfObject(g->implementation, ClassObjOfVariable) ) { Variable v = g->implementation; argname = v->name; } else { argname = t->argument_name; if ( isNil(argname) ) argname = CtoName("?"); } errorPce(g->implementation, NAME_missingArgument, toInt(an+1), argname, getNameType(t)); break; } case PCE_ERR_FUNCTION_FAILED: /* this is not (yet) reported */ break; case PCE_ERR_ERROR: break; default: Cprintf("Unknown error: %d\n", g->errcode); } if ( pushed ) popGoal(g); } status vm_send(Any receiver, Name selector, Class class, int argc, const Any argv[]) { pce_goal g; g.va_argc = 0; g.flags = PCE_GF_SEND; g.receiver = receiver; g.class = class; g.selector = selector; g.errcode = PCE_ERR_OK; if ( pceResolveImplementation(&g) ) { int i; status rval; pceInitArgumentsGoal(&g); for(i=0; iname; g.va_allocated = 0; g.va_argc = 0; g.argn = 0; g.flags = PCE_GF_SEND; g.receiver = receiver; g.implementation = sm; g.errcode = PCE_ERR_OK; if ( onDFlag(sm, D_HOSTMETHOD) ) g.flags |= PCE_GF_HOST; pushGoal(&g); g.argc = valInt(sm->types->size); g.types = (PceType *)sm->types->elements; if ( g.argc > 0 && g.types[g.argc-1]->vector == ON ) { g.va_type = g.types[g.argc-1]; g.argc--; g.va_argc = 0; } else { g.va_type = NULL; } /* and this is as vm_send() */ pceInitArgumentsGoal(&g); for(i=0; iname; g.va_allocated = 0; g.va_argc = 0; g.argn = 0; g.flags = PCE_GF_GET; g.receiver = receiver; g.implementation = gm; g.errcode = PCE_ERR_OK; g.return_type = gm->return_type; if ( onDFlag(gm, D_HOSTMETHOD) ) g.flags |= PCE_GF_HOST; g.argc = valInt(gm->types->size); g.types = (PceType *)gm->types->elements; if ( g.argc > 0 && g.types[g.argc-1]->vector == ON ) { g.va_type = g.types[g.argc-1]; g.argc--; g.va_argc = 0; } else { g.va_type = NULL; } /* and this is as vm_get() */ pceInitArgumentsGoal(&g); for(i=0; iargn >= g->argc && g->va_type ) { *type = g->va_type; *ai = -1; /* Means use vararg list */ succeed; } g->argn = -1; for(i=0; iargc; i++) { if ( g->types[i]->argument_name == name ) { *type = g->types[i]; *ai = i; succeed; } } return pceSetErrorGoal(g, PCE_ERR_NO_NAMED_ARGUMENT, name); } if ( g->argn >= 0 ) { if ( g->argn < g->argc ) { *type = g->types[g->argn]; *ai = g->argn++; succeed; } else { if ( g->va_type ) { *type = g->types[g->argn]; *ai = -1; succeed; } else { if ( offDFlag(g->implementation, D_TYPENOWARN) ) pceSetErrorGoal(g, PCE_ERR_TOO_MANY_ARGS); fail; } } } else return pceSetErrorGoal(g, PCE_ERR_ANONARG_AFTER_NAMED, NIL); } #undef sendv status sendv(Any receiver, Name selector, int argc, Any *argv) { return vm_send(receiver, selector, NULL, argc, argv); } typedef status (*SendFunc0)(Any r); typedef status (*SendFunc1)(Any r, Any); typedef status (*SendFunc2)(Any r, Any, Any); typedef status (*SendFunc3)(Any r, Any, Any, Any); typedef status (*SendFunc4)(Any r, Any, Any, Any, Any); typedef status (*SendFunc5)(Any r, Any, Any, Any, Any, Any); typedef status (*SendFunc6)(Any r, Any, Any, Any, Any, Any, Any); status /* QuickAndDirtySend */ qadSendv(Any r, Name selector, int ac, Any *av) { SendMethod implementation = getSendMethodClass(classOfObject(r), selector); SendFunc f; if ( instanceOfObject(implementation, ClassSendMethod) && (f=implementation->function) && offDFlag(implementation, D_CXX|D_TRACE|D_BREAK)) { switch(ac) { case 0: return (*(SendFunc0)f)(r); case 1: return (*(SendFunc1)f)(r, av[0]); case 2: return (*(SendFunc2)f)(r, av[0],av[1]); case 3: return (*(SendFunc3)f)(r, av[0],av[1],av[2]); case 4: return (*(SendFunc4)f)(r, av[0],av[1],av[2],av[3]); case 5: return (*(SendFunc5)f)(r, av[0],av[1],av[2],av[3],av[4]); case 6: return (*(SendFunc6)f)(r, av[0],av[1],av[2],av[3],av[4],av[5]); } } return vm_send(r, selector, classOfObject(r), ac, av); } #undef getv Any getv(Any receiver, Name selector, int argc, Any *argv) { return vm_get(receiver, selector, NULL, argc, argv); } Any /* QuickAndDirtyGet */ qadGetv(Any r, Name selector, int ac, Any *av) { GetMethod implementation = getGetMethodClass(classOfObject(r), selector); Func f; if ( instanceOfObject(implementation, ClassGetMethod) && (f=implementation->function) && offDFlag(implementation, D_CXX|D_TRACE|D_BREAK) ) { switch(ac) { case 0: return (*(GetFunc0)f)(r); case 1: return (*(GetFunc1)f)(r, av[0]); case 2: return (*(GetFunc2)f)(r, av[0],av[1]); case 3: return (*(GetFunc3)f)(r, av[0],av[1],av[2]); case 4: return (*(GetFunc4)f)(r, av[0],av[1],av[2],av[3]); case 5: return (*(GetFunc5)f)(r, av[0],av[1],av[2],av[3],av[4]); case 6: return (*(GetFunc6)f)(r, av[0],av[1],av[2],av[3],av[4],av[5]); } } return vm_get(r, selector, classOfObject(r), ac, av); } /******************************** * VARARG VERSIONS * ********************************/ status send(Any receiver, Name selector, ...) { va_list args; Any argv[VA_PCE_MAX_ARGS]; int argc; va_start(args, selector); for(argc=0; (argv[argc] = va_arg(args, Any)) != NULL; argc++) assert(argc <= VA_PCE_MAX_ARGS); va_end(args); return vm_send(receiver, selector, NULL, argc, argv); } Any get(Any receiver, Name selector, ...) { va_list args; Any argv[VA_PCE_MAX_ARGS]; int argc; va_start(args, selector); for(argc=0; (argv[argc] = va_arg(args, Any)) != NULL; argc++) assert(argc <= VA_PCE_MAX_ARGS); va_end(args); return vm_get(receiver, selector, NULL, argc, argv); } /******************************* * PUBLIC RESOLVE SUPPORT * *******************************/ Any resolveSendMethodObject(Any obj, Class class, Name sel, Any *receiver) { pce_goal g; g.receiver = obj; g.class = class; g.selector = sel; g.flags = PCE_GF_SEND; g.errcode = PCE_ERR_OK; if ( resolveImplementationGoal(&g) && !(g.flags & PCE_GF_CATCHALL) ) { *receiver = g.receiver; return g.implementation; } fail; } Any resolveGetMethodObject(Any obj, Class class, Name sel, Any *receiver) { pce_goal g; g.receiver = obj; g.class = class; g.selector = sel; g.flags = PCE_GF_GET; g.errcode = PCE_ERR_OK; if ( resolveImplementationGoal(&g) && !(g.flags & PCE_GF_CATCHALL) ) { *receiver = g.receiver; return g.implementation; } fail; }