[George Peter Staplin] 07.25.2006 - Below is an RPN extension in C that supports int, wide, and double types. Compile it using a pattern like: gcc -O -Wall -DUSE_TCL_STUBS -std=c99 rpn.c -I/gps/runtime8.4/include -L/gps/runtime8.4/lib -ltclstub84 -shared -o rpn.so Then just load ./rpn.so to use the extension commands. The backup code is here: http://www.xmission.com/~georgeps/implementation/software/tcl/rpn.c ---- /* * RPN Extension * * Copyright 2006 George Peter Staplin * * Version 1 - July 25, 2006 */ #include #define TCL_OBJ_CMD_ARGS ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[] /* * The stack grows downwards from stackupperlimit. */ #define OP2_STACK_CHECK(op) do { \ if ((sptr + 1) >= stackupperlimit) { \ Tcl_SetResult (interp, \ "stack underflow with " op " operator", TCL_STATIC); \ return TCL_ERROR; \ } \ } while (0) /* * C doesn't have polymorphism, but we can fake it with templates. * This macro is used to generate at least 3 functions. */ #define TEMPLATE(FUNC,ARGS,STACKTYPE,GET,NEWOBJ) \ static int FUNC ( ARGS ) { \ STACKTYPE stack[objc], *sptr, *stackupperlimit; \ int i; \ if (objc <= 1) { \ Tcl_WrongNumArgs (interp, 1, objv, #FUNC " takes at least 1 argument"); \ return TCL_ERROR; \ } \ \ stackupperlimit = sptr = stack + objc; \ \ for (i = 1; i < objc; ++i) { \ --sptr; \ if (TCL_OK != GET (interp, objv[i], sptr)) { \ int slen; \ char *op = Tcl_GetStringFromObj (objv[i], &slen); \ ++sptr; \ \ if (1 != slen) { \ Tcl_SetResult (interp, "invalid operator. ", TCL_STATIC); \ Tcl_AppendResult (interp, " more info: ", op, "\n", NULL); \ return TCL_ERROR; \ } \ \ switch (op[0]) { \ case '+': \ OP2_STACK_CHECK ("+"); \ *(sptr + 1) += *sptr; \ ++sptr; \ break; \ \ case '-': \ OP2_STACK_CHECK ("-"); \ *(sptr + 1) -= *sptr; \ ++sptr; \ break; \ \ case '*': \ OP2_STACK_CHECK ("*"); \ *(sptr + 1) *= *sptr; \ ++sptr; \ break; \ \ case '/': \ OP2_STACK_CHECK ("/"); \ *(sptr + 1) /= *sptr; \ ++sptr; \ break; \ \ default: \ Tcl_SetResult (interp, "invalid operator. ", TCL_STATIC); \ Tcl_AppendResult (interp, " more info: ", op, "\n", NULL); \ return TCL_ERROR; \ } \ } \ } \ \ if ((stackupperlimit - 1) != sptr) { \ Tcl_SetResult (interp, "more than 1 value remains on the operand stack", \ TCL_STATIC); \ return TCL_ERROR; \ } \ \ Tcl_SetObjResult (interp, NEWOBJ (*sptr)); \ \ return TCL_OK; \ } TEMPLATE (rpnwide_cmd, TCL_OBJ_CMD_ARGS, Tcl_WideInt, Tcl_GetWideIntFromObj, Tcl_NewWideIntObj); TEMPLATE (rpnfloat_cmd, TCL_OBJ_CMD_ARGS, double, Tcl_GetDoubleFromObj, Tcl_NewDoubleObj); TEMPLATE (rpn_cmd, TCL_OBJ_CMD_ARGS, long, Tcl_GetLongFromObj, Tcl_NewLongObj); int Rpn_Init (Tcl_Interp *interp) { if (NULL == Tcl_InitStubs (interp, TCL_VERSION, 0)) return TCL_ERROR; Tcl_CreateObjCommand (interp, "rpnwide", rpnwide_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand (interp, "rpnfloat", rpnfloat_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand (interp, "rpn", rpn_cmd, (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL); return TCL_OK; } ---- [Category Mathematics]