theSq3Lite 10.0 NHI1 - theKernel - theLink - theConfig - theSq3Lite - theCompiler - theBrain - theGuard - theLib - theATL
c - tcl - atl - cs - py - rb - jv - cc
Loading...
Searching...
No Matches
LibMkKernel_tcl.h
Go to the documentation of this file.
1
12#pragma once
13
14#include <tcl.h>
15#include <tclOO.h>
16
17#include "LibMkKernel_mk.h"
18
19#include "tmpl/mk_type_S_lng.h"
20
21#if !defined(META_FILE_NAME)
22 #define META_FILE_NAME (__builtin_strrchr(__FILE__, '/') ? __builtin_strrchr(__FILE__, '/') + 1 : __FILE__)
23#endif
24
25/*****************************************************************************/
26/* */
27/* Macro_API */
28/* */
29/*****************************************************************************/
30
31// BEGIN-HEADER - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
32
33#undef HEADER
34#define HEADER
35
36// If the source of libmkkernel is direct used in an external library
37// (without dynamic linking) and this library should *not* export
38// the symbol's of libmkkernel then the flag META_IGNORE_EXTERN have
39// to be set
40#undef MK_TCL_EXTERN
41#if defined(META_IGNORE_EXTERN)
42# define MK_TCL_EXTERN
43#elif defined(PIC)
44 // does we build a DLL ?
45# if defined(DLL_EXPORT)
46 // does we build the libmkkernel library ?
47# if defined(MK_TCL_BUILD_DLL)
48# define MK_TCL_EXTERN __declspec(dllexport)
49# else
50# define MK_TCL_EXTERN __declspec(dllimport)
51# endif
52# else
53 // no DLL - architecture specific extern specifier
54# define MK_TCL_EXTERN __attribute__ ((visibility("default")))
55# endif
56#else
58# define MK_TCL_EXTERN
59#endif
60
61// external data lookup
62#undef MK_TCL_EXTERN_DATA
63#if defined(META_PRIVATE)
64# define MK_TCL_EXTERN_DATA extern
65#elif defined(META_IGNORE_EXTERN)
66# define MK_TCL_EXTERN_DATA extern
67#elif defined(PIC)
68 // does we build a DLL ?
69# if defined(DLL_EXPORT)
70 // does we build the libmkkernel library ?
71# if defined(MK_TCL_BUILD_DLL)
72# define MK_TCL_EXTERN_DATA __declspec(dllexport)
73# else
74# define MK_TCL_EXTERN_DATA __declspec(dllimport)
75# endif
76# else
77 // no DLL - architecture specific extern specifier
78# define MK_TCL_EXTERN_DATA __attribute__ ((visibility("default"))) extern
79# endif
80#else
81# define MK_TCL_EXTERN_DATA extern
82#endif
83
84#undef MK
85#define MK(n) tclmkkernel_ ## n
86#undef NS
87#define NS(n) tclmkkernel_ ## n
88
89// END-HEADER - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
90
91#define META_CONTEXT_S hdl
92
93#define OT_ProcRet int
94
95#define TCL_ARGS OT_ENV_T interp, int objc, OT_OBJ_T const *objv
96#define TCL_ARGS_CALL interp, objc, objv
97
98#define OBJECT_ARGS ClientData clientData, OT_ENV_T interp, Tcl_ObjectContext objCtx, \
99 int objc, OT_OBJ_T const *objv
100#define OBJECT_ARGS_CALL hdl, interp, objCtx, objc, objv
101
102#define OBJCMD_ARGS ClientData clientData, OT_ENV_T interp, int objc, OT_OBJ_T const *objv
103#define OBJCMD_ARGS_CALL clientData, interp, objc, objv
104
105#define CONSTR_ARGS OBJECT_ARGS
106
107#define SKIP_ARGS TCL_ARGS, int __skip
108#define SKIP_ARGS_CALL TCL_ARGS_CALL, __skip
109
110#define OtClass_ARGS OBJECT_ARGS
111#define OtClass_ARGS_CALL OBJECT_ARGS_CALL
112
113// class args ******************************************************************************
114
115// BEGIN-Class-def - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
116
117#define MkBufferListC_ARGS OBJECT_ARGS
118#define MkBufferListC_ARGS_CALL OBJECT_ARGS_CALL
119#define MkBufferC_ARGS OBJECT_ARGS
120#define MkBufferC_ARGS_CALL OBJECT_ARGS_CALL
121#define MkBufferStreamC_ARGS OBJECT_ARGS
122#define MkBufferStreamC_ARGS_CALL OBJECT_ARGS_CALL
123#define MkErrorC_ARGS OBJECT_ARGS
124#define MkErrorC_ARGS_CALL OBJECT_ARGS_CALL
125#define MkLogFileC_ARGS OBJECT_ARGS
126#define MkLogFileC_ARGS_CALL OBJECT_ARGS_CALL
127#define MkObjectC_ARGS OBJECT_ARGS
128#define MkObjectC_ARGS_CALL OBJECT_ARGS_CALL
129#define MkRuntimeC_ARGS OBJECT_ARGS
130#define MkRuntimeC_ARGS_CALL OBJECT_ARGS_CALL
131
132// END-Class-def - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
133
134// setup ***********************************************************************************
135
136#define OT_SETUP_ARGS_ALL(d) \
137 OT_OBJ_T retObj=NULL; \
138 MK_UNUSED static const MK_STRN __doc=d; \
139 MK_UNUSED OT_OBJ_T frame=NULL; \
140
141#define OT_FRAME_CLEANUP if (frame != NULL) { Tcl_DecrRefCount(frame); frame = NULL; }
142
143#define OT_SETUP_VARARGS(min,max,d) \
144 OT_SETUP_ARGS_ALL(d); \
145 OT_CHECK_NUM_ARGS(min,max);
146
147#define OT_SETUP_CONSTRUCTOR_ARGS(...) OT_SETUP_VARARGS(__VA_ARGS__)
148
149#define OT_SETUP_ONEARG(d) \
150 OT_SETUP_ARGS_ALL(d); \
151 OT_CHECK_NUM_ARGS(1,1);
152
153#define OT_SETUP_NOARG(d) \
154 OT_SETUP_ARGS_ALL(d); \
155 OT_CHECK_NUM_ARGS(0,0);
156
157//#define OT_SETUP_self OT_OBJ_T self = Tcl_GetObjectName(interp,(OT_SELF_T)hdl->obj.self);
158#define OT_SETUP_obj MK_OBJ obj = OBJ;
159#define OT_SETUP_doc __attribute__((unused)) const MK_STRN __doc = __func__;
160
161#define SETUP_ARGS MK_RT_ARGS TCL_ARGS
162#define SETUP_ARGS_CALL MK_RT_CALL TCL_ARGS_CALL
163
164MK_TCL_EXTERN_DATA const Tcl_ObjectMetadataType MK(AtomMeta);
165
166#define OT_retObj_CONSTR(x) retObj = Tcl_GetObjectName(interp,MK(AtomInit)(MK_RT_CALL interp,selfO,MkOBJ(x)));
167#define OT_CONSTRUCTOR_POST(x)
168
169#define OT_retObj_SET(val) retObj = (val);
170#define OT_retObj_SET_None retObj = RG(noneObj);
171#define OT_retObj_SET_Error retObj = NULL; \
172 /*Tcl_AppendResult(interp,"\n -> found in: ", doc, NULL);*/
173#define OT_retObj_SET_List retObj = Tcl_NewListObj(0,NULL);
174#define OT_retObj_APPEND(var) OtErrorCheckLngGoto(Tcl_ListObjAppendElement(interp,retObj,var));
175#define OT_retObj_RETURN \
176 if (retObj != NULL) { \
177 Tcl_SetObjResult(interp,retObj); \
178 return TCL_OK; \
179 } else { \
180 return TCL_ERROR; \
181 }
182
183/*
184BUG FIX : 24 apr 2024 → the "nullObj does now become a REAL command…
185test : misc issues in RPC etc
186
187 #define OT_retObj_RETURN \
188 if (retObj != NULL) { \
189 if (retObj != RG(nullObj)) { \
190 Tcl_SetObjResult(interp,retObj); \
191 } else { \
192 Tcl_ResetResult(interp); \
193 } \
194 return TCL_OK; \
195 } else { \
196 return TCL_ERROR; \
197 }
198*/
199
200#define OT_retObj_SET_BOL(nat) retObj = BOL2VAL(nat);
201#define OT_retObj_SET_I8(nat) retObj = I82VAL(nat);
202#define OT_retObj_SET_I16(nat) retObj = I162VAL(nat);
203#define OT_retObj_SET_U16(nat) retObj = U162VAL(nat);
204#define OT_retObj_SET_I32(nat) retObj = INT2VAL(nat);
205#define OT_retObj_SET_I64(nat) retObj = I642VAL(nat);
206#define OT_retObj_SET_LLG(nat) retObj = LLG2VAL(nat);
207#define OT_retObj_SET_FLT(nat) retObj = FLT2VAL(nat);
208#define OT_retObj_SET_DBL(nat) retObj = DBL2VAL(nat);
209#define OT_retObj_SET_BIN(nat,len) retObj = BIN2VAL(nat,len);
210#define OT_retObj_SET_STR(nat) retObj = STRN2VAL(nat);
211#define OT_retObj_SET_STRN(nat) retObj = STRN2VAL(nat);
212#define OT_retObj_SET_LONG(nat) retObj = LONG2VAL(nat);
213#define OT_retObj_SET_HDL(nat) retObj = HDL2VAL(nat);
214
215// METHOD CALL **********************************************************************
216
217#if 0
218
219#define OT_MK_CALL_0_v1
220
221// calling an object TROUGH the Tcl_Eval api
222#define OT_MK_CALL_0(hdl,cls,meth,ret) \
223{
224 ret = MK(EvalObjvVR)(NULL,interp,0,MK(cls##_ObjNew)(interp,hdl),MK(cls##_##meth##_Obj),NULL);
225}
226
227#else
228
229// call an method direct.
230// !! ATTENTION !! the "selfO" is NULL -> do NOT use this call for any "internal" usage.
231#define OT_MK_CALL_0(hdl,cls,meth,ret) { \
232 OtErrorCheckLngGoto(MK(cls##_##meth)(hdl,interp, NULL, 0, NULL)); \
233 ret = Tcl_GetObjResult(interp); \
234}
235
236#endif
237
238// LNG ******************************************************************************
239
240typedef Tcl_Obj* OT_OBJ_T ;
242typedef Tcl_Class OT_CLS_T ;
243typedef Tcl_Interp* OT_ENV_T ;
244typedef Tcl_Namespace* OT_NS_T ;
245typedef Tcl_Object OT_SELF_T ;
246
247#define OT_LNG_NULL NULL
248#define OT_LNG_UNDEF NULL
249#define OT_LNG_RETURN(ret,cmd) \
250 OtErrorCheckLngGoto(cmd); \
251 ret = Tcl_GetObjResult(interp); \
252
253#define OT_LNG_FULLNAME_FROM_OBJECT(_obj) Tcl_GetString(Tcl_GetObjectName(interp,_obj))
254#define OT_LNG_NAME_FROM_OBJECT(_obj) Tcl_GetCommandName(interp,Tcl_GetObjectCommand(_obj))
255#define OT_LNG_NAME_FROM_CLASS(_cls) OT_LNG_NAME_FROM_OBJECT(Tcl_GetClassAsObject(_cls))
256#define OT_LNG_NAME_FROM_OBJ(_obj) OT_LNG_NAME_FROM_OBJECT(Tcl_GetObjectFromObj(interp,_obj))
257// silent assume a "OT_LNG_OBJECT_IS" or "OT_LNG_CLASS_IS" befor set "retP"
258#define OT_LNG_OBJ_CLASSNAME(obj) MK(ClassName)(OT_Prefix_CALL obj, false)
259#define OT_LNG_OBJ_CLASSNAME_SHORT(obj) MK(ClassName)(OT_Prefix_CALL obj, true)
260#define OT_OBJ_TYPE_STRING(obj) MK(ClassName)(OT_Prefix_CALL obj, false)
261
262// name of the declaring class of the method
263#define OT_LNG_NAME_CLASS_FROM_CONTEXT(ox) \
264 OT_LNG_NAME_FROM_CLASS(Tcl_MethodDeclarerClass(Tcl_ObjectContextMethod(ox)))
265
266#define OT_LNG_OBJV(__skip) objv[__skip]
267
268#define OT_OBJ_TO_CLASS(str) str
269#define OT_OBJ_TO_ENUM(str) #str
270
271#define OT_LNG_SET_VAR(var,val) \
272 if (Tcl_ObjSetVar2(interp, var, NULL, val, TCL_LEAVE_ERR_MSG) == NULL) goto error
273
274// REGISTRY *************************************************************************
275
276#define OT_REGISTRY_AS_TLS
277
278#define RG(_key) MK(reggv)[MK(_key)]
279#ifdef OT_REGISTRY_AS_TLS
281#else
282 MK_TCL_EXTERN_DATA OT_OBJ_T MK(reggv)[100];
283#endif
284
285#define regTclObj(str) MK_TCL_EXTERN_DATA int MK(str);
286#define regTclObj2(def,str) MK_TCL_EXTERN_DATA int MK(def);
287#include "MkRegistry_tcl.h"
288#undef regTclObj
289#undef regTclObj2
290
291#define RL(num) RL_data[num]
292#define RL_init(code) static MkThreadLocal OT_OBJ_T RL_data[10] = {0}; if (RL_data[0] == NULL) { code; }
293#define RL_NewC(num,str) { RL_data[num] = STRN2VAL(#str); Tcl_IncrRefCount(RL_data[num]); }
294#define RL_NewS(num,str) { RL_data[num] = STRN2VAL(str); Tcl_IncrRefCount(RL_data[num]); }
295#define RL_NewI(num,itg) { RL_data[num] = INT2VAL(itg); Tcl_IncrRefCount(RL_data[num]); }
296#define RL_O(num,obj) { RL_data[num] = obj; }
297#define RL_objv(num) (num),RL_data
298#define RL_Free(num) do {Tcl_DecrRefCount(RL_data[num]); RL_data[num]=NULL;} while (0);
299
300MK_TCL_EXTERN_DATA const Tcl_ObjType *MK(tcl_LONG);
301MK_TCL_EXTERN_DATA const Tcl_ObjType *MK(tcl_WIDE);
302MK_TCL_EXTERN_DATA const Tcl_ObjType *MK(tcl_DOUBLE);
303MK_TCL_EXTERN_DATA const Tcl_ObjType *MK(tcl_BOOLEAN);
304MK_TCL_EXTERN_DATA const Tcl_ObjType *MK(tcl_INDEX);
305
306// ERROR ******************************************************************************
307
308#define OT_ERROR_LNG_RETURN return TCL_ERROR
309
310#define OT_ERROR_TYPE(str) \
311 Tcl_SetObjResult(interp, Tcl_ObjPrintf("TYPE ERROR: %s", str));
312
313#define OT_ERROR_SOFT_CONSTRUCTOR(class) { \
314 Tcl_SetResult(interp, "InitSoftError: '" #class "' soft constructor return 'NULL' pointer", TCL_STATIC); \
315}
316
317#define OT_ERROR_CONSTRUCTOR(class) { \
318 Tcl_SetResult(interp, "InitError: '" #class "' constructor return 'NULL' pointer", TCL_STATIC); \
319 if (MkErrorCheckE_0E()) { \
320 Tcl_AppendResult(interp, "\nMqError: ", MkErrorGetText_0E(), NULL); \
321 MkErrorReset_0M(); \
322 } \
323}
324
325// !! attention → always jumps to error
326#define OT_ERROR_NUMARGS(...) \
327 MkErrorC_CheckD(WrongNumArgs(__VA_ARGS__))
328
329#define OT_ERROR_ABNORMAL(mng) { \
330 MkErrorSetV_4M(mng,__func__,999,"AbnormalError: %s", Tcl_GetStringResult(interp));\
331 Tcl_ResetResult(interp); \
332}
333
334//Tcl_SetResult(interp, "NatIsNullError: '" _cls "->" _nat "' is NULL", TCL_STATIC);
335#define OT_ERROR_LNG_RETURN_HDL_NAT_NULL(_hdl) { \
336 Tcl_SetResult(interp, "NatIsNullError : ", TCL_STATIC); \
337 Tcl_AppendResult(interp, MkObjectToString(_hdl)); \
338 return TCL_ERROR; \
339}
340
341#define OT_ERROR_VAR_DEFAULT(...) Tcl_SetObjResult(interp,Tcl_ObjPrintf(__VA_ARGS__));
342
343#define OT_ERROR_LNG_RETURN_VAR_ERROR(...) return ({ OT_ERROR_VAR_DEFAULT(__VA_ARGS__); TCL_ERROR; })
344
345
346// check *********************************************************************************
347
348#define OT_Prefix_ARGS OT_ENV_T interp, MK_RT_ARGS
349#define OT_Prefix_CALL interp, MK_RT_CALL
350#define OT_Check_ARGS MK_RT_ARGS MK_MNG hdl, MK_STRN const arg, TCL_ARGS, int *skipP
351#define OT_Check_CALL(arg) MK_RT_CALL hdl, arg, TCL_ARGS_CALL, &__skip
352#define OT_Check_CALL2(arg) MK_RT_CALL hdl, arg, TCL_ARGS_CALL, skipP
353
354#define OT_CHECK_OPTIONAL(val) if (__skip < objc) {val}
355#define OT_CHECK_REQUIRED(val) val
356
357#define OT_CHECK_NUM_ARGS(min,max) \
358 if ((objc-__skip) < min || (objc-__skip) > max) { \
359 OT_ERROR_NUMARGS(hdl,__skip, objc, min, max, ""); \
360 }
361// printLV("objc<%i>, __skip<%i>, min<1>, max<999>\n",objc, __skip);
362
363#define OT_CHECK_NOARGS \
364 if (__skip != objc) { \
365 OT_ERROR_NUMARGS(hdl,objc, __skip, -999, +999, ""); \
366 }
367
368#define OT_GET_CONSTR_NAME(ctor) VAL2STR(ctor)
369
370MK_TCL_EXTERN OT_SELF_T MK_DECL MK(GetClassObjectFromObj) (MK_RT_ARGS OT_ENV_T interp, OT_OBJ_T selfO);
371
372#define OT_CHECK_BNP(val,len) \
373 if (__skip >= objc) { \
374 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
375 } else { \
376 int i; \
377 val = (MK_BINN) Tcl_GetByteArrayFromObj(objv[__skip++], &i); \
378 len = (MK_SIZE)i; \
379 }
380
381#define OT_CHECK_BCP(val) \
382 if (__skip >= objc) { \
383 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
384 } else { \
385 val = (MK_BIN) Tcl_GetByteArrayFromObj(objv[__skip++], NULL); \
386 }
387
388#define OT_CHECK_BCPN(val) \
389 if (__skip >= objc) { \
390 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
391 } else { \
392 val = (MK_BINN) Tcl_GetByteArrayFromObj(objv[__skip++], NULL); \
393 }
394
395/*
396MK_TCL_EXTERN enum MkErrorE MK_DECL MK(Check__Tcl_Object) (OT_Check_ARGS, OT_SELF_T*);
397#define OT_CHECK__Tcl_Object(val) \
398 MkErrorC_CheckD(MK(Check__Tcl_Object) (OT_Check_CALL(#val), &val));
399*/
400
401// ----------------------------------------------------------------------------
402
403#define MkErrorC_Check(mng,PROC) \
404 if (unlikely(MkErrorCheckI(PROC))) { \
405 OT_ERROR_META_2_LNG(mng); goto error; \
406 }
407
408#define MkErrorC_CheckD(PROC) \
409 if (unlikely(MkErrorCheckI(PROC))) { \
410 OT_ERROR_META_2_LNG(hdl); goto error; \
411 }
412
413#define OT_ERROR_META_2_LNG(m) MK(MkExceptionC_Raise) (OT_Prefix_CALL m, __doc, __FILE__, __LINE__)
414#define OT_ERROR_LNG_2_META(m) MK(MkExceptionC_Catch) (OT_Prefix_CALL m, NULL, __func__)
415
416#define OtErrorCheckLng(cmd) if (cmd != TCL_OK) return TCL_ERROR
417#define OtErrorCheckLngGoto(cmd) if (cmd != TCL_OK) goto error
418#define OtErrorCheckLngGoto1(cmd) if (cmd != TCL_OK) goto error1
419#define OtErrorCheckLngGoto2(cmd) if (cmd != TCL_OK) goto error2
420
421#define check_LNG(code) if ((code) != TCL_OK)
422#define check_NULL(code) if ((code) == NULL)
423#define check_META(code) if (MkErrorCheckI(code))
424
425// new object ******************************************************************************
426
427#define OT_TMP_BOL_OBJ(val) BOL2VAL(val)
428#define OT_TMP_I8_OBJ(val) I82VAL(val)
429#define OT_TMP_I16_OBJ(val) I162VAL(val)
430#define OT_TMP_I32_OBJ(val) INT2VAL(val)
431#define OT_TMP_I64_OBJ(val) I642VAL(val)
432#define OT_TMP_FLT_OBJ(val) FLT2VAL(val)
433#define OT_TMP_DBL_OBJ(val) DBL2VAL(val)
434#define OT_TMP_BIN_OBJ(val,len) BIN2VAL(val,len)
435#define OT_TMP_STR_OBJ(val) STRN2VAL(val)
436#define OT_TMP_CST_OBJ(val) STRN2VAL(val)
437
438// atom ******************************************************************************
439
443mk_inline bool MK_DECL MK(AtomDeleteHard) (MK_RT_ARGS OT_ENV_T, OT_SELF_T);
444mk_inline void MK_DECL MK(AtomUnlink) (MK_RT_ARGS OT_ENV_T, OT_SELF_T);
445mk_inline void MK_DECL MK(AtomDispose) (MK_RT_ARGS OT_SELF_T);
446
447// THIS is an soft-delete called from the "<destructor>", SOFT mean that SELF is already on-DELETE
448#define OT_OBJECT_DELETE_SOFT(O) error: done in AtomMetaDelete
449
450// THIS is an hard-delete called from everywhere, HARD mean that SELF have to be deleted too
451#define OT_OBJECT_DELETE_HARD(O) MK(AtomDeleteHard) (MK_RT_CALL interp,O)
452
453// THIS is an "dispose" delte the link between LNG an MQ
454#define OT_OBJECT_DISPOSE(O) MK(AtomDispose) (MK_RT_CALL O)
455#define OT_OBJECT_DELETE(O) MK(AtomDeleteHard) (MK_RT_CALL interp, O)
456
457#define OT_REF_INCR(_obj) Tcl_IncrRefCount(_obj)
458#define OT_REF_DECR(_obj) Tcl_DecrRefCount(_obj)
459#define OT_REF_INCR_AND_RETURN(_obj) ({ Tcl_IncrRefCount(_obj); _obj;})
460#define OT_REF_DECR_AND_NULL(_obj) if (_obj) { Tcl_DecrRefCount (_obj) ; _obj = NULL; }
461
462//
463// ==================================================================================
464//
465
466#define SETUP_interp MK_UNUSED OT_ENV_T const interp = (OT_ENV_T const) MK_RT_REF.mkThreadData.ptr;
467#define SETUP_mqctx struct MqContextS * const mqctx = (struct MqContextS * const) hdl;
468#define SETUP_tclctx struct TclContextS * const tclctx = (struct TclContextS * const) hdl;
469#define SETUP_selfO OT_SELF_T selfO = OT_SELF_X(hdl);
470#define SETUP_selfX(x) OT_SELF_T selfO = OT_SELF_X(x);
471#define MQCTX (hdl)
472#define TCLCTX ((struct TclContextS * const)hdl)
473#define OT_SELF_O(o) ((OT_SELF_T)(*o).self)
474#define OT_SELF_X(x) OT_SELF_O(MkOBJ(x))
475#define OT_SELF selfO
476#define OT_SELF_NAME_O(o) Tcl_GetObjectName(interp,OT_SELF_O(o))
477#define OT_SELF_CMD_O(o) Tcl_GetObjectCommand(OT_SELF_O(o))
478
479#define SetupHdlFromMetaData_init_2(_CLS,_SHORT) \
480 int __skip; OT_SELF_T selfO; _SHORT hdl; \
481 if (objCtx) { \
482 /* call method via TCL */ \
483 __skip = Tcl_ObjectContextSkippedArgs(objCtx); \
484 selfO = Tcl_ObjectContextObject(objCtx); \
485 hdl = OBJECT2##_CLS(selfO); \
486 } else { \
487 /* call method DIRECT */ \
488 __skip = 0; \
489 selfO = NULL; \
490 hdl = (_SHORT) clientData; \
491 } \
492
493#define SetupHdlFromMetaData_2(_CLS,_SHORT) \
494 SetupHdlFromMetaData_init_2(_CLS,_SHORT) \
495 if (hdl == NULL) { \
496 MkRtSetup_NULL; \
497 OT_ERROR_LNG_RETURN_VAR_ERROR("'%s' hdl is NULL",OT_LNG_OBJ_CLASSNAME_SHORT(SELF2VAL(OT_SELF))); \
498 } \
499 SetupRtFromHdl_XN(hdl); \
500
501#define SetupHdlFromMetaData__null_allow_2(_CLS,_SHORT) \
502 SetupHdlFromMetaData_init_2(_CLS,_SHORT) \
503 SetupRtFromHdl_X(hdl); \
504
505// call ******************************************************************************
506
507#define MkCallS_SIG 0x82335642
508typedef struct MkCallS {
510 enum {
519 OT_OBJ_T my; // if "MkCallS_static" -> this is the CLASS "my"
520 OT_OBJ_T mth; // if 'proc' than NULL if 'method' than "method-name"
521 OT_OBJ_T args; // additionals arguments passed to the calling proc at beginning of the argument list
522 MK_MNG hdl; // always the 'hdl'
523 OT_ENV_T interp; // always the 'interp'
524 MK_RT mkrt; // runtime
525 bool isAlloc; // instance was alloced
526 OT_OBJ_T nsO; // namespace for command resolution
527 OT_NS_T nsPtr; // namespace for command resolution (resolved pointer)
529
530#define MkProcResolve_maxArgsLen 16
532
533mk_inline void NS(ProcResolveAppendArgs) (
534 struct MkCallS *call,
535 int *objcP,
536 OT_OBJ_T objv[]
537) {
538 assert(call != NULL);
539 assert(objcP != NULL);
540 assert(objv != NULL);
541
542 if (call->args) {
543 int myobjc;
544 OT_OBJ_T *myobjv;
545 int objc = *objcP;
546 // call->args already checked to be a valid TCL-LIST
547 Tcl_ListObjGetElements(NULL,call->args,&myobjc,&myobjv);
548 for (int i=0; i<myobjc; i++) {
549//printLLngObj(objv[i])
550 objv[objc++] = myobjv[i];
551 }
552 *objcP = objc;
553 }
554}
555
556mk_inline void MK(CallFree) ( MK_CBP *dataP )
557{
558 assert (dataP != NULL && *dataP != NULL);
559
560 MkCallS * call = *dataP;
561
562 call->signature = 0x0;
563
568 call->nsPtr = NULL;
569
570 if (call->isAlloc) MkSysFree(*dataP);
571 else *dataP = NULL;
572}
573
574mk_inline void MK(CallFreeOnce) ( MK_CBP *dataP )
575{
576 MK(CallFree) (dataP);
577}
578
579#ifdef META_HAS_THREAD
580 #define OT_OBJ_COPY(o) ({OT_OBJ_T t=(o); if (t) { t = Tcl_NewStringObj(Tcl_GetString(t),-1); OT_REF_INCR(t); }; t; })
581#else
582 #define OT_OBJ_COPY(o) ({OT_OBJ_T t=(o); if (t) { OT_REF_INCR(t); }; t; })
583#endif
584
585mk_inline void MK(CallCopy) ( MK_RT_ARGS MK_OBJ obj, MK_CBP *dataP )
586{
587 assert (dataP != NULL && *dataP != NULL);
588
589 MkCallS *call = MkSysMemDup(MK_ERROR_PANIC,*dataP,sizeof(*call));
590 call->isAlloc = true;
591
592 call->my = OT_OBJ_COPY (call->my) ;
593 call->mth = OT_OBJ_COPY (call->mth) ;
594 call->args = OT_OBJ_COPY (call->args) ;
595 call->nsO = OT_OBJ_COPY (call->nsO) ;
596 call->nsPtr = NULL;
597
598 *dataP = call;
599}
600
601// check *****************************************************************************
602
603#define NO_OtCheckEnum
604#define NO_OtCheckEnumFlag
605#define NO_TestObject
607
608#define OT_CHECK_ENUM(ename,val) \
609 if (__skip >= objc) {\
610 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
611 } else { \
612 OtErrorCheckLngGoto(Get_ ## ename ## _FromObj_path (MK_RT_CALL interp,objv[__skip++],&val)); \
613 }
614
615#define OT_CHECK_ENUM_FLAG(ename,val) \
616 if (__skip >= objc) {\
617 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
618 } else { \
619 OtErrorCheckLngGoto(Get_ ## ename ## _FromObj_path (MK_RT_CALL interp,objv[__skip++],&val)); \
620 }
621
622// object 2 native *************************************************************************
623
624
626
627#define OT_CHECK_LNGTMPL(val,func) MkErrorC_CheckD (func(OT_Check_CALL(#val),&val));
628
629#define OT_CHECK_bool(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsBOOL))
630#define OT_CHECK_NB1(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsBOL))
631#define OT_CHECK_NI1(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsI8))
632#define OT_CHECK_NI2(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsI16))
633#define OT_CHECK_U2N(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsU16))
634#define OT_CHECK_NI4(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsI32))
635#define OT_CHECK_U4N(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsU32))
636#define OT_CHECK_NI8(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsI64))
637#define OT_CHECK_IXN(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsLLG))
638#define OT_CHECK_NF4(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsFLT))
639#define OT_CHECK_NF8(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsDBL))
640#define OT_CHECK_STRN(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsSTRN))
641#define OT_CHECK_NIL(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsLONG))
642#define OT_CHECK_NIH(val) MK_HDL_REF_S3(OT_CHECK_) (val)
643
644#define OT_CHECK_STRN_NULL(val) OT_CHECK_LNGTMPL(val,MK(Obj_AsCSTNull))
645
646MK_TCL_EXTERN enum MkErrorE MK_DECL MK(Obj_AsSTR_COPY) (OT_Check_ARGS,MK_STR,size_t);
647#define OT_CHECK_C_COPY(val,size) MkErrorC_CheckD (MK(Obj_AsSTR_COPY)(OT_Check_CALL(#val),val,size));
648
649// inspection *************************************************************************
650
651#define OT_GET_CALL_PROC MK(Get_Call_Proc)(MK_RT_CALL interp,&frame)
652#define OT_GET_CALL_FILE MK(Get_Call_File)(MK_RT_CALL interp,&frame)
653#define OT_GET_CALL_LINE MK(Get_Call_Line)(MK_RT_CALL interp,&frame)
654
659MK_TCL_EXTERN bool MK_DECL MK(Get_Call_Stack) ( MK_RT_ARGS OT_ENV_T, MK_ERR const, int );
660
661// enum ******************************************************************************
662
664 const char *key;
665 int val;
666};
667
668MK_TCL_EXTERN int MK_DECL MK(EnumFlagWorker) (MK_RT_ARGS OT_ENV_T , const struct LookupEnumE*, OT_OBJ_T , int*);
669
670// from MkBufferC_tcl.c
672MK_TCL_EXTERN int MK_DECL MK(MkBufferC_GetBFL) (MkBufferC_ARGS);
673MK_TCL_EXTERN int MK_DECL MK(MkBufferC_Temp) (MkBufferC_ARGS);
674
675// from MkBufferListC_tcl.c
677
682
683typedef int (*LookupClassF) (SKIP_ARGS);
684
686 const char *key;
688};
689
690#define WNA(min,max,txt) { \
691/* printObjV */ \
692 if (objc<(__skip+min) || objc>(__skip+max)) { \
693 Tcl_WrongNumArgs (interp, __skip, objv, txt); \
694 return TCL_ERROR; \
695 } \
696}
697
699
704
705typedef struct {
707 size_t nmemb;
708 const Tcl_MethodType* list;
711} OtUnknownS;
712
713MK_TCL_EXTERN int MK_DECL MK(UnknownSetup) (OT_ENV_T, OT_SELF_T, const Tcl_MethodType[], OtUnknownS*);
714
715//*****************************************************************************
716//*
717//* FRAME feature
718//*
719//*****************************************************************************
720
727typedef struct MkVarFrameS * OT_VARFRAME;
728
729#define OT_VARFRAME_CREATE \
730 struct MkVarFrameS otVarFrame = {50, 0}; otVarFrame.data = otVarFrame.prealloc; \
731 OT_VARFRAME varframe = &otVarFrame;
732
733#define OT_VARFRAME_DELETE { \
734 for (int i=0; i<varframe->num; i++) Tcl_DecrRefCount(varframe->data[i]); \
735 varframe = NULL; \
736}
737
738#define OT_VARFRAME_ARGS MK_RT_ARGS OT_VARFRAME varframe
739#define OT_VARFRAME_CALL MK_RT_CALL varframe
740
741static inline OT_OBJ_T MK(OT_VARFRAME_ADD)(OT_VARFRAME_ARGS, OT_OBJ_T add) {
742 if (varframe != NULL) {
743 if (varframe->num >= varframe->max) {
744 void *tmp;
745 if (varframe->data == varframe->prealloc) {
746 tmp = MkSysCalloc(MK_ERROR_PANIC,(size_t)varframe->max*2,sizeof(OT_OBJ_T));
747 memcpy(tmp,varframe->data,(size_t)varframe->max*sizeof(OT_OBJ_T));
748 } else {
749 tmp = MkSysReCalloc(MK_ERROR_PANIC,varframe->data,varframe->max,varframe->max,sizeof(OT_OBJ_T));
750 }
751 varframe->data = tmp;
752 varframe->max *= 2;
753 }
754 varframe->data[varframe->num++] = add;
755 Tcl_IncrRefCount(add);
756 }
757 return add;
758}
759
760#define OT_VARFRAME_OBJ_RESULT(itp) MK(OT_VARFRAME_ADD)(OT_VARFRAME_CALL,Tcl_GetObjResult(itp))
761
762
763/*****************************************************************************/
764/* MARK_F */
765/* functions */
766/* */
767/*****************************************************************************/
768
769MK_TCL_EXTERN MK_STR MK_DECL MK(PrintLngObj) (OT_Prefix_ARGS const char *, OT_OBJ_T );
770//MK_TCL_EXTERN int MK_DECL MK(EvalObjv) (OT_ENV_T, int, OT_OBJ_T const[], int);
771MK_TCL_EXTERN int MK_DECL MK(EvalObjvVA) (OT_ENV_T, int, ...);
772//OT_OBJ_T MK(EvalObjvVR) (OT_VARFRAME_ARGS,OT_ENV_T, int, ...);
774
777MK_TCL_EXTERN enum MkErrorE MK_DECL MK(LngListToMkBufferListS) ( OT_Prefix_ARGS OT_OBJ_T , MK_BFL* );
778
779mk_inline int NS(EvalObjv) (
780 OT_ENV_T interp,
781 int objc,
782 OT_OBJ_T const objv[],
783 int flags
784) {
785 int i,ret;
786//printAry(objc,objv)
787 for (i=0;i<objc;i++) Tcl_IncrRefCount(objv[i]);
788 ret = Tcl_EvalObjv (interp, objc, objv, flags);
789 for (i=0;i<objc;i++) Tcl_DecrRefCount(objv[i]);
790 return ret;
791}
792
793// stolen from "Tcl_MethodType"
794typedef struct {
795 int version; /* Structure version field. Always to be equal
796 * to TCL_OO_METHOD_VERSION_CURRENT in
797 * declarations. */
798 const char *name; /* Name of this type of method, mostly for
799 * debugging purposes. */
800 Tcl_ObjCmdProc *callProc;
801 /* How to invoke this method. */
802 Tcl_CmdDeleteProc *deleteProc;
803 /* How to delete this method's type-specific
804 * data, or NULL if the type-specific data
805 * does not need deleting. */
806 void *cloneProc; /* How to copy this method's type-specific
807 * data, or NULL if the type-specific data can
808 * be copied directly. */
810
811
812#if 0
813MK_TCL_EXTERN int MK_DECL MK(NewEnsemble) (OT_ENV_T , const char *, OT_NS_T , const OtObjProcDefS[],
814 ClientData);
815#endif
816
817MK_TCL_EXTERN int MK_DECL MK(FillNamespace) (OT_ENV_T , OT_NS_T , const OtObjProcDefS[], ClientData);
818// from MkExceptionC_tcl.c
819
820MK_TCL_EXTERN MK_ERR MK_DECL MK(MkExceptionC_Catch) (OT_Prefix_ARGS MK_MNG const, MK_EXP const, MK_STRN const);
821MK_TCL_EXTERN void MK_DECL MK(MkExceptionC_Raise) (OT_Prefix_ARGS MK_MNGN const, MK_STRN const, MK_STRN const, MK_I32);
822
823// from MkCall_tcl.c
824
825void MK_DECL NS(ObjectDeleteFree) ( MkObjectDeleteFreeF_ARGS );
826enum MkErrorE MK_DECL NS(ObjectDeleteCall) ( MkObjectDeleteCallF_ARGS );
827
828// enum ******************************************************************************
829
830// BEGIN-enum-tostring - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
831
832#define OT_NEW_Mk_enum_OBJ(typ,val) MK(Mk ## typ ## _ToString(val))
833
835
837
839
841
842// END-enum-tostring - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
843
844// BEGIN-enum - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
845
846MK_TCL_EXTERN int MK_DECL MK(Get_MkErrorE_FromObj)(MK_RT_ARGS OT_ENV_T interp, OT_OBJ_T enumE, enum MkErrorE *ret);
847#define Get_MkErrorE_FromObj_path MK(Get_MkErrorE_FromObj)
848
849MK_TCL_EXTERN int MK_DECL MK(Get_MkIdSE_FromObj)(MK_RT_ARGS OT_ENV_T interp, OT_OBJ_T enumE, enum MkIdSE *ret);
850#define Get_MkIdSE_FromObj_path MK(Get_MkIdSE_FromObj)
851
852MK_TCL_EXTERN int MK_DECL MK(Get_MkTimeoutE_FromObj)(MK_RT_ARGS OT_ENV_T interp, OT_OBJ_T enumE, enum MkTimeoutE *ret);
853#define Get_MkTimeoutE_FromObj_path MK(Get_MkTimeoutE_FromObj)
854
855MK_TCL_EXTERN int MK_DECL MK(Get_MkTypeE_FromObj)(MK_RT_ARGS OT_ENV_T interp, OT_OBJ_T enumE, enum MkTypeE *ret);
856#define Get_MkTypeE_FromObj_path MK(Get_MkTypeE_FromObj)
857
858// END-enum - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
859
860/*****************************************************************************/
861/* */
862/* definition's */
863/* */
864/*****************************************************************************/
865
866#define PTR2VAL(nat) (OT_OBJ_T)(nat)
867#define SELF2VAL(slf) Tcl_GetObjectName(interp,slf)
868#define META2VAL_X(x) SELF2VAL(OT_SELF_X(x))
869#define META2VAL_O(o) SELF2VAL(OT_SELF_O(o))
870
871#define I82VAL(nat) Tcl_NewIntObj(nat)
872#define BOL2VAL(nat) Tcl_NewBooleanObj(nat)
873#define I162VAL(nat) Tcl_NewIntObj(nat)
874#define U162VAL(nat) Tcl_NewIntObj((int)nat)
875#define INT2VAL(nat) Tcl_NewIntObj(nat)
876#define I642VAL(nat) Tcl_NewWideIntObj(nat)
877#define HDL2VAL(nat) Tcl_NewIntObj(nat)
878#define LLG2VAL(nat) Tcl_NewWideIntObj(nat)
879#define FLT2VAL(nat) Tcl_NewDoubleObj(nat)
880#define DBL2VAL(nat) Tcl_NewDoubleObj(nat)
881#define STRN2VAL(nat) MK(STRN2VAL)(nat)
882#define BIN2VAL(ptr,len) Tcl_NewByteArrayObj((const unsigned char*)ptr,(int)len)
883#define STR2VAL(ptr,len) Tcl_NewStringObj((const char*)ptr,(int)len)
884#define LONG2VAL(nat) Tcl_NewLongObj(nat)
885
886#define VAL2STR(obj) Tcl_GetString(obj)
887#define VAL2SELF(obj) Tcl_GetObjectFromObj(interp,obj)
888
889#define SELF2MNG(slf) Tcl_ObjectGetMetadata(slf, &MK(AtomMeta))
890
891// *********************************************************************************************
892
894 // mark=MK_NULL
895 if (val==MK_NULL) {
896 return RG(MK_NULL_OBJ);
897 } else {
898 return Tcl_NewStringObj(val,-1);
899 }
900}
901
902/*****************************************************************************/
903/* */
904/* former TclMsgque.c */
905/* */
906/*****************************************************************************/
907
908// TODO → who set OT_SHARED_IS_DLL ?
909#ifdef OT_SHARED_IS_DLL
910# define OT_TCL_EXTERN __declspec(dllexport)
911#else
912# define OT_TCL_EXTERN __attribute__ ((visibility("default")))
913#endif
914
915/*****************************************************************************/
916/* */
917/* Class_API */
918/* */
919/*****************************************************************************/
920
921#define OT_TMP_BAC_OBJ(val) MK(MkBufferListC_ObjNew) (MK_RT_CALL interp,val)
922
923// BEGIN-CLASS - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
924
925// ----------------------------------------------------------------------
926// class: MkBufferListC
927
928 #define MkBufferListC_lngO MK(MkBufferListC)
931
932 int MK(pMkBufferListC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
933
934 #define OT_retObj_SET_BFL(nat) retObj = MK(MkBufferListC_ObjNew) (MK_RT_CALL interp,nat)
935
936 #define OT_TMP_BFL_OBJ(val) MK(MkBufferListC_ObjNew) (MK_RT_CALL interp,val)
937
939 mk_inline OT_OBJ_T MK(MkBufferListC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkBufferListC_type hdl) {
940 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkBufferListC_X2obj(hdl)) : MK(MkBufferListC_MK_NULL) );
941 }
942
943// ----------------------------------------------------------------------
944// class: MkBufferC
945
946 #define MkBufferC_lngO MK(MkBufferC)
949
950 int MK(pMkBufferC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
951
952 #define OT_retObj_SET_BUF(nat) retObj = MK(MkBufferC_ObjNew) (MK_RT_CALL interp,nat)
953
954 #define OT_TMP_BUF_OBJ(val) MK(MkBufferC_ObjNew) (MK_RT_CALL interp,val)
955
957 mk_inline OT_OBJ_T MK(MkBufferC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkBufferC_type hdl) {
958 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkBufferC_X2obj(hdl)) : MK(MkBufferC_MK_NULL) );
959 }
960
961// ----------------------------------------------------------------------
962// class: MkBufferStreamC
963
964 #define MkBufferStreamC_lngO MK(MkBufferStreamC)
966 MK_TCL_EXTERN_DATA MkThreadLocal OT_OBJ_T MK(MkBufferStreamC_MK_NULL);
967
968 int MK(pMkBufferStreamC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
969
970 #define OT_retObj_SET_BUS(nat) retObj = MK(MkBufferStreamC_ObjNew) (MK_RT_CALL interp,nat)
971
972 #define OT_TMP_BUS_OBJ(val) MK(MkBufferStreamC_ObjNew) (MK_RT_CALL interp,val)
973
975 mk_inline OT_OBJ_T MK(MkBufferStreamC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkBufferStreamC_type hdl) {
976 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkBufferStreamC_X2obj(hdl)) : MK(MkBufferStreamC_MK_NULL) );
977 }
978
979// ----------------------------------------------------------------------
980// class: MkErrorC
981
982 #define MkErrorC_lngO MK(MkErrorC)
985
986 int MK(pMkErrorC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
987
988 #define OT_retObj_SET_ERR(nat) retObj = MK(MkErrorC_ObjNew) (MK_RT_CALL interp,nat)
989
990 #define OT_TMP_ERR_OBJ(val) MK(MkErrorC_ObjNew) (MK_RT_CALL interp,val)
991
993 mk_inline OT_OBJ_T MK(MkErrorC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkErrorC_type hdl) {
994 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkErrorC_X2obj(hdl)) : MK(MkErrorC_MK_NULL) );
995 }
996
997// ----------------------------------------------------------------------
998// class: MkLogFileC
999
1000 #define MkLogFileC_lngO MK(MkLogFileC)
1003
1004 int MK(pMkLogFileC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
1005
1006 #define OT_retObj_SET_LFL(nat) retObj = MK(MkLogFileC_ObjNew) (MK_RT_CALL interp,nat)
1007
1008 #define OT_TMP_LFL_OBJ(val) MK(MkLogFileC_ObjNew) (MK_RT_CALL interp,val)
1009
1011 mk_inline OT_OBJ_T MK(MkLogFileC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkLogFileC_type hdl) {
1012 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkLogFileC_X2obj(hdl)) : MK(MkLogFileC_MK_NULL) );
1013 }
1014
1015// ----------------------------------------------------------------------
1016// class: MkObjectC
1017
1018 #define MkObjectC_lngO MK(MkObjectC)
1021
1022 int MK(pMkObjectC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
1023
1024 #define OT_retObj_SET_OBJ(nat) retObj = MK(MkObjectC_ObjNew) (MK_RT_CALL interp,nat)
1025
1026 #define OT_TMP_OBJ_OBJ(val) MK(MkObjectC_ObjNew) (MK_RT_CALL interp,val)
1027
1029 mk_inline OT_OBJ_T MK(MkObjectC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkObjectC_type hdl) {
1030 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkObjectC_X2obj(hdl)) : MK(MkObjectC_MK_NULL) );
1031 }
1032
1033// ----------------------------------------------------------------------
1034// class: MkRuntimeC
1035
1036 #define MkRuntimeC_lngO MK(MkRuntimeC)
1039
1040 int MK(pMkRuntimeC_Init) (MK_RT_ARGS OT_ENV_T, OT_NS_T );
1041
1042 #define OT_retObj_SET_RT(nat) retObj = MK(MkRuntimeC_ObjNew) (MK_RT_CALL interp,nat)
1043
1044 #define OT_TMP_RT_OBJ(val) MK(MkRuntimeC_ObjNew) (MK_RT_CALL interp,val)
1045
1047 mk_inline OT_OBJ_T MK(MkRuntimeC_ObjNew) (MK_RT_ARGS OT_ENV_T interp, MkRuntimeC_type hdl) {
1048 return ( hdl ? MK(AtomObjNew) (MK_RT_CALL interp, MkRuntimeC_X2obj(hdl)) : MK(MkRuntimeC_MK_NULL) );
1049 }
1050
1051// END-CLASS - created by 'tcl_MqS.tcl -i NHI1_HOME/theKernel/c/gen/c_mkkernel.meta' - DO NOT change
1052
1053/*****************************************************************************/
1054/* */
1055/* reference */
1056/* */
1057/*****************************************************************************/
1058
1059#define ME_REF_MkBinaryR MkBinaryR
1060#define OT_GET__ME_REF_MkBinaryR(b) BIN2VAL(b.data,b.size)
1061#define VAL2MkBinaryR(obj) \
1062 ({int size;unsigned char * bin =Tcl_GetByteArrayFromObj(obj,&size);MkBinaryCreate(size,bin);})
1063#define OT_CHECK__ME_REF_MkBinaryR(val) \
1064 if (__skip >= objc) { \
1065 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
1066 } else { \
1067 val = VAL2MkBinaryR(objv[__skip++]); \
1068 }
1069
1070#define ME_REF_MkStringR MkStringR
1071#define OT_GET__ME_REF_MkStringR(s) STR2VAL(s.ptr,s.len)
1072#define VAL2MkStringR(obj) \
1073 ({int len;char * str =Tcl_GetStringFromObj(obj,&len);MkStringCreate(len,str);})
1074#define OT_CHECK__ME_REF_MkStringR(val) \
1075 if (__skip >= objc) { \
1076 OT_ERROR_NUMARGS(hdl,__skip, objc, -999, +999, #val); \
1077 } else { \
1078 val = VAL2MkStringR(objv[__skip++]); \
1079 }
1080
1082{
1083 int len = 0;
1084 char* str = Tcl_GetStringFromObj(tclO,&len);
1085 return MkStringCreate(len,str);
1086}
1087
1088/*****************************************************************************/
1089/* */
1090/* enum helpers */
1091/* */
1092/*****************************************************************************/
1093
1094// helper for xxx_ToString, the ERROR returned from Tcl_ListObjAppendElement is NOT checked
1095#define ot_fixstr(_s) _s,strlen(_s)
1096#define ot_fixstrobj(_s) Tcl_NewStringObj(_s,strlen(_s))
1097#define ot_enum_append(_o,_s) Tcl_ListObjAppendElement(NULL,_o,ot_fixstrobj(_s))
1098
1099/*****************************************************************************/
1100/* */
1101/* inline functions */
1102/* */
1103/*****************************************************************************/
1104
1105// debugging ***********************************************************************************
1106
1107#define printLng(var) printV(#var" = '%s' [ref=%i]",(var?VAL2STR(var):"NULL"),(var)?(var)->refCount:-1)
1108#define printXLng(x,var) printXV(x,#var" = '%s' [ref=%i]",(var?VAL2STR(var):"NULL"),(var)?(var)->refCount:-1)
1109#define printLngObj(var) if (var) {printTxt(MK(PrintLngObj)(OT_Prefix_CALL #var,var))} else {printTxt(#var "=NULL")}
1110#define printXLngObj(x,var) if (var) {printXC2(x,MK(PrintLngObj)(OT_Prefix_CALL #var,var))} else {printTxt(#var "=NULL")}
1111#define printLLngObj(var) if (var) {printXC2(META_CONTEXT_S,MK(PrintLngObj)(OT_Prefix_CALL #var,var))} else {printTxt(#var "=NULL")}
1112
1113#define printLngErrorCode() do { \
1114 OT_OBJ_T errorCode = Tcl_GetVar2Ex (interp, "errorCode", NULL, TCL_GLOBAL_ONLY); \
1115 printLngObj(errorCode); \
1116} while (0); \
1117
1118#define printLngErrorInfo() do { \
1119 OT_OBJ_T errorInfo = Tcl_GetVar2Ex (interp, "errorInfo", NULL, TCL_GLOBAL_ONLY); \
1120 printLngObj(errorInfo); \
1121} while (0); \
1122
1123#define printObjv printV( "__skip=%i, objc=%i",__skip,objc) ; printAry3( " ",objc,objv)
1124#define printXObjv(x) printXV(x,"__skip=%i, objc=%i",__skip,objc) ; printXAry4(x, " ",objc,objv)
1125
1126#define printAry(c,o) printAry3(#o,c,o)
1127#define printAryDetail(c,o) for(int i=0;i<c;i++) { printLngObj(o[i]) }
1128
1129#define printXAry(x,pre,c,o) printXAry4(x,"",c,o)
1130#define printXAry4(x,pre,c,o) for(int i=0;i<c;i++) { printXV(x,"%2i= %s",i,o[i]?Tcl_GetString(o[i]):"NULL"); }
1131#define printXAryDetail(x,c,o) for(int i=0;i<c;i++) { printXLngObj(x,o[i]) }
1132
1133#define printAry3(txt, c,o) do { \
1134 mk_dbg_Z_start(512,MK_COLOR_BLUE "%s : ",txt); \
1135 for(int i=0;i<c;i++) { \
1136 mk_dbg_Z_next(MK_COLOR_YELLOW "[%d:%p]" MK_COLOR_RESET "='%s' ",i,o[i],o[i]?Tcl_GetString(o[i]):"NULL"); \
1137 } \
1138 mk_dbg_Z_end(); \
1139} while (0)
1140
1141#define printAryX(x,t,c,o) \
1142 printXV(x, "%-15s = ",t); \
1143 for(int i=0;i<c;i++) { \
1144 fprintf(stderr, "'%s' ",o[i]?Tcl_GetString(o[i]):"NULL"); \
1145 } \
1146 fputc('\n', stderr);
1147
1148#define printAryL(t,c,o) printAryX(META_CONTEXT_S,t,c,o) \
1149
1150#define xstr(s) str(s)
1151#define str(s) #s
1152
1153#define printLngClass(clsC) printV(#clsC " name = %s\n", OT_LNG_NAME_FROM_CLASS(clsC))
1154#define printLngObject(objO) printV(#objO " name = %s\n", OT_LNG_NAME_FROM_OBJECT(objO))
1155
1156// MK_TCL_EXTERN void MK_DECL MK(PrintLngObjAsObject)(MK_RT_ARGS OT_ENV_T interp, MK_STRN name, OT_OBJ_T in, MK_STRN proc);
1157// #define MkPrintLngObjAsObject(inobj) MK(PrintLngObjAsObject)(MK_RT_CALL interp,#inobj,inobj,__func__);
1158
1164
1166{
1167 #define __doc "AtomObjNew"
1168 MK_PTR selfO = NULL;
1169 // force "class-NULL object → test done BEFORE "AtomObjNew" is called
1170 assert(obj != NULL);
1171 //if (obj == NULL) return RG(nullObj);
1172 MkErrorC_Check(obj, MkSelfNew(obj,&selfO,interp))
1173 OT_OBJ_T ret = Tcl_GetObjectName(interp,(OT_SELF_T)selfO);
1174 return ret;
1175 #undef __doc
1176error:
1177 return NULL;
1178}
1179
1180// update SELF if OBJECT is already available
1181// CALLED from: "<contructor>", MkAtomCreate
1184 OT_ENV_T interp,
1185 OT_SELF_T object,
1186 MK_OBJ obj
1187) {
1188 if (obj) MkRefIncrSelf (obj, (void*) object, interp);
1189 ClientData meta = Tcl_ObjectGetMetadata(object,&MK(AtomMeta));
1190 // a "reborn" object as result from a AtomMetaDelete→MkRefDecrWithoutSelf→self=NULL
1191 // BUG fix for LibLcConfig_lc_prv.c→pSettingDelete
1192 if (meta != (ClientData)obj) {
1193 if (meta) {
1194 MkDLogV_O(obj, 3, "WARNING: REBORN object[%s] REPLACE meta[%p -> %p]\n", \
1195 OT_LNG_FULLNAME_FROM_OBJECT(object), meta, obj);
1196 } else {
1197 MkDLogV_O(obj, 6, "INFO: BORN object[%s] with NEW meta[%p]\n", \
1198 OT_LNG_FULLNAME_FROM_OBJECT(object),obj);
1199 }
1200 Tcl_ObjectSetMetadata(object,&MK(AtomMeta),(ClientData)obj);
1201 } else {
1202 // This is a result of a DELETE & CREATE
1203 if (obj != NULL) {
1204 MkDLogV_O(obj, 3, "WARNING: REBORN object[%s] with SAME meta[%p]\n", \
1205 OT_LNG_FULLNAME_FROM_OBJECT(object),obj);
1206 }
1207 Tcl_ObjectSetMetadata(object,&MK(AtomMeta),(ClientData)obj);
1208 }
1209 return object;
1210}
1211
1212// create OBJECT and update SELF
1213// CALLED from: "*_SelfCreate"
1216 OT_ENV_T interp,
1217 MK_OBJ obj,
1218 OT_CLS_T class,
1219 MK_STRN name,
1220 MK_STRN ns
1221) {
1222 // create name if not set
1223 #define BUFLEN 127
1224 char nameBuf[BUFLEN+1] = {0};
1225 int retLen = 0;
1226 if (name == NULL) {
1227 if (obj) {
1228 retLen = snprintf(nameBuf,BUFLEN,"%s::<%s-%p>",ns?ns:"",obj->type->type_name,obj);
1229 } else {
1230 MkLogV_1("SUSPICIOS WARNING[%s]: 'name' and 'obj' are NULL", OT_LNG_NAME_FROM_CLASS(class));
1231 retLen = snprintf(nameBuf,BUFLEN,"%s::<UNKNOWN>",ns?ns:"");
1232 }
1233 } else {
1234 retLen = snprintf(nameBuf,BUFLEN,"%s::%s",ns?ns:"",name);
1235 }
1236 if (retLen>=BUFLEN) {
1237 MkLogV_1("SUSPICIOS WARNING[%s]: 'name' truncate to '%s'", OT_LNG_NAME_FROM_CLASS(class), nameBuf);
1238 }
1239 #undef BUFLEN
1240
1241 OT_OBJ_T nameObj = STRN2VAL(nameBuf);
1242 OT_REF_INCR(nameObj);
1243 name = nameBuf;
1244
1245 // 1. with the "noSelf" feature no "self" pointer is saved into "obj->self" and
1246 // the "atomCreate" is always called -> BUT an object COULD be already available.
1247 // 2. multiple objects using the SAME name are possible, but not allowed.
1248 OT_SELF_T object = NULL;
1249 if (obj && Tcl_GetCommandFromObj(interp, nameObj) != NULL) {
1250 object = Tcl_GetObjectFromObj(interp,nameObj);
1251 // don't trust the name -> get REAL MQ-OBJ from TCL-OBJECT
1252 MK_OBJ object_hdl = MkObj(SELF2MNG(object));
1253 if (object_hdl == obj) {
1254 // OK: "reborn" self or stalled delete or something broken
1255
1256 // SUSPICIUS -> self == NULL but command is available
1257 // PROBLEM: MkAtomInit->Tcl_ObjectSetMetadata" will DECR the refCount from object_hdl.
1258 // With refCount <= 1 the "obj" will be deleted !!
1259 // restrict to "obj->isLocal" because this was the concret problem with "ReadBUF" reference
1260 //if (obj->self == NULL && obj->isLocal) MkRefIncr(obj);
1261 if (obj->self == NULL && obj->obj_protect.isLocal)
1262 MkPanicV_2(obj,"reuse tcl-command<%s> with mq-obj<%p>", name, object_hdl);
1263 } else {
1264 // ATTENTION: MkAtomInit->Tcl_ObjectSetMetadata will DECR the refCount from object_hdl
1265 MkLogV_2(object_hdl, "MANIPULATION WARNING[%s]: found tcl-command<%s> with wrong mq-obj<%p>\n",
1266 OT_LNG_NAME_FROM_CLASS(class), name, object_hdl);
1267 }
1268 }
1269
1270 // create object WITHOUT calling the CONSTR because the MK_OBJ is already available
1271 // tclOO.c: Run constructors, except when objc < 0, which is a special flag case
1272 // used for object cloning only.
1273 if (object==NULL) {
1274 object = Tcl_NewObjectInstance(interp, class, name, name, -1, NULL, 0);
1275 }
1276
1277//printV("class=%s(%p), object=%s(%p)\n", OT_LNG_NAME_FROM_CLASS(class), class, OT_LNG_FULLNAME_FROM_OBJECT(object), object)
1278
1279 check_NULL(object) {
1281 return NULL;
1282 }
1283
1284 if (nameObj) Tcl_DecrRefCount(nameObj);
1285 return MK(AtomInit)(MK_RT_CALL interp,object,obj);
1286}
1287
1288// TCL object is still alive
1289// called by: "Delete" and "Dispose" as pseudo-DTOR
1290// META: is called when the META object is destroyed and SELF does NOT belongs to the META.
1291mk_inline bool MK(AtomDeleteHard)(MK_RT_ARGS OT_ENV_T interp, OT_SELF_T selfO) {
1292 assert(interp!=NULL || selfO!=NULL);
1293 if (Tcl_InterpDeleted(interp) || Tcl_ObjectDeleted(selfO)) return false;
1294 check_LNG(Tcl_DeleteCommandFromToken (interp, Tcl_GetObjectCommand(selfO))) {
1296 return false;
1297 }
1298 return true;
1299}
1300
1301// TCL object is still alive but can NOT be deleted
1302// META: is called when the META object is destroyed and SELF does NOT belong to the META.
1303mk_inline void MK(AtomUnlink)(MK_RT_ARGS OT_ENV_T interp, OT_SELF_T selfO) {
1304 assert(interp!=NULL || selfO!=NULL);
1305 Tcl_ObjectSetMetadata(selfO,&MK(AtomMeta),NULL);
1306}
1307
1308// SOFT: delete META if TCL is still active
1309// CALLED from: "Dispose"
1310mk_inline void MK(AtomDispose) (MK_RT_ARGS OT_SELF_T selfO)
1311{
1312 assert(selfO!=NULL);
1313 MK_MNG mng = SELF2MNG(selfO);
1314 check_NULL(mng) return;
1315 MK_OBJ obj = MkObj(mng);
1316 check_NULL(obj) return;
1317 // unlink TCL from META
1319 // unlink META from TCL → call: AtomMetaDelete, with disabled META
1320 Tcl_ObjectSetMetadata(selfO,&MK(AtomMeta),NULL);
1321}
1322
1323#undef HEADER
#define OT_ERROR_ABNORMAL(mng)
#define check_NULL(code)
#define MK(n)
Tcl_Class OT_CLS_T
Tcl_Namespace * OT_NS_T
MK_STRN OT_ENUM_T
#define OT_LNG_NAME_FROM_CLASS(_cls)
#define SKIP_ARGS
OtUnknownE
@ OT_UNKNOWN_CLASS
@ OT_UNKNOWN_INSTANCE
static MkStringR Ot_GetStringFromObj(OT_OBJ_T tclO)
#define OT_Check_ARGS
#define SELF2MNG(slf)
#define OT_LNG_FULLNAME_FROM_OBJECT(_obj)
#define TCL_ARGS
#define MkBufferC_ARGS
#define NS(n)
#define MK_TCL_EXTERN
static library
struct MkVarFrameS * OT_VARFRAME
int(* LookupClassF)(SKIP_ARGS)
#define check_LNG(code)
struct MkCallS MkCallS
Tcl_Object OT_SELF_T
#define OT_OBJ_COPY(o)
#define OT_REF_DECR_AND_NULL(_obj)
#define RG(_key)
#define str(s)
#define BUFLEN
#define OT_REF_INCR(_obj)
#define MK_TCL_EXTERN_DATA
#define MkBufferListC_ARGS
#define MkErrorC_Check(mng, PROC)
Tcl_Interp * OT_ENV_T
#define OT_Prefix_ARGS
Tcl_Obj * OT_OBJ_T
#define STRN2VAL(nat)
#define OT_VARFRAME_ARGS
OT_ProcRet NS MkBufferC_ToObject(MkBufferC_ARGS)
OT_ProcRet MK MkBufferListC_ToList(MkBufferListC_ARGS)
#define MkBufferC_type
#define MkBufferC_X2obj(x)
#define MkBufferListC_type
#define MkBufferListC_X2obj(x)
#define MkBufferStreamC_type
#define MkBufferStreamC_X2obj(x)
#define MkErrorC_X2obj(x)
#define MkErrorC_type
#define MkPanicV_2(fmtobj, printfmt,...)
#define MK_ERROR_PRINT
#define MK_ERROR_PANIC
#define MK_DECL
#define mk_inline
#define MK_ARTIFICIAL
#define MK_NULL
MK_STRN MkTimeoutE_ToString(enum MkTimeoutE value)
MkTimeoutE
MK_STRN MkIdSE_ToString(enum MkIdSE value)
MK_STRN MkTypeE_ToString(enum MkTypeE value)
MkErrorE
MkTypeE
MK_STRN MkErrorE_ToString(enum MkErrorE value)
static MkStringR MkStringCreate(MK_NUM len, MK_STRN str)
const MK_PTRB * MK_MNGN
int32_t MK_NUM
MK_PTRB * MK_PTR
const MK_STRB * MK_STRN
MK_PTRB * MK_MNG
MK_PTRB const * MK_EXP
unsigned int MK_SIG
MK_PTRB * MK_CBP
MK_STRB * MK_STR
signed int MK_I32
#define MkLogFileC_X2obj(x)
#define MkLogFileC_type
struct MkObjectS * MK_OBJ
#define MkObjectC_X2obj(x)
#define MkObjectC_type
static MK_OBJ MkObj(MK_MNG mng)
#define MkLogV_1(printfmt,...)
#define MkDLogV_O(fmtobj, _debug, printfmt,...)
#define MkLogV_2(fmtobj, printfmt,...)
#define MkSelfNew(...)
#define MkRefDecrWithoutSelf(...)
static void MkRefIncrSelf(MK_OBJ const obj, MK_PTR const self, MK_PTR const env)
MkIdSE
MK_PTR MkSysCalloc(MK_OBJN fmtobj, size_t const nmemb, size_t const size)
#define MkSysFree(pointer)
MK_PTR MkSysMemDup(MK_OBJN fmtobj, MK_PTRN const blck, size_t const size)
MK_PTR MkSysReCalloc(MK_OBJN fmtobj, MK_PTR const buf, MK_NUM const oldnum, MK_NUM const addnum, size_t const size)
#define MkObjectDeleteCallF_ARGS
#define MkObjectDeleteFreeF_ARGS
#define MkRuntimeC_type
#define MkRuntimeC_X2obj(x)
#define MkThreadLocal
#define MK_RT_CALL
#define MK_RT_ARGS
struct MkTypeS * MK_TYP
mk_misc_ObjAs_lng.h - 13 Feb 2025 - aotto1968
mk_misc_check_lng.h - 21 Feb 2025 - aotto1968
bool MK TestObject(OT_Prefix_ARGS OT_OBJ_T lngO, OT_CLS_T typeO, MK_OBJ *objP, MkTestClassE *flagP)
mk_type_S_lng.h - 10 Apr 2025 - aotto1968
LookupClassF keyF
const char * key
const char * key
OT_OBJ_T mth
OT_ENV_T interp
OT_OBJ_T args
enum MkCallS::@3 type
OT_NS_T nsPtr
OT_OBJ_T nsO
MK_SIG signature
OT_OBJ_T my
OT_OBJ_T prealloc[50]
OT_OBJ_T * data
Tcl_ObjCmdProc * callProc
const char * name
Tcl_CmdDeleteProc * deleteProc
OT_CLS_T classC
OT_SELF_T classO
const Tcl_MethodType * list
OtUnknownE what