/* * fasteval.c --- * * Defines a form of eval that is much faster (in most cases) * under Tcl8. * * Copyright © 1997 Donal K. Fellows * * The author hereby grants permission to use, copy, modify, * distribute, and license this software and its documentation for any * purpose, provided that existing copyright notice is retained in all * copies and that this notice is included verbatim in any * distributions. No written agreement, license, or royalty fee is * required for any of the authorized uses. Modifications to this * software may be copyrighted by their authors and need not follow * the licensing terms described here, provided that the new terms are * clearly indicated on the first page of each file where they apply. * * IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTORS BE LIABLE TO ANY PARTY * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY * DERIVATIVES THEREOF, EVEN IF THE AUTHOR HAS BEEN ADVISED OF THE * POSSIBILITY OF SUCH DAMAGE. * * THE AUTHOR AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND * NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, * AND THE AUTHOR AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE * MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. * * GOVERNMENT USE: If you are acquiring this software on behalf of the * U.S. government, the Government shall have only "Restricted Rights" * in the software and related documentation as defined in the Federal * Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you * are acquiring the software on behalf of the Department of Defense, * the software shall be classified as "Commercial Computer Software" * and the Government shall have only "Restricted Rights" as defined * in Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the * foregoing, the author grants the U.S. Government and others acting * in its behalf permission to use and distribute the software in * accordance with the terms specified in this license. * * * Known problems: * o Things can go badly wrong when you try to use expr with this * command, and I suspect that this may well be the case for the * other commands that are treated specially by the compiler. * o If you redefine or delete a referred to command or procedure, * make sure that you invalidate any objects used in the command * position as well, or there could be an interesting crash. * o Renaming a command or procedure doesn't work well with this * either. I don't even have an inklinkg of an idea how to fix * this... * * * Compiling: * You should be able to compile this up into a little shared * library without any extra files (except the Tcl distribution) * provided shred libs and dynamic loading are properly supported on * your system. If you need to statically link this file, then the * external function that you want to call is: * [int Fasteval_Init(Tcl_Interp *interp)] * On my system at the time of writing (SunOS 4.1.3, and Tcl8.0a2) I * successfully compile this file into a dynamic lib using the * following commands, with no generated warnings at all: * $ gcc -fPIC -Wall -O -c fasteval.c * $ ld -assert pure-text -o fasteval.so fasteval.o * * I don't know enough about Windows or Mac systems to tell you how * to build a shared lib on them. It should be possible though, * especially since I'm not using any Unix specific stuff at all... * * * Contact email addresses: * fellowsd@cs.man.ac.uk or donal@ugglan.demon.co.uk * * $Id: fasteval.c,v 1.1 1997/02/19 10:21:08 fellowsd Exp $ */ #include #ifndef TCL_MAJOR_VERSION #warning Unable to extract Tcl version info from header tcl.h #error Please upgrade to Tcl8.0 at least. #else #if (TCL_MAJOR_VERSION<8) #error Need at least Tcl8.0 to compile this file! Found TCL_PATCH_LEVEL... #endif #endif static int fasteval _ANSI_ARGS_((ClientData, Tcl_Interp *, int, Tcl_Obj **)); static int fasteval_create _ANSI_ARGS_((Tcl_Interp *, Tcl_Obj *)); #if (TCL_MAJOR_VERSION==8 && TCL_MINOR_VERSION==0 && TCL_RELEASE_LEVEL==0 && TCL_RELEASE_SERIAL==1) #define INTERP_ARG_DEF Tcl_Interp *, #define INTERP_ARG_USE Tcl_Interp *interp, #define INTERP_ARG interp, #else #define INTERP_ARG_DEF /* nothing - upgrade in tcl.h*/ #define INTERP_ARG_USE /* nothing */ #define INTERP_ARG /* nothing */ #endif static void fasteval_update _ANSI_ARGS_((INTERP_ARG_DEF Tcl_Obj *)); static void fasteval_dup _ANSI_ARGS_((Tcl_Obj *, Tcl_Obj *)); /* static void fasteval_free _ANSI_ARGS_((Tcl_Obj *)); */ /* The fasteval cache-object type */ static Tcl_ObjType fastevalObject = { "object:fasteval:lookup-reference", /* fasteval_free, */ NULL, fasteval_dup, fasteval_update, fasteval_create }; static int fastevalObjectRegistered = 0; int Fasteval_Init(Tcl_Interp *interp) { if (!fastevalObjectRegistered) { Tcl_RegisterObjType(&fastevalObject); fastevalObjectRegistered = 1; } Tcl_CreateObjCommand(interp, "object:fasteval", -1, fasteval, NULL, NULL); return TCL_OK; } /* ---------------------------------------------------------------------- */ static int fasteval_create(Tcl_Interp *interp, Tcl_Obj *obj) { if (obj->typePtr == &fastevalObject) return TCL_OK; else { int len; char *cmdname = Tcl_GetStringFromObj(INTERP_ARG obj, &len); Tcl_CmdInfo info; if (!Tcl_GetCommandInfo(interp, cmdname, &info)) { Tcl_Obj *err = Tcl_NewStringObj("unknown command \"", -1); Tcl_StringObjAppendObj(INTERP_ARG err, obj); Tcl_StringObjAppend(INTERP_ARG err, "\"", -1); Tcl_SetObjResult(interp, err); return TCL_ERROR; } if (!info.proc || !info.objProc) { /* Hmm. Something is not quite kosher. Moan! */ Tcl_Obj *err =Tcl_NewStringObj("bad command for fast evaluation \"", -1); Tcl_StringObjAppendObj(INTERP_ARG err, obj); Tcl_StringObjAppend(INTERP_ARG err, "\": perhaps it is compiled specially?", -1); Tcl_SetObjResult(interp, err); return TCL_ERROR; } obj->internalRep.twoPtrValue.ptr1 = (VOID *)info.objProc; obj->internalRep.twoPtrValue.ptr2 = (VOID *)info.objClientData; obj->typePtr = &fastevalObject; return TCL_OK; } } static void fasteval_update(INTERP_ARG_USE Tcl_Obj *obj) { int i; const char error[] = "error"; obj->bytes = Tcl_Alloc(6); obj->length = 5; for (i=0 ; i<6 ; i++) { obj->bytes[i] = error[i]; } } static void fasteval_dup(Tcl_Obj *src, Tcl_Obj *dup) { if (src->typePtr == &fastevalObject) { src->internalRep.twoPtrValue.ptr1 = dup->internalRep.twoPtrValue.ptr1; src->internalRep.twoPtrValue.ptr2 = src->internalRep.twoPtrValue.ptr2; src->typePtr = dup->typePtr; } } /* ---------------------------------------------------------------------- */ static int fasteval(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj **objv) { /* object:fasteval $cmd $arg1 $arglist */ Tcl_ObjCmdProc *objProc; ClientData objClientData; int arglistlen, i, result; if (objc<3) { Tcl_Obj *err = Tcl_NewStringObj("wrong # args: should be \"", -1); /* I think the next two lines are right */ Tcl_StringObjAppendObj(INTERP_ARG err, objv[0]); Tcl_StringObjAppend(INTERP_ARG err, " command ?arg ...? arglist\"", -1); Tcl_SetObjResult(interp, err); return TCL_ERROR; } if (Tcl_ConvertToType(interp, objv[1], &fastevalObject) != TCL_OK) { return TCL_ERROR; } if (Tcl_ListObjLength(interp, objv[objc-1], &arglistlen) != TCL_OK) { return TCL_ERROR; } objProc = (Tcl_ObjCmdProc *)objv[1]->internalRep.twoPtrValue.ptr1; objClientData = (ClientData)objv[1]->internalRep.twoPtrValue.ptr2; if (arglistlen==0) { return objProc(objClientData, interp, objc-2, objv+1); } else { Tcl_Obj **callvec = (Tcl_Obj **) Tcl_Alloc(sizeof(Tcl_Obj *)*(arglistlen+objc-2)); for (i=0 ; i