MkCall_atl.c

Go to the documentation of this file.

 
/* LABEL-NO */
 
#include  "LibMkKernel_private_atl.h"
#include  "log_mk.h"
#include  "mk_check_atl.h"
 
#undef META_CONTEXT_S
#define META_CONTEXT_S obj
 
/*****************************************************************************/
/*                                                                           */
/*                                Proc-Call                                  */
/*                                                                           */
/*****************************************************************************/
 
enum MkErrorE MK(CheckCallable) (OT_Check_ARGS, MK_CBP* retP)
{
  OT_SETUP_doc
  if ((*skipP) >= objc) {
    WrongNumArgs(hdl,(*skipP), objc, -999, +999, arg);
    goto error;
  }
  Tcl_ResetResult(interp);
  OT_OBJ_T argsO = objv[(*skipP)++];
 
  int myobjc;
  Tcl_Obj **myobjv;
  check_LNG (Tcl_ListObjGetElements(interp, argsO, &myobjc, &myobjv)) goto tcl_error;
 
  // BUG-FIX: set the "default" value for "NULL" = ""
  // defined in: ./lib_TCL.atl → map_M2C
  // mark=MK_NULL
  if (OT_LNG_NULL_IS(myobjv[0])) {
    *retP = NULL;
    return MK_OK;
  }
 
  struct MkCallS *call = *retP;
 
  if (*retP == NULL) {
    call = *retP = MkSysCalloc(MK_ERROR_PANIC,1,sizeof(struct MkCallS));
    call->isAlloc = true;
  }
 
  call->signature = MkCallS_SIG;
  call->args      = argsO;
  call->hdl       = hdl;
  call->amkrt     = amkrt;
  call->nsO       = STRN2VAL(Tcl_GetCurrentNamespace(interp)->fullName);
  call->mkrt      = MK_RT_PTR;
 
//colorGREEN("call<%p>, type<%d>",call,call->type);
 
  OT_REF_INCR(call->args);
  OT_REF_INCR(call->nsO);
 
  return MK_OK;
tcl_error:
  OT_ERROR_LNG_2_META(hdl);
error:
  return MkErrorStack_0E();
}
 
/*****************************************************************************/
/*                                                                           */
/*                                Proc-Call                                  */
/*                                                                           */
/*****************************************************************************/
 
enum MkErrorE NS(ProcResolve) (
  OT_MK_ARGS
  MK_MNG          hdl,
  struct MkCallS  *call
) {
  SETUP_moxrt;
  OT_OBJ_T argsO = call->args;
    call->args = NULL;
  int objc;
  OT_OBJ_T *objv;
 
  assert(call->signature == MkCallS_SIG);
 
//colorORANGE("call->nsPtr<%p>, call->nsO<%s>",call->nsPtr,VAL2STR(call->nsO));
  OT_NS_T nsPtr = MoxResolveN(call->nsO);
    if (nsPtr == NULL) return MK_OK ;   /* DEFINITION namespace already deleted */
 
  if (argsO == NULL) {
    MkErrorSetC_2M(hdl,"CallbackResolveError: INTERNAL ERROR -> callback is invalid");
    goto error;
  }
 
  check_LNG(Tcl_ListObjGetElements(interp,argsO,&objc,&objv)) {
    OT_ERROR_LNG_2_META(hdl);
    goto error;
  }
 
  Tcl_Command procCmd = NULL;
  OT_OBJ_T arg0 = objv[0];
  do {
    // resolve using CURRENT and GLOBAL namespace
    procCmd = Tcl_FindCommand (interp,VAL2STR(arg0),nsPtr,0);
      if (procCmd != NULL) break; 
 
    // resolve using toplevel CLASS namespace for METHOD call → test if "objv[0]" is an INSTANCE
    if (objc == 1) break;
 
    MOX_NS_T myNsP = MoxResolveN(objv[1]);
      if (myNsP == NULL) break;
    OT_OBJ_T clsNsO = MoxMy__CLASS__NN(myNsP,0);
      if (clsNsO == NULL) break;
    OT_NS_T clsNsPtr = MoxResolveN(clsNsO);
      if (clsNsPtr == NULL) break;
    procCmd = Tcl_FindCommand (interp,VAL2STR(arg0),clsNsPtr,0);
      if (procCmd == NULL) break;
 
    // FOUND toplevel CLASS namespace with METHOD "arg0"
    OT_REF_DECR(call->nsO);
    call->nsO = clsNsO;
      OT_REF_INCR(call->nsO);
 
  } while (0);
 
  if (procCmd == NULL) {
    MK_STRN cbS = VAL2STR(arg0);
    MkErrorSetV_2M(hdl,"CallbackResolveError: unknown method \"%s\" in namespace \"%s\"", cbS, nsPtr->fullName);
    MkErrorAppendC_2M(hdl,"  attention: private callback require namespace prefix!");
    goto error;
  }
 
  arg0 = NULL;
    objc--;objv++;
 
  call->mth = Tcl_NewObj();
    Tcl_GetCommandFullName(interp,procCmd,call->mth);
    OT_REF_INCR(call->mth);
 
  OT_CLS_T procClass = AtlGetClassFromProc(procCmd);
 
  if (procClass == NULL) {
    // just one proc
    call->type = MkCallS_proc;
  } else {
    if (objc == 0) {
      // DEFINED: instance or class method without my -> own method
      call->type  = MkCallS_own_method;
      call->my    = NULL;
    } else {
      OT_OBJ_T myO = objv[0];
      if (MoxMyIsN(myO)) {
        // instance method with my
        call->type = MkCallS_other_method;
        call->my  = myO;
          OT_REF_INCR(myO);
          objc--;objv++;
      } else {
        // CLASS method
        call->type = MkCallS_static;
        call->my  = NULL;
      }
    }
  }
 
  // resolve additional arguments
  if (objc > MkProcResolve_maxArgsLen) {
    MkErrorSetV_2M(hdl, "expect max '%d' additional arguments to callback but got '%d' "
                        "with '%s'", MkProcResolve_maxArgsLen, objc, Tcl_GetString(argsO));
    goto error;
  } else if (objc > 0) {
    call->args = Tcl_NewListObj(objc,objv);
    OT_REF_INCR(call->args);
  }
 
  OT_REF_DECR_AND_NULL(argsO);
  return MK_OK;
 
error:
  call->args = argsO;
  return MkErrorStack_1M(hdl);
}
 
// **********************************************************************
 
 
#if 0
  #define dbgMsg(fmt,...) printV(fmt,__VA_ARGS__)
  #define dbgObj(obj)     printLngObj(obj)
#else
  #define dbgMsg(fmt,...)
  #define dbgObj(obj)
#endif
 
 
/*
[ObjectDeleteCall signature]
  callback-args := typeName:MK_STRN[in], typeHdl:MK_HDL[in], objHdl:MK_HDL[in]
  [proc]      proc callback { callback-args ?additional-args...? } ...
              MkObjectC::DeleteCallbackSetup "NAME" callback "FILTER"
  [instance]  myooX::ClassN ::XXX {
                proc callback { xxxNs callback-args ?additional-args...? } ...
              }
              MkObjectC::DeleteCallbackSetup "NAME" [list callback $xxxNs] "FILTER"
  [class]     myooX::ClassN ::YYY {
                proc callback { callback-args ?additional-args...? } ...
              }
              MkObjectC::DeleteCallbackSetup "NAME" ::YYY::callback "FILTER"
[ObjectDeleteCall signature]
*/
 
enum MkErrorE NS(ObjectDeleteCall) ( MkObjectDeleteCallF_ARGS )
{
  MkObjectDeleteCallF_CHECK;
 
  // if NO self object is available than NO callback is called
  if (!MkSelfExists(obj)) return MK_OK;
 
  // 1. setup environment
  struct MkCallS *call = __data__;
 
  // 2. Prolog
  CallProlog(call->hdl);
  if (call->type == MkCallS_own_method) {
    return MkErrorSetC_1E("MkCallS_own_method not supported");
  }
 
  // 3. setup args
  objv[objc++] = STR2VAL(typeName);
  objv[objc++] = HDL2VAL(typeHdl);
  objv[objc++] = HDL2VAL(objHdl);
 
  // 4. setup user args
  if (call->args) MK(ProcResolveAppendArgs)(call,&objc,objv);
 
  // 5. call the callback
  int ret = MK(EvalObjv) (interp, objc, objv, 0); /* "MK(EvalObjv)" IS required !! */
    if (ret != TCL_OK) goto error;
 
  Tcl_ResetResult(interp);
  return MkErrorGetCode_0E();
 
error:
  OT_ERROR_LNG_2_META(call->hdl);
 
error_mq:
  return MkErrorStack_0E();
}
 
void NS(ObjectDeleteFree) ( MkObjectDeleteFreeF_ARGS )
{
  MK(CallFree)(dataP);
}
 
static MK_STRN sMkCallTypeEC ( MkCallTypeE type ) {
  switch (type) {
    case MkCallS_null          :  return "null";
    case MkCallS_init          :  return "init";
    case MkCallS_proc          :  return "proc";
    case MkCallS_static        :  return "static";
    case MkCallS_own_method    :  return "own_method";
    case MkCallS_other_method  :  return "other_method";
    case MkCallS_error         :  return "error";
    default                    :  return "INVALID";
  }
}
 
void MK(CallLog) (
  MK_RT_ARGS
  MkCallS *call,
  MK_STRN caller
) {
  MkRuntimeLogBufferPush();
    MkLogV_3(NULL,caller,"MkCallS[%p] : sig=%c, type=%s, isAlloc = %c\n",
      call, logB(call->signature == MkCallS_SIG), sMkCallTypeEC(call->type), logB(call->isAlloc));
    if (call->my)     { MkLogV_3(NULL,caller, "  | my      = %s\n", Tcl_GetString(call->my)); }
    if (call->mth)    { MkLogV_3(NULL,caller, "  | mth     = %s\n", Tcl_GetString(call->mth)); }
    if (call->args)   { MkLogV_3(NULL,caller, "  | args    = %s\n", Tcl_GetString(call->args)); }
    while (call->hdl)    { 
      MK_OBJ obj = MkObj(call->hdl);
        if (obj == NULL) { MkLogV_3(NULL,caller, "  | hdl     = %p (INVALID)\n", call->hdl); break; }
      OT_OBJ_T objO = META2VAL_O(obj);
        if (objO == NULL) { MkLogV_3(NULL,caller, "  | hdl     = %p (NO SELF)\n", call->hdl); break; }
        
      MkLogV_3(NULL,caller, "  | hdl     = %s\n", Tcl_GetString(objO));
      break;
    }
    if (call->amkrt)  { MkLogV_3(NULL,caller, "  | amkrt   = %p\n", call->amkrt); }
    if (call->nsO)    { MkLogV_3(NULL,caller, "  | nsO     = %s\n", Tcl_GetString(call->nsO)); }
  MkRuntimeLogBufferPop();
}