File: tclstuff.h

package info (click to toggle)
tcl-unix-sockets 0.5-3
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 644 kB
  • sloc: ansic: 392; sh: 371; tcl: 40; makefile: 25
file content (150 lines) | stat: -rw-r--r-- 4,302 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
// Written by Cyan Ogilvie, and placed in the public domain

#ifndef _TCLSTUFF_H
#define _TCLSTUFF_H

#include <tcl.h>

#define NEW_CMD( tcl_cmd, c_cmd ) \
	Tcl_CreateObjCommand( interp, tcl_cmd, \
			(Tcl_ObjCmdProc *) c_cmd, \
			(ClientData *) NULL, NULL );

#define THROW_ERROR( ... )								\
	{													\
		Tcl_AppendResult(interp, ##__VA_ARGS__, NULL);	\
		return TCL_ERROR;								\
	}

#define THROW_PRINTF( fmtstr, ... )											\
	{																		\
		Tcl_SetObjResult(interp, Tcl_ObjPrintf((fmtstr), ##__VA_ARGS__));	\
		return TCL_ERROR;													\
	}

#define THROW_ERROR_LABEL( label, var, ... )				\
	{														\
		Tcl_AppendResult(interp, ##__VA_ARGS__, NULL);		\
		var = TCL_ERROR;									\
		goto label;											\
	}

#define THROW_PRINTF_LABEL( label, var, fmtstr, ... )						\
	{																		\
		Tcl_SetObjResult(interp, Tcl_ObjPrintf((fmtstr), ##__VA_ARGS__));	\
		var = TCL_ERROR;													\
		goto label;															\
	}

#define THROW_POSIX_LABEL(label, code, msg) do {							\
	int err = Tcl_GetErrno();											\
	const char* errstr = Tcl_ErrnoId();									\
	Tcl_SetErrorCode(interp, "POSIX", errstr, Tcl_ErrnoMsg(err), NULL);	\
	THROW_PRINTF_LABEL(label, code, "%s: %s %s", msg, errstr, Tcl_ErrnoMsg(err));	\
} while(0);

// convenience macro to check the number of arguments passed to a function
// implementing a tcl command against the number expected, and to throw
// a tcl error if they don't match.  Note that the value of expected does
// not include the objv[0] object (the function itself)
#define CHECK_ARGS(expected, msg)										\
	if (objc != expected + 1) {											\
		Tcl_WrongNumArgs(interp, 1, objv, msg);							\
		return TCL_ERROR;												\
	}

#define CHECK_ARGS_LABEL(label, rc, msg) \
	do { \
		if (objc != A_objc) { \
			Tcl_WrongNumArgs(interp, A_cmd+1, objv, msg); \
			rc = TCL_ERROR; \
			goto label; \
		} \
	} while(0);

#define CHECK_MIN_ARGS_LABEL(label, rc, msg) \
	do { \
		if (objc < A_args) { \
			Tcl_WrongNumArgs(interp, A_cmd+1, objv, msg); \
			rc = TCL_ERROR; \
			goto label; \
		} \
	} while(0);


// A rather frivolous macro that just enhances readability for a common case
#define TEST_OK( cmd )		\
	if (cmd != TCL_OK) return TCL_ERROR;

#define TEST_OK_LABEL( label, var, cmd )		\
	if (cmd != TCL_OK) { \
		var = TCL_ERROR; \
		goto label; \
	}

#define TEST_OK_BREAK(var, cmd) if (TCL_OK != (var=(cmd))) break;

static inline void release_tclobj(Tcl_Obj** obj)
{
	if (*obj) {
		Tcl_DecrRefCount(*obj);
		*obj = NULL;
	}
}
#define RELEASE_MACRO(obj)		if (obj) {Tcl_DecrRefCount(obj); obj=NULL;}
#define REPLACE_MACRO(target, replacement)	\
{ \
	release_tclobj(&target); \
	if (replacement) Tcl_IncrRefCount(target = replacement); \
}
static inline void replace_tclobj(Tcl_Obj** target, Tcl_Obj* replacement)
{
	Tcl_Obj*	old = *target;

#if DEBUG
	if (*target && (*target)->refCount <= 0) Tcl_Panic("replace_tclobj target exists but has refcount <= 0: %d", (*target)->refCount);
#endif
	*target = replacement;
	if (*target) Tcl_IncrRefCount(*target);
	if (old) {
		Tcl_DecrRefCount(old);
		old = NULL;
	}
}

#if DEBUG
#	 include <signal.h>
#	 include <unistd.h>
#	 include <time.h>
#	 include "names.h"
#	 define DBG(...) fprintf(stdout, ##__VA_ARGS__)
#	 define FDBG(...) fprintf(stdout, ##__VA_ARGS__)
#	 define DEBUGGER raise(SIGTRAP)
#	 define TIME(label, task) \
	do { \
		struct timespec first; \
		struct timespec second; \
		struct timespec after; \
		double empty; \
		double delta; \
		clock_gettime(CLOCK_MONOTONIC, &first); /* Warm up the call */ \
		clock_gettime(CLOCK_MONOTONIC, &first); \
		clock_gettime(CLOCK_MONOTONIC, &second); \
		task; \
		clock_gettime(CLOCK_MONOTONIC, &after); \
		empty = second.tv_sec - first.tv_sec + (second.tv_nsec - first.tv_nsec)/1e9; \
		delta = after.tv_sec - second.tv_sec + (after.tv_nsec - second.tv_nsec)/1e9 - empty; \
		DBG("Time for %s: %.1f microseconds\n", label, delta * 1e6); \
	} while(0)
#else
#	define DBG(...) /* nop */
#	define FDBG(...) /* nop */
#	define DEBUGGER /* nop */
#	define TIME(label, task) task
#endif

#define OBJCMD(name)	int (name)(ClientData cdata, Tcl_Interp* interp, int objc, Tcl_Obj *const objv[])
#define INIT			int init(Tcl_Interp* interp)
#define RELEASE			void release(Tcl_Interp* interp)

#endif