tinytcl.c

CMX990 demonstration board (DE9901)

/* 
 * tclTest.c --
 *
 *	Test driver for TCL.
 *
 * 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.
 *
 * $Id: tinytcl.c,v 1.2 2001/04/29 20:56:17 karll Exp $
 */

#include <stdio.h>
#include <errno.h>
#include <string.h>
#include <stdlib.h>
#include "tcl.h"
#include "tclExtdInt.h"

#include <cyg/kernel/kapi.h>

extern void TclX_InitGeneral(Tcl_Interp *interp);
extern int Tcl_InitReaddir(Tcl_Interp *interp);

Tcl_Interp *interp;
Tcl_CmdBuf buffer;
char dumpFile[100];
#ifdef TCL_MEM_DEBUG
int quitFlag = 0;
#endif

char initCmd[] =
"puts stdout \"\nEmbedded Tcl 6.8.0\n\"; source /tcl_sys/autoinit.tcl";

#ifdef TCL_MEM_DEBUG
int cmdCheckmem(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) {
  if (argc != 2) {
    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
                     " fileName\"", (char *) NULL);
    return TCL_ERROR;
  }
  strcpy(dumpFile, argv[1]);
  quitFlag = 1;
  return TCL_OK;
}
#endif

/* ARGSUSED */
int cmdEcho(ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) {
  int i;

  for (i = 1; ; i++) {
    if (argv[i] == NULL) {
      if (i != argc) {
      echoError:
        sprintf(interp->result,
                "argument list wasn't properly NULL-terminated in \"%s\" command",
                argv[0]);
      }
      break;
    }
    if (i >= argc) {
      goto echoError;
    }
    fputs(argv[i], stdout);
    if (i < (argc-1)) {
      printf(" ");
    }
  }
  printf("\n");
  return TCL_OK;
}

void TclMain(cyg_addrword_t lData) {
  char line[500], *cmd;
  int result, gotPartial;

  interp = Tcl_CreateInterp();
#ifdef TCL_MEM_DEBUG
  Tcl_InitMemory(interp);
#endif
  Tcl_InitDebug(interp);
  TclX_InitGeneral(interp);
  //Tcl_InitDos(interp);
  Tcl_InitReaddir(interp);

  Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo",
                    (Tcl_CmdDeleteProc *) NULL);
#ifdef TCL_MEM_DEBUG
  Tcl_CreateCommand(interp, "checkmem", cmdCheckmem, (ClientData) 0,
                    (Tcl_CmdDeleteProc *) NULL);
#endif

  buffer = Tcl_CreateCmdBuf();
#ifndef TCL_GENERIC_ONLY
  result = Tcl_Eval(interp, initCmd, 0, (char **) NULL);
  if (result != TCL_OK) {
    printf("%s\n", interp->result);
    //exit(1);
  }
#endif

  /* Stop TCL here until user starts it. */
  cyg_thread_suspend(cyg_thread_self());

  gotPartial = 0;
  while (1) {
    clearerr(stdin);
    if (!gotPartial) {
      fputs("% ", stdout);
      fflush(stdout);
    }
    if (fgets(line, 500, stdin) == NULL) {
      if (!gotPartial) {
        //exit(0);
      }
      line[0] = 0;
    }
    cmd = Tcl_AssembleCmd(buffer, line);
    if (cmd == NULL) {
      gotPartial = 1;
      continue;
    }

    gotPartial = 0;
    result = Tcl_Eval(interp, cmd, 0, (char **)NULL);
    if (result == TCL_OK) {
      if (*interp->result != 0) {
        printf("%s\n", interp->result);
      }
#ifdef TCL_MEM_DEBUG
      if (quitFlag) {
        Tcl_DeleteInterp(interp);
        Tcl_DeleteCmdBuf(buffer);
        Tcl_DumpActiveMemory(dumpFile);
        exit(0);
      }
#endif
    } else {
      if (result == TCL_ERROR) {
        printf("Error");
      } else {
        printf("Error %d", result);
      }
      if (*interp->result != 0) {
        printf(": %s\n", interp->result);
      } else {
        printf("\n");
      }
    }
  }
}