MkCall_tcl.c File Reference

tag: nhi1-release-250425 More...

#include "LibMkKernel_tcl.h"
#include "mk_check_tcl.h"
#include <tclInt.h>

Include dependency graph for MkCall_tcl.c:

Go to the source code of this file.

Macros
#define	mycheck_LNG(val)
#define	mycheck_NULL(var)
#define	mycheck_NULL_2(var, str)
#define	myListObjIndex(itp, lst, idx)
#define	myListObjPop(itp, lst)
#define	myListObjLength(itp, lst)
#define	myGetBooleanFromObj(itp, lngO)
#define	myEvalObjvAR(frm, itp, opt, objc, objv)
#define	myGetObjectFromObj(itp, _mng, slf)
#define	myWrongTypeOfStaticArgError(exp, cls, got)
#define	dbgMsg(fmt, ...)
#define	dbgObj(obj)

Functions
enum MkErrorE	tclmkkernel_CheckCallable (OT_Check_ARGS, MK_CBP *retP)
static enum MkErrorE	tclmkkernel_sProcResolve_StaticMethod (OT_VARFRAME_ARGS, OT_ENV_T interp, MK_MNG hdl, struct MkCallS *call, OT_OBJ_T clsO, OT_OBJ_T *mthOP, bool needArg, bool needError)
enum MkErrorE	tclmkkernel_ProcResolve (MK_RT mkrt, OT_ENV_T interp, MK_MNG hdl, struct MkCallS *call)
enum MkErrorE	tclmkkernel_ObjectDeleteCall (MK_RT mkrt, MK_OBJN const obj, MK_STRN const typeName, MK_HDL const typeHdl, MK_HDL const objHdl, MK_CBP const __data__)
void	tclmkkernel_ObjectDeleteFree (MkObjectDeleteFreeF_ARGS)

Detailed Description

tag: nhi1-release-250425

Copyright

(C) NHI - #1 - Project - Group This software has NO permission to copy, please contact AUTHOR for additional information

Definition in file MkCall_tcl.c.

Macro Definition Documentation

dbgMsg

#define dbgMsg	(		fmt,
			... )

Definition at line 237 of file MkCall_tcl.c.

dbgObj

#define dbgObj

(

obj

)

Definition at line 238 of file MkCall_tcl.c.

mycheck_LNG

#define mycheck_LNG

(

val

)

Value:

  check_LNG(val) { \
    OT_ERROR_LNG_2_META(hdl); \
    goto error; \
  }

Definition at line 75 of file MkCall_tcl.c.

#define mycheck_LNG(val) \
  check_LNG(val) { \
    OT_ERROR_LNG_2_META(hdl); \
    goto error; \
  }

mycheck_NULL

#define mycheck_NULL

(

var

)

Value:

  check_NULL(var) { \
    OT_ERROR_LNG_2_META(hdl); \
    goto error; \
  }

Definition at line 81 of file MkCall_tcl.c.

#define mycheck_NULL(var) \
  check_NULL(var) { \
    OT_ERROR_LNG_2_META(hdl); \
    goto error; \
  }

mycheck_NULL_2

#define mycheck_NULL_2	(		var,
			str )

Value:

  check_NULL(var) { \
    MkErrorSetC_2M(hdl,str); \
    goto error; \
  }

Definition at line 87 of file MkCall_tcl.c.

#define mycheck_NULL_2(var,str) \
  check_NULL(var) { \
    MkErrorSetC_2M(hdl,str); \
    goto error; \
  }

myEvalObjvAR

#define myEvalObjvAR	(		frm,
			itp,
			opt,
			objc,
			objv )

Value:

  ({ \
  OT_OBJ_T _ret = MK(EvalObjvAR)(MK_RT_CALL frm, itp, opt, objc, objv);   \
  mycheck_NULL(_ret); \
  _ret; \
})

Definition at line 119 of file MkCall_tcl.c.

#define myEvalObjvAR(frm,itp,opt,objc,objv) ({ \
  OT_OBJ_T _ret = MK(EvalObjvAR)(MK_RT_CALL frm, itp, opt, objc, objv);   \
  mycheck_NULL(_ret); \
  _ret; \
})

myGetBooleanFromObj

#define myGetBooleanFromObj	(		itp,
			lngO )

Value:

  ({ \
  int _retB = 0; \
  mycheck_LNG(Tcl_GetBooleanFromObj(itp,lngO,&_retB)); \
  ( _retB > 0 ); \
})

Definition at line 113 of file MkCall_tcl.c.

#define myGetBooleanFromObj(itp,lngO) ({ \
  int _retB = 0; \
  mycheck_LNG(Tcl_GetBooleanFromObj(itp,lngO,&_retB)); \
  ( _retB > 0 ); \
})

myGetObjectFromObj

#define myGetObjectFromObj	(		itp,
			_mng,
			slf )

Value:

  ({ \
  OT_SELF_T _ret = Tcl_GetObjectFromObj(itp,slf); \
  check_NULL(_ret) { \
    MkErrorSetC_2M(_mng,Tcl_GetStringResult (itp)); \
    goto error; \
  } \
  _ret; \
})

Definition at line 125 of file MkCall_tcl.c.

#define myGetObjectFromObj(itp,_mng,slf) ({ \
  OT_SELF_T _ret = Tcl_GetObjectFromObj(itp,slf); \
  check_NULL(_ret) { \
    MkErrorSetC_2M(_mng,Tcl_GetStringResult (itp)); \
    goto error; \
  } \
  _ret; \
})

myListObjIndex

#define myListObjIndex	(		itp,
			lst,
			idx )

Value:

  ({ \
  OT_OBJ_T _ret; \
  mycheck_LNG(Tcl_ListObjIndex(itp,lst,idx,&_ret)); \
  mycheck_NULL_2(_ret,"LIST-IDX-LOOKUP-ERROR at " #lst "' index '" #idx "'"); \
  _ret; \
})

Definition at line 93 of file MkCall_tcl.c.

#define myListObjIndex(itp,lst,idx) ({ \
  OT_OBJ_T _ret; \
  mycheck_LNG(Tcl_ListObjIndex(itp,lst,idx,&_ret)); \
  mycheck_NULL_2(_ret,"LIST-IDX-LOOKUP-ERROR at " #lst "' index '" #idx "'"); \
  _ret; \
})

myListObjLength

#define myListObjLength	(		itp,
			lst )

Value:

  ({ \
  int _len=0; \
  mycheck_LNG(Tcl_ListObjLength(itp, lst, &_len)); \
  _len; \
})

Definition at line 107 of file MkCall_tcl.c.

#define myListObjLength(itp,lst) ({ \
  int _len=0; \
  mycheck_LNG(Tcl_ListObjLength(itp, lst, &_len)); \
  _len; \
})

myListObjPop

#define myListObjPop	(		itp,
			lst )

Value:

  ({ \
  OT_OBJ_T _ret = myListObjIndex(itp,lst,0); \
  Tcl_IncrRefCount(_ret); \
  mycheck_LNG(Tcl_ListObjReplace(itp,lst,0,1,0,NULL)); \
  _ret; \
})

Definition at line 100 of file MkCall_tcl.c.

#define myListObjPop(itp,lst) ({ \
  OT_OBJ_T _ret = myListObjIndex(itp,lst,0); \
  Tcl_IncrRefCount(_ret); \
  mycheck_LNG(Tcl_ListObjReplace(itp,lst,0,1,0,NULL)); \
  _ret; \
})

myWrongTypeOfStaticArgError

#define myWrongTypeOfStaticArgError	(		exp,
			cls,
			got )

Value:

  MkErrorVD("WrongTypeOfStaticArgError", "expect type '%s' for class '%s', but got '%s'", exp, cls, got ); \
  goto error;

Definition at line 134 of file MkCall_tcl.c.

#define myWrongTypeOfStaticArgError(exp,cls,got) \
  MkErrorVD("WrongTypeOfStaticArgError", "expect type '%s' for class '%s', but got '%s'", exp, cls, got ); \
  goto error;

Function Documentation

tclmkkernel_CheckCallable()

enum MkErrorE tclmkkernel_CheckCallable	(	OT_Check_ARGS	,
		MK_CBP *	retP )

Definition at line 21 of file MkCall_tcl.c.

{
  OT_SETUP_doc
  if ((*skipP) >= objc) {
    WrongNumArgs(hdl,(*skipP), objc, -999, +999, arg);
    goto error;
  }
  Tcl_ResetResult(interp);
  OT_OBJ_T argO = objv[(*skipP)++];
 
  int myobjc;
  Tcl_Obj **myobjv;
  check_LNG (Tcl_ListObjGetElements(interp, argO, &myobjc, &myobjv)) goto tcl_error;
 
  // BUG-FIX: set the "default" value for "NULL" = ""
  // defined in: ./lib_TCL.tcl → map_M2C
  // mark=MK_NULL
  if (myobjc == 0) goto null;                                     /* empty list */
  if (Tcl_GetObjectFromObj (interp, myobjv[0])) {                 /* method? */
    if (myobjc > 1 && OT_LNG_NULL_IS(myobjv[1])) goto null;
  } else {
    Tcl_ResetResult(interp);
    if (OT_LNG_NULL_IS(myobjv[0])) goto null;                     /* proc */
  }
 
  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->mth       = argO;
  call->hdl       = hdl;
  call->interp    = interp;
  call->mkrt      = MK_RT_PTR;
  call->nsO       = STRN2VAL(Tcl_GetCurrentNamespace(interp)->fullName);
 
  OT_REF_INCR(call->mth);
  OT_REF_INCR(call->nsO);
 
//colorGREEN("call<%p>, type<%d>, nsO<%p>",call,call->type,call->nsO);
 
  return MK_OK;
tcl_error:
  OT_ERROR_LNG_2_META(hdl);
error:
  return MkErrorStack_0E();
null:
  *retP = NULL;
  return MK_OK;
}

tclmkkernel_ObjectDeleteCall()

enum MkErrorE tclmkkernel_ObjectDeleteCall	(	MK_RT	mkrt,
		MK_OBJN const	obj,
		MK_STRN const	typeName,
		MK_HDL const	typeHdl,
		MK_HDL const	objHdl,
		MK_CBP const	__data__ )

Definition at line 378 of file MkCall_tcl.c.

{
  MkObjectDeleteCallF_CHECK;
 
  // if NO self object is available than NO callback is called
  if (!MkSelfExists(obj)) return MK_OK;
 
  // 1. setup environment
  SETUP_interp
  if (interp==NULL || Tcl_InterpDeleted(interp)) return MK_OK;
 
  // 2. setup arguments
  struct MkCallS *call = __data__;
  OT_OBJ_T objv[5+MkProcResolve_maxArgsLen] = {0};
  int objc = 0;
 
  //Tcl_ResetResult(interp);
//printLLngObj(call->mth);
 
  // 3. setup my
rescan:
  switch (call->type) {
    case MkCallS_own_method:
//printLTxt("MkCallS_own_method");
      return MkErrorSetC_1E("MkCallS_own_method not supported");
      break;
    case MkCallS_other_method:
    case MkCallS_static:
//printLTxt("MkCallS_other_method OR MkCallS_static");
      objv[objc++] = call->my;
      break;
    case MkCallS_proc:
//printLTxt("MkCallS_proc");
      break;
    case MkCallS_init: {
      check_META(MK(ProcResolve)(MK_RT_CALL interp, call->hdl, call)) goto error_mq;
      goto rescan;
    }
    case MkCallS_error:
//printLTxt("MkCallS_error");
      goto error;
    case MkCallS_null:
//printLTxt("MkCallS_null");
      return MK_OK;
  }
 
  // 4. setup methode
  if (call->mth)  objv[objc++] = call->mth;
 
  // 5. setup OBJ arg
  switch (call->type) {
    case MkCallS_other_method:
    case MkCallS_static:
    case MkCallS_proc:
      objv[objc++] = STR2VAL(typeName,-1);
      objv[objc++] = HDL2VAL(typeHdl);
      objv[objc++] = HDL2VAL(objHdl);
      break;
    case MkCallS_own_method:
    case MkCallS_init:
      break;
    case MkCallS_error:
      goto error;
    case MkCallS_null:
      return MK_OK;
  }
 
  if (call->args) MK(ProcResolveAppendArgs)(call,&objc,objv);
 
  // 3. call the callback
  // require "MK(EvalObjv)" to cleanup "objv"
  int ret = MK(EvalObjv) (interp, objc, objv, TCL_EVAL_GLOBAL);
 
//printV("ret=%i, code=%s\n", ret, MkLogErrorE(MkErrorGetCode_0E()))
 
  if (ret == TCL_OK) {
    Tcl_ResetResult(interp);
    return MkErrorGetCode_0E();
  }
 
error:
  OT_ERROR_LNG_2_META(call->hdl);
 
error_mq:
  return MkErrorStack_0E();
}

tclmkkernel_ObjectDeleteFree()

void tclmkkernel_ObjectDeleteFree

(

MkObjectDeleteFreeF_ARGS

)

Definition at line 465 of file MkCall_tcl.c.

{
  if ( MK_RT_REF.mkThreadData.ptr == NULL || Tcl_InterpDeleted(MK_RT_REF.mkThreadData.ptr)) return;
  MK(CallFree)(dataP);
}

tclmkkernel_ProcResolve()

enum MkErrorE tclmkkernel_ProcResolve	(	MK_RT	mkrt,
		OT_ENV_T	interp,
		MK_MNG	hdl,
		struct MkCallS *	call )

Definition at line 241 of file MkCall_tcl.c.

  {
//L0
  OT_VARFRAME_CREATE
  enum MkErrorE ret = MK_OK;
  OT_OBJ_T arg0 = NULL;
  OT_OBJ_T arg1 = NULL;
  OT_OBJ_T tstO = Tcl_DuplicateObj(call->mth);
 
  if (call->nsPtr == NULL) {
    call->nsPtr = Tcl_FindNamespace(interp,VAL2STR(call->nsO),NULL,TCL_GLOBAL_ONLY);
      if (call->nsPtr == NULL) return MK_OK ;   // instance namespace already deleted
  }
 
  Namespace * savedNsPtr = NULL;
  Tcl_Command procCmd = NULL;
  Interp *iPtr = (Interp *) interp;
 
  // check if "arg0" is an object or class
  arg0 = myListObjPop(interp,tstO);
 
dbgMsg("nsPtr<%p>", call->nsPtr)
 
  savedNsPtr = iPtr->varFramePtr->nsPtr;
  iPtr->varFramePtr->nsPtr = (Namespace *) call->nsPtr;
 
dbgObj(arg0);
  
  //Tcl_Command procCmd = Tcl_FindCommand (interp,Tcl_GetString(arg0),call->ns,0);
  procCmd = Tcl_GetCommandFromObj (interp,arg0);
 
dbgMsg("procCmd<%p>", procCmd)
 
  if (procCmd != NULL) {
 
    OT_SELF_T obj0 = Tcl_GetObjectFromObj(interp,arg0);
    Tcl_ResetResult(interp);
 
    if (obj0 != NULL) {
dbgMsg("%s","object")
      // first is NON "proc" and "object" → interface, method (own or other)
 
      arg1 = myListObjPop(interp,tstO);
 
      // check if "arg0" is an "instance" or "class"
      OT_CLS_T cls0 = Tcl_GetObjectAsClass(obj0);
 
      if (cls0 != NULL) {
dbgMsg("%s","class method")
        // class method -> static
        check_META(NS(sProcResolve_StaticMethod)( OT_VARFRAME_CALL,interp,hdl,call,arg0,&arg1,true,true)) goto error;
      } else {
dbgMsg("%s","instance method")
        // instance method
        OT_OBJ_T myCmdO = MK(GetMyFromObject)(interp,obj0);
          check_NULL(myCmdO)  {
            OT_ERROR_LNG_2_META(hdl);
            goto error;
          }
 
        call->type = MkCallS_other_method;
        call->my  = myCmdO;
          Tcl_IncrRefCount(myCmdO);
        call->mth = arg1;
          Tcl_IncrRefCount(arg1);
          arg1 = NULL;
      }
 
    } else {
 
dbgMsg("%s","proc")
      call->type = MkCallS_proc;
      call->mth = arg0;
        Tcl_IncrRefCount(arg0);
        arg0 = NULL;
    }
 
  } else {
dbgMsg("%s","NON proc instance method")
    // first is NON "proc" and NON "object" → method on OWN class
    call->type = MkCallS_own_method;
    call->my  = NULL;
    call->mth = arg0;
      Tcl_IncrRefCount(arg0);
      arg0 = NULL;
  }
 
  // resolve additional arguments
  int tstOLen = myListObjLength(interp, tstO);
  if (tstOLen > MkProcResolve_maxArgsLen) {
    MkErrorSetV_2M(hdl, "expect max '%d' additional arguments to callback but got '%d' "
                        "with '%s'", MkProcResolve_maxArgsLen, tstOLen, Tcl_GetString(tstO));
    goto error;
  } else if (tstOLen > 0) {
    call->args = tstO;
      Tcl_IncrRefCount(tstO);
      tstO = NULL;
  } else {
    call->args = NULL; 
  }
 
end:
  OT_REF_DECR_AND_NULL(arg0);
  OT_REF_DECR_AND_NULL(arg1);
  OT_REF_DECR_AND_NULL(tstO);
  OT_VARFRAME_DELETE
  if (savedNsPtr) iPtr->varFramePtr->nsPtr = savedNsPtr;
  return ret;
 
error:
  ret = MkErrorStack_1M(hdl);
  if (savedNsPtr) iPtr->varFramePtr->nsPtr = savedNsPtr;
  goto end;
}

tclmkkernel_sProcResolve_StaticMethod()

static enum MkErrorE tclmkkernel_sProcResolve_StaticMethod ( OT_VARFRAME_ARGS , OT_ENV_T interp, MK_MNG hdl, struct MkCallS * call, OT_OBJ_T clsO, OT_OBJ_T * mthOP, bool needArg, bool needError )

static

Definition at line 138 of file MkCall_tcl.c.

  {
  enum MkErrorE ret = MK_OK;
  OT_OBJ_T mthO = *mthOP;
 
//X0(hdl)
//printXLng(hdl,clsO)
//printXLng(hdl,mthO)
 
  // is a "PRIVATE/PUBLIC method"
  // call: info object methods -all -private
  OT_OBJ_T mthL = NULL;
  {
    RL_init( RL_O(0,RG(infoObjectMethodsCmd)) RL_NewS(2,"-all") RL_NewS(3,"-private") ) RL_O(1,clsO);
    mthL = myEvalObjvAR(varframe,interp,TCL_EVAL_GLOBAL,4,RL_data);
  }
 
  // search for the meth, result: >0 found, -1 = not found
  // lsearch -exact mthL mthO
  OT_OBJ_T isMthO = NULL;
  {
    RL_init( RL_NewS(0,"lsearch") RL_NewS(1,"-exact") ) ; RL_O(2,mthL) ; RL_O(3,mthO)
    isMthO = myEvalObjvAR(varframe,interp,TCL_EVAL_GLOBAL, 4, RL_data);
  }
 
  int mthIdx;
  mycheck_LNG(Tcl_GetIntFromObj(interp,isMthO,&mthIdx));
 
  if (mthIdx == -1) {
    RL_init( RL_O(0,RG(infoClassSuperclassesCmd)) ) ; RL_O(1,clsO)
 
    // CURRENT class has NO method -> continue with superclass
    // call: info class subclasses CLASS
    OT_OBJ_T superclassesL = myEvalObjvAR(varframe,interp,TCL_EVAL_GLOBAL, 2, RL_data);
 
//printXLng(hdl,superclassesL)
 
    // get superclassesL as objv
    int objc;
    OT_OBJ_T *objv;
    mycheck_LNG(Tcl_ListObjGetElements(interp,superclassesL,&objc,&objv));
    for (int i=0; i<objc; i++) {
      check_META(NS(sProcResolve_StaticMethod)(OT_VARFRAME_CALL,interp,hdl,call,objv[i],mthOP,true,false)) continue;
      // ok found something
      goto end;
    }
    if (needError) {
      myWrongTypeOfStaticArgError("static Callable", VAL2STR(clsO), VAL2STR(mthO));
    } else {
      goto error;
    }
    goto end;
 
  } else {
 
    // get static "my"
    OT_SELF_T object = myGetObjectFromObj(interp,hdl,clsO);
    OT_OBJ_T myCmdO = MK(GetMyFromObject)(interp,object);
      check_NULL(myCmdO)  {
        OT_ERROR_LNG_2_META(hdl);
        goto error;
      }
 
    call->type  = MkCallS_static;
    call->my    = myCmdO;
      Tcl_IncrRefCount(myCmdO);
    call->mth   = mthO;
      Tcl_IncrRefCount(mthO);
      *mthOP = NULL;
  }
 
end:
//printTxt("OK");
  return ret;
 
error:
 
    call->type  = MkCallS_error;
    call->my    = NULL;
    call->mth   = NULL;
 
//printXTxt(hdl,"ERROR");
//printXTxt(hdl,MkErrorGetText_0E());
//printXTxt(hdl,Tcl_GetStringResult(interp));
  return MK_ERROR;
}