couldn't find HOME environment variable to expand path
while executing
"file normalize $dir"
(procedure "cache" line 3)
invoked from within
"cache [file join ~ .critcl [platform::identify]]"
(procedure "setconfig" line 66)
invoked from within
"setconfig "" "
(procedure "readconfig" line 176)
invoked from within
"readconfig [file join $mydir Config]"
(procedure "::critcl::Initialize" line 39)
invoked from within
"::critcl::Initialize"
(file "/commun/linux/local/ActiveTcl-8.6.11/lib/tcl8.6/critcl3.1.17/critcl.tcl" line 5924)
invoked from within
"source /commun/linux/local/ActiveTcl-8.6.11/lib/tcl8.6/critcl3.1.17/critcl.tcl"
("package ifneeded critcl 3.1.17" script)
invoked from within
"package require critcl"
(in namespace eval "::request" script line 14)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
# stackc.tcl --
#
# Implementation of a stack data structure for Tcl.
# This code based on critcl, API compatible to the PTI [x].
# [x] Pure Tcl Implementation.
#
# Copyright (c) 2008 Andreas Kupries
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: stack_c.tcl,v 1.1 2008/06/19 23:03:35 andreas_kupries Exp $
package require critcl
# @sak notprovided struct_stackc
package provide struct_stackc 1.3.1
package require Tcl 8.4
namespace eval ::struct {
# Supporting code for the main command.
catch {
#critcl::cheaders -g
#critcl::debug memory symbols
}
critcl::cheaders stack/*.h
critcl::csources stack/*.c
critcl::ccode {
/* -*- c -*- */
#include
#include
#include
#include
/* .................................................. */
/* Global stack management, per interp
*/
typedef struct SDg {
long int counter;
char buf [50];
} SDg;
static void
SDgrelease (ClientData cd, Tcl_Interp* interp)
{
ckfree((char*) cd);
}
static CONST char*
SDnewName (Tcl_Interp* interp)
{
#define KEY "tcllib/struct::stack/critcl"
Tcl_InterpDeleteProc* proc = SDgrelease;
SDg* sdg;
sdg = Tcl_GetAssocData (interp, KEY, &proc);
if (sdg == NULL) {
sdg = (SDg*) ckalloc (sizeof (SDg));
sdg->counter = 0;
Tcl_SetAssocData (interp, KEY, proc,
(ClientData) sdg);
}
sdg->counter ++;
sprintf (sdg->buf, "stack%d", sdg->counter);
return sdg->buf;
#undef KEY
}
static void
SDdeleteCmd (ClientData clientData)
{
/* Release the whole stack. */
st_delete ((S*) clientData);
}
}
# Main command, stack creation.
critcl::ccommand stack_critcl {dummy interp objc objv} {
/* Syntax
* - epsilon |1
* - name |2
*/
CONST char* name;
S* sd;
Tcl_Obj* fqn;
Tcl_CmdInfo ci;
#define USAGE "?name?"
if ((objc != 2) && (objc != 1)) {
Tcl_WrongNumArgs (interp, 1, objv, USAGE);
return TCL_ERROR;
}
if (objc < 2) {
name = SDnewName (interp);
} else {
name = Tcl_GetString (objv [1]);
}
if (!Tcl_StringMatch (name, "::*")) {
/* Relative name. Prefix with current namespace */
Tcl_Eval (interp, "namespace current");
fqn = Tcl_GetObjResult (interp);
fqn = Tcl_DuplicateObj (fqn);
Tcl_IncrRefCount (fqn);
if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
Tcl_AppendToObj (fqn, "::", -1);
}
Tcl_AppendToObj (fqn, name, -1);
} else {
fqn = Tcl_NewStringObj (name, -1);
Tcl_IncrRefCount (fqn);
}
Tcl_ResetResult (interp);
if (Tcl_GetCommandInfo (interp,
Tcl_GetString (fqn),
&ci)) {
Tcl_Obj* err;
err = Tcl_NewObj ();
Tcl_AppendToObj (err, "command \"", -1);
Tcl_AppendObjToObj (err, fqn);
Tcl_AppendToObj (err, "\" already exists, unable to create stack", -1);
Tcl_DecrRefCount (fqn);
Tcl_SetObjResult (interp, err);
return TCL_ERROR;
}
sd = st_new();
sd->cmd = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
stms_objcmd, (ClientData) sd,
SDdeleteCmd);
Tcl_SetObjResult (interp, fqn);
Tcl_DecrRefCount (fqn);
return TCL_OK;
}
}
# ### ### ### ######### ######### #########
## Ready