tclmain.c

tcl源码详细资料

#ifndef EXCLUDE_TCL

/* 
 * tclMain.c --
 *
 *	Main program for Tcl shells and other Tcl-based applications.
 *
 * Copyright 1987-1991 Regents of the University of California
 * All rights reserved.
 *
 * Permission to use, copy, modify, and distribute this
 * software and its documentation for any purpose and without
 * fee is hereby granted, provided that the above copyright
 * notice appears in all copies.  The University of California
 * makes no representations about the suitability of this
 * software for any purpose.  It is provided "as is" without
 * express or implied warranty.
 */

#include "tclInt.h"
#include "tclUnix.h"
#include "tclInitFS.c"

#define MAX_TCL_INIT_SIZE	(32 * 1024)

#ifdef CONFIG_YAFFS_NOR_FLASH
const char tcl_library[] = "/flash/tcl";
#else
const char tcl_library[] = "/ram/tcl";
#endif

static const char tclInitCmd[] =
    "if [file exists [info library]/init.tcl] {source [info library]/init.tcl}";

static Tcl_Interp *tclInterp;
static Tcl_CmdBuf tclCmdBuf;

static int
cmdDumpHeap(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char *argv[];
{
    if (argc != 1) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], "\"", (char *) NULL);
	return TCL_ERROR;
    }
    Tcl_DumpHeap();
    return TCL_OK;
}

int
Tcl_InitShell(user)
    Tcl_CmdAppendProc *user;
{
    struct yaffs_stat statBuf;
    char *tempBuf;
    long length;
    int result;

    Tcl_InitHeap();	/* Must initialize TCL-private memory heap at first !!! */

    tclInterp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
    Tcl_InitMemory(tclInterp);
#endif
    Tcl_CreateCommand(tclInterp, "heap", (Tcl_CmdProc *) cmdDumpHeap, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
    if (user != NULL) {
	if ((*user)(tclInterp) < 0) {
	    tracef("WARNING: register user TCL commands failed\n");
	}
    }
    if (yaffs_stat(tcl_library, &statBuf) < 0) {
	tracef("NOTICE: restoring default TCL library files ... ");
	tempBuf = ckalloc(MAX_TCL_INIT_SIZE);
	if (tempBuf == NULL) {
	    tracef("failed\n");
	}
	else {
	    if ((length = unzip_mem2mem((unsigned long)tcl_init_fs, sizeof(tcl_init_fs),
					(unsigned long)tempBuf, MAX_TCL_INIT_SIZE, 1)) < 0) {
		tracef("failed\n");
	    }
	    else {
#ifdef CONFIG_YAFFS_NOR_FLASH
		untar_from_mem((unsigned long)tempBuf, length, "/flash", 1);
#else
		untar_from_mem((unsigned long)tempBuf, length, "/ram", 1);
#endif
		tracef("success\n");
	    }
	    ckfree(tempBuf);
	}
    }
    result = Tcl_Eval(tclInterp, tclInitCmd, 0, (char **) NULL);
    if (result != TCL_OK) {
	tracef("WARNING: %s\n", tclInterp->result);
    }
    tclCmdBuf = Tcl_CreateCmdBuf();
    return 0;
}

int
Tcl_ExecShell(buffer, length)
    char *buffer;
    int length;
{
    static int gotPartial = 0;
    char *command;
    int result;

    command = Tcl_AssembleCmd(tclCmdBuf, buffer);
    if (command == NULL) {
	gotPartial = 1;
	return 0;
    }

    result = Tcl_RecordAndEval(tclInterp, command, 0);
    if (result == TCL_OK) {
	if (*tclInterp->result != 0) {
	    tracef("%s\n", tclInterp->result);
	}
    }
    else {
	if (result == TCL_ERROR) {
	    tracef("Error");
	}
	else {
	    tracef("Error %d", result);
	}
	if (*tclInterp->result != 0) {
	    tracef(": %s\n", tclInterp->result);
	}
	else {
	    tracef("\n");
	}
    }

    gotPartial = 0;
    return 1;
}

int
Tcl_EvalBatch(string)
    const char *string;
{
    int result;

    result = Tcl_Eval(tclInterp, string, 0, (char **) NULL);
    if (result != TCL_OK) {
	tracef("WARNING: %s\n", tclInterp->result);
	return -1;
    }
    return 0;
}

#else

static const char file_name[] = "tclMain.c";

#endif /* EXCLUDE_TCL */