[naviserver-commits] naviserver/nsd tclcmds.c,1.21,1.22 tclobj.c,1.5,1.6 tclthread.c,1.5,1.6

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/naviserver/naviserver/nsd
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv8676/nsd

Modified Files:
	tclcmds.c tclobj.c tclthread.c 
Log Message:
        * include/ns.h:
        * nsd/tclobj.c: Generalise the ns_thread routines for wrapping a C
        structs with a Tcl obj handle.  Slighlty enhanced: also allows
        wrapping of statically allocated C structs which always have a direct
        string name -> struct relationship.
        * nsd/tclcmds.c:
        * nsd/tclthread.c: Convert to Tcl objects, remove some duplicated
        code and convert to the new ns:addr Tcl object type interface.
        * tests/ns_thread.test: Exercise the ns_thread command and the
        new ns:addr Tcl object type.


Index: tclobj.c
===================================================================
RCS file: /cvsroot/naviserver/naviserver/nsd/tclobj.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** tclobj.c	12 Jul 2005 08:26:05 -0000	1.5
--- tclobj.c	21 Oct 2005 06:22:14 -0000	1.6
***************
*** 40,43 ****
--- 40,85 ----
  
  
+ /*
+  * Local functions defined in this file.
+  */
+ 
+ static Tcl_UpdateStringProc UpdateStringOfAddr;
+ static Tcl_SetFromAnyProc   SetAddrFromAny;
+ 
+ /*
+  * Local variables defined in this file.
+  */
+ 
+ static Tcl_ObjType addrType = {
+     "ns:addr",
+     (Tcl_FreeInternalRepProc *) NULL,
+     (Tcl_DupInternalRepProc *)  NULL,
+     UpdateStringOfAddr,
+     SetAddrFromAny
+ };
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * NsTclInitAddrType --
+  *
+  *      Initialize the Tcl address object type.
+  *
+  * Results:
+  *      None.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ void
+ NsTclInitAddrType(void)
+ {
+     Tcl_RegisterObjType(&addrType);
+ }
+ 
  
  /*
***************
*** 150,151 ****
--- 192,404 ----
  }
  
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Ns_TclSetFromAnyError --
+  *
+  *      This procedure is registered as the setFromAnyProc for an
+  *      object type when it doesn't make sense to generate it's internal
+  *      form from the string representation alone.
+  *
+  * Results:
+  *      The return value is always TCL_ERROR, and an error message is
+  *      left in interp's result if interp isn't NULL.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ int
+ Ns_TclSetFromAnyError(Tcl_Interp *interp, Tcl_Obj *objPtr)
+ {
+     Tcl_AppendToObj(Tcl_GetObjResult(interp),
+                     "can't convert value to requested type except via prescribed API",
+                     -1);
+     return TCL_ERROR;
+ }
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Ns_TclGetAddrFromObj --
+  *
+  *      Return the internal pointer of an address Tcl_Obj.
+  *
+  * Results:
+  *      TCL_OK or TCL_ERROR if conversion failed or not the correct type.
+  *
+  * Side effects:
+  *      Object may be converted to address type.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ int
+ Ns_TclGetAddrFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+                      CONST char *type, void **addrPtrPtr)
+ {
+     if (Tcl_ConvertToType(interp, objPtr, &addrType) != TCL_OK) {
+         return TCL_ERROR;
+     }
+     if (objPtr->internalRep.twoPtrValue.ptr1 != (void *) type) {
+         Tcl_AppendResult(interp, "incorrect type: ", Tcl_GetString(objPtr), NULL);
+         return TCL_ERROR;
+     }
+     *addrPtrPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ 
+     return TCL_OK;
+ }
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Ns_TclSetAddrObj --
+  *
+  *      Convert the given object to the ns:addr type.
+  *
+  * Results:
+  *      None.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ void
+ Ns_TclSetAddrObj(Tcl_Obj *objPtr, CONST char *type, void *addr)
+ {
+     if (Tcl_IsShared(objPtr)) {
+         Tcl_Panic("Ns_TclSetAddrObj called with shared object");
+     }
+     Ns_TclSetTwoPtrValue(objPtr, &addrType, (void *) type, addr);
+     Tcl_InvalidateStringRep(objPtr);
+ }
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Ns_TclGetOpaqueFromObj --
+  *
+  *      Get the internal pointer of an address Tcl_Obj.
+  *
+  * Results:
+  *      TCL_OK or TCL_ERROR if object was not of the ns:addr type.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ int
+ Ns_TclGetOpaqueFromObj(Tcl_Obj *objPtr, CONST char *type, void **addrPtrPtr)
+ {
+     if (objPtr->typePtr != &addrType
+         || objPtr->internalRep.twoPtrValue.ptr1 != (void *) type) {
+         return TCL_ERROR;
+     }
+     *addrPtrPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ 
+     return TCL_OK;
+ }
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * Ns_TclSetOpaqueObj --
+  *
+  *      Convert the given object to the ns:addr type without
+  *      invalidating the current string rep.  It is OK if the object
+  *      is shared.
+  *
+  * Results:
+  *      None.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ void
+ Ns_TclSetOpaqueObj(Tcl_Obj *objPtr, CONST char *type, void *addr)
+ {
+     Ns_TclSetTwoPtrValue(objPtr, &addrType, (void *) type, addr);
+ }
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * UpdateStringOfAddr --
+  *
+  *      Update the string representation for an address object.
+  *      Note: This procedure does not free an existing old string rep
+  *      so storage will be lost if this has not already been done. 
+  *
+  * Results:
+  *      None.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ static void
+ UpdateStringOfAddr(Tcl_Obj *objPtr)
+ {
+     void   *type = objPtr->internalRep.twoPtrValue.ptr1;
+     void   *addr = objPtr->internalRep.twoPtrValue.ptr2;
+     char    buf[128];
+     size_t  len;
+ 
+     len = snprintf(buf, sizeof(buf), "t%p a%p %s",
+                    type, addr, (char *) type);
+     Ns_TclSetStringRep(objPtr, buf, len);
+ }
+ 
+ 
+ /*
+  *----------------------------------------------------------------------
+  *
+  * SetAddrFromAny --
+  *
+  *      Attempt to generate an address internal form for the Tcl object.
+  *
+  * Results:
+  *      The return value is a standard Tcl result. If an error occurs
+  *      during conversion, an error message is left in the interpreter's
+  *      result unless interp is NULL.
+  *
+  * Side effects:
+  *      None.
+  *
+  *----------------------------------------------------------------------
+  */
+ 
+ static int
+ SetAddrFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
+ {
+     void *type, *addr;
+     char *string;
+ 
+     string = Tcl_GetString(objPtr);
+     if (sscanf(string, "t%p a%p", &type, &addr) != 2
+         || type == NULL || addr == NULL) {
+         Tcl_AppendResult(interp, "invalid address \"", string, "\"", NULL);
+         return TCL_ERROR;
+     }
+     Ns_TclSetTwoPtrValue(objPtr, &addrType, type, addr);
+ 
+     return TCL_OK;
+ }

Index: tclcmds.c
===================================================================
RCS file: /cvsroot/naviserver/naviserver/nsd/tclcmds.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -C2 -d -r1.21 -r1.22
*** tclcmds.c	9 Oct 2005 22:27:24 -0000	1.21
--- tclcmds.c	21 Oct 2005 06:22:14 -0000	1.22
***************
*** 168,171 ****
--- 168,172 ----
      NsTclStrftimeObjCmd,
      NsTclSymlinkObjCmd,
+     NsTclThreadObjCmd,
      NsTclTimeObjCmd,
      NsTclTmpNamObjCmd,
***************
*** 205,209 ****
      NsTclShareCmd,
      NsTclStripHtmlCmd,
-     NsTclThreadCmd,
      TclX_KeyldelObjCmd,
      TclX_KeylgetObjCmd,
--- 206,209 ----
***************
*** 316,320 ****
      {"ns_striphtml", NsTclStripHtmlCmd, NULL},
      {"ns_symlink", NULL, NsTclSymlinkObjCmd},
!     {"ns_thread", NsTclThreadCmd, NULL},
      {"ns_time", NULL, NsTclTimeObjCmd},
      {"ns_tmpnam", NULL, NsTclTmpNamObjCmd},
--- 316,320 ----
      {"ns_striphtml", NsTclStripHtmlCmd, NULL},
      {"ns_symlink", NULL, NsTclSymlinkObjCmd},
!     {"ns_thread", NULL, NsTclThreadObjCmd},
      {"ns_time", NULL, NsTclTimeObjCmd},
      {"ns_tmpnam", NULL, NsTclTmpNamObjCmd},

Index: tclthread.c
===================================================================
RCS file: /cvsroot/naviserver/naviserver/nsd/tclthread.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** tclthread.c	30 Jul 2005 04:06:02 -0000	1.5
--- tclthread.c	21 Oct 2005 06:22:14 -0000	1.6
***************
*** 32,36 ****
   * tclthread.c --
   *
!  *	Tcl wrappers around all thread objects 
   */
  
--- 32,36 ----
   * tclthread.c --
   *
!  *      Tcl wrappers around all thread objects 
   */
[...1495 lines suppressed...]
!     if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0, &opt) != TCL_OK) {
!         return TCL_ERROR;
      }
!     if (opt == createOpt) {
!         addr = ns_malloc(sizeof(void *));
!         Ns_TclSetAddrObj(Tcl_GetObjResult(interp), type, addr);
      } else {
          if (objc < 3) {
!             Tcl_WrongNumArgs(interp, 2, objv, "object");
!             return TCL_ERROR;
!         }
!         if (Ns_TclGetAddrFromObj(interp, objv[2], type, &addr) != TCL_OK) {
!             return TCL_ERROR;
!         }
      }
      *addrPtr = addr;
      *optPtr = opt;
  
      return TCL_OK;
  }

[naviserver-commits] naviserver/nsd tclcmds.c,1.21,1.22 tclobj.c,1.5,1.6 tclthread.c,1.5,1.6

NaviServer, a high performance web server written in C and Tcl

[naviserver-commits] naviserver/nsd tclcmds.c,1.21,1.22 tclobj.c,1.5,1.6 tclthread.c,1.5,1.6