Artifact 95be374a42e3cc1acbd9552a4821ac82532295d2:
- File
kitdll/buildsrc/kitdll-0.0/rechan.c
— part of check-in
[b11b735302]
at
2010-09-29 23:15:37
on branch trunk
— Created GNU autoconf script for KitDLL
Made KitDLL build a shared object
Added test driver (user: rkeene, size: 7711) [annotate] [blame] [check-ins using]
- File kitsh/buildsrc/kitsh-0.0/rechan.c — part of check-in [9315fecb01] at 2010-09-26 04:37:13 on branch trunk — Added kitsh code (user: rkeene, size: 7711) [annotate] [blame] [check-ins using]
/* Written by Matt Newman and Jean-Claude Wippler, as part of Tclkit. * March 2003 - placed in the public domain by the authors. * * Reflecting channel interface */ #include <tcl.h> #ifndef TCL_DECLARE_MUTEX #define TCL_DECLARE_MUTEX(v) #define Tcl_MutexLock(v) #define Tcl_MutexUnlock(v) #endif static int mkChanSeq = 0; TCL_DECLARE_MUTEX(rechanMutex) /* Uncomment for Linux or other non-Solaris OS's for memcpy declaration */ #include <memory.h> /* Uncomment for Solaris (and comment above) for memcpy declaration */ /* #include <string.h> */ #ifndef EINVAL #define EINVAL 9 #endif typedef struct { Tcl_Channel _chan; int _validMask; int _watchMask; Tcl_Interp* _interp; Tcl_Obj* _context; Tcl_Obj* _seek; Tcl_Obj* _read; Tcl_Obj* _write; Tcl_Obj* _name; Tcl_TimerToken _timer; } ReflectingChannel; static ReflectingChannel* rcCreate (Tcl_Interp* ip_, Tcl_Obj* context_, int mode_, const char* name_) { ReflectingChannel* cp = (ReflectingChannel*) Tcl_Alloc (sizeof *cp); cp->_validMask = mode_; cp->_watchMask = 0; cp->_chan = 0; cp->_context = context_; cp->_interp = ip_; cp->_name = Tcl_NewStringObj(name_, -1); cp->_timer = NULL; /* support Tcl_GetIndexFromObj by keeping these objectified */ cp->_seek = Tcl_NewStringObj("seek", -1); cp->_read = Tcl_NewStringObj("read", -1); cp->_write = Tcl_NewStringObj("write", -1); Tcl_IncrRefCount(cp->_context); Tcl_IncrRefCount(cp->_seek); Tcl_IncrRefCount(cp->_read); Tcl_IncrRefCount(cp->_write); Tcl_IncrRefCount(cp->_name); return cp; } static Tcl_Obj* rcBuildCmdList(ReflectingChannel* chan_, Tcl_Obj* cmd_) { Tcl_Obj* vec = Tcl_DuplicateObj(chan_->_context); Tcl_IncrRefCount(vec); Tcl_ListObjAppendElement(chan_->_interp, vec, cmd_); Tcl_ListObjAppendElement(chan_->_interp, vec, chan_->_name); return vec; /* with refcount 1 */ } static int rcClose (ClientData cd_, Tcl_Interp* interp) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, Tcl_NewStringObj("close", -1)); Tcl_Interp* ip = chan->_interp; Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n); Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); if (chan->_timer != NULL) { Tcl_DeleteTimerHandler(chan->_timer); chan->_timer = NULL; } Tcl_DecrRefCount(chan->_context); Tcl_DecrRefCount(chan->_seek); Tcl_DecrRefCount(chan->_read); Tcl_DecrRefCount(chan->_write); Tcl_DecrRefCount(chan->_name); Tcl_Free((char*) chan); return TCL_OK; } static int rcInput (ClientData cd_, char* buf, int toRead, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; if (chan->_validMask & TCL_READABLE) { Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_read); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(toRead)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK) { void* s = Tcl_GetByteArrayFromObj(Tcl_GetObjResult(ip), &n); if (0 <= n && n <= toRead) if (n > 0) memcpy(buf, s, n); else chan->_watchMask &= ~TCL_READABLE; else n = -1; } Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); } if (n < 0) *errorCodePtr = EINVAL; return n; } static int rcOutput (ClientData cd_, const char* buf, int toWrite, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; if (chan->_validMask & TCL_WRITABLE) { Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_write); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewByteArrayObj((unsigned char*) buf, toWrite)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK && Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK) if (0 <= n && n <= toWrite) chan->_watchMask = chan->_validMask; else n = -1; Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); } if (n < 0) *errorCodePtr = EINVAL; return n; } static int rcSeek (ClientData cd_, long offset, int seekMode, int* errorCodePtr) { ReflectingChannel* chan = (ReflectingChannel*) cd_; int n = -1; Tcl_SavedResult sr; Tcl_Obj* cmd = rcBuildCmdList(chan, chan->_seek); Tcl_Interp* ip = chan->_interp; Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewLongObj(offset)); Tcl_ListObjAppendElement(NULL, cmd, Tcl_NewIntObj(seekMode)); Tcl_SaveResult(ip, &sr); if (Tcl_EvalObjEx(ip, cmd, TCL_EVAL_GLOBAL | TCL_EVAL_DIRECT) == TCL_OK && Tcl_GetIntFromObj(NULL, Tcl_GetObjResult(ip), &n) == TCL_OK) chan->_watchMask = chan->_validMask; Tcl_RestoreResult(ip, &sr); Tcl_DecrRefCount(cmd); if (n < 0) *errorCodePtr = EINVAL; return n; } static void rcTimerProc (ClientData cd_) { ReflectingChannel* chan = (ReflectingChannel*) cd_; if (chan->_timer != NULL) Tcl_DeleteTimerHandler(chan->_timer); chan->_timer = NULL; Tcl_NotifyChannel(chan->_chan, chan->_watchMask); } static void rcWatchChannel (ClientData cd_, int mask) { ReflectingChannel* chan = (ReflectingChannel*) cd_; /* Dec 2001: adopting logic used in Andreas Kupries' memchan, i.e. timers */ if (mask) { chan->_watchMask = mask & chan->_validMask; if (chan->_watchMask && chan->_timer == NULL) chan->_timer = Tcl_CreateTimerHandler(5, rcTimerProc, cd_); } else if (chan->_timer != NULL) { Tcl_DeleteTimerHandler(chan->_timer); chan->_timer = NULL; } } static int rcGetFile (ClientData cd_, int direction, ClientData* handlePtr) { return TCL_ERROR; } static int rcBlock (ClientData cd_, int mode) { return 0; } static Tcl_ChannelType reChannelType = { "rechan", /* Type name. */ (Tcl_ChannelTypeVersion) rcBlock, /* Set blocking/nonblocking behaviour */ rcClose, /* Close channel, clean instance data */ rcInput, /* Handle read request */ rcOutput, /* Handle write request */ rcSeek, /* Move location of access point. NULL'able */ 0, /* Set options. NULL'able */ 0, /* Get options. NULL'able */ rcWatchChannel, /* Initialize notifier */ rcGetFile /* Get OS handle from the channel. */ }; static int cmd_rechan(ClientData cd_, Tcl_Interp* ip_, int objc_, Tcl_Obj*const* objv_) { ReflectingChannel *rc; int mode; char buffer [20]; if (objc_ != 3) { Tcl_WrongNumArgs(ip_, 1, objv_, "command mode"); return TCL_ERROR; } if (Tcl_ListObjLength(ip_, objv_[1], &mode) == TCL_ERROR || Tcl_GetIntFromObj(ip_, objv_[2], &mode) == TCL_ERROR) return TCL_ERROR; Tcl_MutexLock(&rechanMutex); sprintf(buffer, "rechan%d", ++mkChanSeq); Tcl_MutexUnlock(&rechanMutex); rc = rcCreate (ip_, objv_[1], mode, buffer); rc->_chan = Tcl_CreateChannel(&reChannelType, buffer, (ClientData) rc, mode); Tcl_RegisterChannel(ip_, rc->_chan); Tcl_SetChannelOption(ip_, rc->_chan, "-buffering", "none"); Tcl_SetChannelOption(ip_, rc->_chan, "-blocking", "0"); Tcl_SetResult(ip_, buffer, TCL_VOLATILE); return TCL_OK; } DLLEXPORT int Rechan_Init(Tcl_Interp* interp) { if (!Tcl_InitStubs(interp, "8.4", 0)) return TCL_ERROR; Tcl_CreateObjCommand(interp, "rechan", cmd_rechan, 0, 0); return Tcl_PkgProvide(interp, "rechan", "1.0"); }