From: peter@ficc.uu.net (Peter da Silva) Newsgroups: alt.sources Subject: TCL for System V (part 01/06) Message-ID: Date: 7 Mar 90 11:26:02 GMT Archive-name: tcl/Part01 This is just to let people get browse up and running. The code here should still work on BSD systems. The 'glob' stuff is not included in the binary built from this Makefile, to avoid GNU entanglements... the rest of the code appears to be under the standard Berkeley "do anything you want with this so long as you don't sue us" copyright. I've sent this stuff to John Ousterhout, so hopefully the next release of TCL will support System V. In the meantime, here's a (very) unofficial release. #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh 'MANIFEST' <<'END_OF_FILE' X File Name Archive # Description X----------------------------------------------------------- X MANIFEST 1 This shipping list X Makefile 1 Makefile X README 1 About TCL X argv.c 1 Copying argv in segmented machines X ckalloc.c 1 Error checking malloc X ckalloc.h 1 Error checking malloc X glob.c 1 GNU glob X l_init.c 1 List package X l_insert.c 1 List package X l_l_insert.c 1 List package X l_remove.c 1 List package X list.h 2 List package X panic.c 1 Abnormal error handler X sprite.h 1 Truncated SPRITE header file X stdlib.h 1 POSIX header X stream.5 1 Docs on 'stream'. X stream.c 2 Stdio-style stream I/O. X strerror.c 1 Generate perror() style error string X string.h 1 BSD header X strtol.c 1 Convert string to long X strtoul.c 1 Convert string to unsigned long X tcl.h 1 External tcl header file X tclBasic.c 6 Basic TCL routines X tclCmdAH.c 4 Commands A* to H* X tclCmdIZ.c 5 Commands I* to Z* X tclExpr.c 2 Expression parser X tclGlob.c 2 File globbing code X tclInt.h 2 Internal tcl header file X tclProc.c 3 Procedure handling code X tclTest.c 1 Test mainline X tclUtil.c 3 Utility routines END_OF_FILE if test 1624 -ne `wc -c <'MANIFEST'`; then echo shar: \"'MANIFEST'\" unpacked with wrong size! fi # end of 'MANIFEST' fi if test -f 'Makefile' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Makefile'\" else echo shar: Extracting \"'Makefile'\" \(1419 characters\) sed "s/^X//" >'Makefile' <<'END_OF_FILE' X# X# This Makefile is for use when distributing Tcl to the outside world. X# It is simplified so that it doesn't include any Sprite-specific stuff. X# XSHELL=/bin/sh X X# X#System V X# X#LIBS = X#RANLIB=: X#VOID= -DVOID=void X#MODEL= X#G=-g X X# X#System III Xenix X# XLIBS = -lx XRANLIB= ranlib XVOID= -DVOID=int XMODEL= -Ml XG= X X# X#BSD X# X#LIBS = X#RANLIB= ranlib X#VOID= -DVOID=void X#MODEL= X#G=-g X X# X#HPUX X# X#LIBS = -lBSD X#RANLIB= ranlib X#VOID= -DVOID=void X#MODEL= X#G=-g X XCFLAGS = -I. -DTCL_VERSION=\"2.1\" ${VOID} ${MODEL} ${G} X XGLOB= X# GLOB=glob.o tclGlob.o X XOBJS = ${GLOB} tclBasic.o tclCmdAH.o tclCmdIZ.o tclExpr.o \ X tclProc.o tclUtil.o X XLIBOBJS = panic.o strerror.o strtol.o strtoul.o l_init.o \ X l_insert.o l_l_insert.o l_remove.o ckalloc.o argv.o \ X stream.o X XHDRS=list.h sprite.h stdlib.h string.h tcl.h tclInt.h ckalloc.h XCSRCS = glob.c tclBasic.c tclCmdAH.c tclCmdIZ.c tclExpr.c \ X tclGlob.c tclProc.c tclUtil.c XLIBSRCS= ${LIBOBJS:.o=.c} X Xtcl.a: ${OBJS} ${LIBOBJS} X rm -f tcl.a X ar cr tcl.a ${OBJS} ${LIBOBJS} X ${RANLIB} tcl.a X XtclTest: tclTest.o tcl.a X cc ${CFLAGS} tclTest.o tcl.a ${LIBS} -o tclTest X Xclean: X rm -f ${OBJS} ${LIBOBJS} tcl.a tclTest.o tclTest X rm -f Part?? MANIFEST~ X XALLFILES= Makefile README stream.5 tclTest.c $(HDRS) $(CSRCS) $(LIBSRCS) X Xtcl.shar: $(ALLFILES) X shar $(ALLFILES) > tcl.shar X XMANIFEST: $(ALLFILES) X sh -c 'if [ -r MANIFEST ] ;\ X then makekit -m ;\ X else makekit -oMANIFEST $(ALLFILES) ;\ X fi' END_OF_FILE if test 1419 -ne `wc -c <'Makefile'`; then echo shar: \"'Makefile'\" unpacked with wrong size! fi # end of 'Makefile' fi if test -f 'README' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'README'\" else echo shar: Extracting \"'README'\" \(1897 characters\) sed "s/^X//" >'README' <<'END_OF_FILE' XTcl X Xby John Ousterhout XUniversity of California at Berkeley X XThis directory contains the sources for Tcl, an embeddable tool command Xlanguage. For an introduction to the facilities provided by Tcl, see Xthe paper ``Tcl: An Embeddable Command Language'', in the Proceedings Xof the 1990 Winter USENIX Conference. A copy of that paper is included Xin this directory in Postcript form: it's in the file "usenix.ps". X XThis file assumes that you have received a Tcl distribution and are going Xto use Tcl on a UNIX system; if you're running under Sprite at Berkeley, Xthen some of the notes here may be incorrect. X XThe documentation for Tcl is present in this directory as a set of Xfiles with ".man" extensions. The file "Tcl.man" gives an overall Xdescription of the Tcl language and facilities, and the other ".man Xfiles describe the library procedures that Tcl provides for tools to use. XRead the "Tcl" man page first. To print any of the man pages, use a Xcommand like X X ditroff X Xwhere is the name of the man page you'd like to print. Don't Xspecifiy any macros. X XType "make" to generate the Tcl library, and type "make tclTest" to Xcreate a simple test program that you can use to try out the Tcl facilities. XTclTest is just a main-program sandwich around the Tcl library. It reads Xstandard input until it reaches the end of a line where parentheses and Xbackslashes are balanced, then sends everything it's read to the Tcl Xinterpreter. When the Tcl interpreter returns, tclTest prints the return Xvalue or error message. TclTest defines a few other additional commands Xmost notably: X X echo arg arg ... X XThe "echo" command prints its arguments on standard output, separated by Xspaces. X XI can't promise to provide a lot of help to people trying to use Tcl, but XI am interested in hearing about bugs or suggestions for improvements. XSend them to me at "ouster@sprite.berkeley.edu". END_OF_FILE if test 1897 -ne `wc -c <'README'`; then echo shar: \"'README'\" unpacked with wrong size! fi # end of 'README' fi if test -f 'argv.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'argv.c'\" else echo shar: Extracting \"'argv.c'\" \(619 characters\) sed "s/^X//" >'argv.c' <<'END_OF_FILE' X#include X#include "tcl.h" X/* X * MOVE_ARGV(argv, argc, srcArray, dstArray, len); X * X * Moves an argv pointing into portions of the source string, into the X * (presumably larger) destination string. It does this by copying X * the contents of the array, then adjusting each element of the argv. X * since the two strings may not be in contiguous memory, we have to X * work with offsets. X */ X Xmove_argv(argv, argc, src, dst, len) Xchar **argv; Xint argc; Xchar *src; Xchar *dst; Xint len; X{ X int i; X unsigned off; X X bcopy(src, dst, len); X for(i = 0; i <= argc; i++) { X off = argv[i] - src; X argv[i] = dst + off; X } X} END_OF_FILE if test 619 -ne `wc -c <'argv.c'`; then echo shar: \"'argv.c'\" unpacked with wrong size! fi # end of 'argv.c' fi if test -f 'ckalloc.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ckalloc.c'\" else echo shar: Extracting \"'ckalloc.c'\" \(824 characters\) sed "s/^X//" >'ckalloc.c' <<'END_OF_FILE' X/* X * VOID *ckalloc(memory) X * unsigned memory; X * X * Allocate memory using malloc. If it fails, call a user-defined routine. X * This routine returns one of: X * X * ALLOC_FATAL (-1) Can't free any more memory, abort. X * ALLOC_RETRY (0) Try to allocate the memory again. X */ X#include X#include "ckalloc.h" X Xstatic int (*lowmem)() = NULL; X XVOID *ckalloc(memory) Xunsigned memory; X{ X VOID *result; X VOID *malloc(); X X do { X result = malloc(memory); X } while(result == NULL X && lowmem X && (*lowmem)(memory) == ALLOC_RETRY); X X if(result == NULL) X panic("Out of memory: can't malloc %u bytes.\n", memory); X X return result; X} X Xint (*setalloc(func))() Xint (*func)(); X{ X int (*old_lowmem)(); X X old_lowmem = lowmem; X lowmem = func; X return old_lowmem; X} X Xckfree(memory) Xchar *memory; X{ X if(memory) X free(memory); X} END_OF_FILE if test 824 -ne `wc -c <'ckalloc.c'`; then echo shar: \"'ckalloc.c'\" unpacked with wrong size! fi # end of 'ckalloc.c' fi if test -f 'ckalloc.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ckalloc.h'\" else echo shar: Extracting \"'ckalloc.h'\" \(127 characters\) sed "s/^X//" >'ckalloc.h' <<'END_OF_FILE' X#ifndef VOID X#define VOID void X#endif X XVOID *ckalloc(); Xint (*setalloc())(); X X#define ALLOC_FATAL (-1) X#define ALLOC_RETRY (0) END_OF_FILE if test 127 -ne `wc -c <'ckalloc.h'`; then echo shar: \"'ckalloc.h'\" unpacked with wrong size! fi # end of 'ckalloc.h' fi if test -f 'glob.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'glob.c'\" else echo shar: Extracting \"'glob.c'\" \(402 characters\) sed "s/^X//" >'glob.c' <<'END_OF_FILE' Xtcl.h:extern int Tcl_GlobCmd(); Xtcl.h:extern int Tcl_GlobalCmd(); XtclBasic.c: Tcl_GlobCmd, XtclBasic.c: Tcl_GlobalCmd, XtclCmdAH.c: * Tcl_GlobCmd -- XtclCmdAH.c:Tcl_GlobCmd(dummy, interp, argc, argv) XtclCmdAH.c: return Tcl_Glob(interp, argc, argv); XtclGlob.c: * Tcl_Glob -- XtclGlob.c:Tcl_Glob(interp, argc, argv) XtclProc.c: * Tcl_GlobalCmd -- XtclProc.c:Tcl_GlobalCmd(dummy, interp, argc, argv) END_OF_FILE if test 402 -ne `wc -c <'glob.c'`; then echo shar: \"'glob.c'\" unpacked with wrong size! fi # end of 'glob.c' fi if test -f 'l_init.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'l_init.c'\" else echo shar: Extracting \"'l_init.c'\" \(1413 characters\) sed "s/^X//" >'l_init.c' <<'END_OF_FILE' X/* X * List_Init.c -- X * X * Source code for the List_Init library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: List_Init.c,v 1.1 88/06/20 09:27:25 ouster Exp $ SPRITE (Berkeley)"; X#endif X X#include X#include "list.h" X X X/* X * ---------------------------------------------------------------------------- X * X * List_Init -- X * X * Initialize a header pointer to point to an empty list. The List_Links X * structure must already be allocated. X * X * Results: X * None. X * X * Side effects: X * The header's pointers are modified to point to itself. X * X * ---------------------------------------------------------------------------- X */ Xvoid XList_Init(headerPtr) X register List_Links *headerPtr; /* Pointer to a List_Links structure X to be header */ X{ X if (headerPtr == (List_Links *) NIL || !headerPtr) { X panic("List_Init: invalid header pointer.\n"); X } X headerPtr->nextPtr = headerPtr; X headerPtr->prevPtr = headerPtr; X} END_OF_FILE if test 1413 -ne `wc -c <'l_init.c'`; then echo shar: \"'l_init.c'\" unpacked with wrong size! fi # end of 'l_init.c' fi if test -f 'l_insert.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'l_insert.c'\" else echo shar: Extracting \"'l_insert.c'\" \(1910 characters\) sed "s/^X//" >'l_insert.c' <<'END_OF_FILE' X/* X * List_Insert.c -- X * X * Source code for the List_Insert library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/list/RCS/List_Insert.c,v 1.3 88/07/16 14:44:18 ouster Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include "list.h" X X/* X * ---------------------------------------------------------------------------- X * X * List_Insert -- X * X * Insert the list element pointed to by itemPtr into a List after X * destPtr. Perform a primitive test for self-looping by returning X * failure if the list element is being inserted next to itself. X * X * Results: X * None. X * X * Side effects: X * The list containing destPtr is modified to contain itemPtr. X * X * ---------------------------------------------------------------------------- X */ Xvoid XList_Insert(itemPtr, destPtr) X register List_Links *itemPtr; /* structure to insert */ X register List_Links *destPtr; /* structure after which to insert it */ X{ X if (itemPtr == (List_Links *) NIL || destPtr == (List_Links *) NIL X || !itemPtr || !destPtr) { X panic("List_Insert: itemPtr (%x) or destPtr (%x) is NIL.\n", X (unsigned int) itemPtr, (unsigned int) destPtr); X return; X } X if (itemPtr == destPtr) { X panic("List_Insert: trying to insert something after itself.\n"); X return; X } X itemPtr->nextPtr = destPtr->nextPtr; X itemPtr->prevPtr = destPtr; X destPtr->nextPtr->prevPtr = itemPtr; X destPtr->nextPtr = itemPtr; X} END_OF_FILE if test 1910 -ne `wc -c <'l_insert.c'`; then echo shar: \"'l_insert.c'\" unpacked with wrong size! fi # end of 'l_insert.c' fi if test -f 'l_l_insert.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'l_l_insert.c'\" else echo shar: Extracting \"'l_l_insert.c'\" \(1930 characters\) sed "s/^X//" >'l_l_insert.c' <<'END_OF_FILE' X/* X * List_ListInsert.c -- X * X * Source code for the List_ListInsert library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/list/RCS/List_ListInsert.c,v 1.1 89/06/12 16:59:31 shirriff Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include "list.h" X X/* X * ---------------------------------------------------------------------------- X * X * List_ListInsert -- X * X * Insert the list pointed to by headerPtr into a List after X * destPtr. X * X * Results: X * None. X * X * Side effects: X * The list containing destPtr is modified to contain itemPtr. X * headerPtr no longer references a valid list. X * X * ---------------------------------------------------------------------------- X */ Xvoid XList_ListInsert(headerPtr, destPtr) X register List_Links *headerPtr; /* structure to insert */ X register List_Links *destPtr; /* structure after which to insert it */ X{ X if (headerPtr == (List_Links *) NIL || destPtr == (List_Links *) NIL X || !headerPtr || !destPtr) { X panic("List_ListInsert: headerPtr (%x) or destPtr (%x) is NIL.\n", X (unsigned int) headerPtr, (unsigned int) destPtr); X return; X } X X if (headerPtr->nextPtr != headerPtr) { X headerPtr->prevPtr->nextPtr = destPtr->nextPtr; X headerPtr->nextPtr->prevPtr = destPtr; X destPtr->nextPtr->prevPtr = headerPtr->prevPtr; X destPtr->nextPtr = headerPtr->nextPtr; X } X X headerPtr->nextPtr = (List_Links *) NIL; X headerPtr->prevPtr = (List_Links *) NIL; X} END_OF_FILE if test 1930 -ne `wc -c <'l_l_insert.c'`; then echo shar: \"'l_l_insert.c'\" unpacked with wrong size! fi # end of 'l_l_insert.c' fi if test -f 'l_remove.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'l_remove.c'\" else echo shar: Extracting \"'l_remove.c'\" \(1594 characters\) sed "s/^X//" >'l_remove.c' <<'END_OF_FILE' X/* X * List_Remove.c -- X * X * Source code for the List_Remove library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/list/RCS/List_Remove.c,v 1.1 88/06/20 09:27:29 ouster Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include "list.h" X X/* X * ---------------------------------------------------------------------------- X * X * List_Remove -- X * X * Remove a list element from the list in which it is contained. X * X * Results: X * None. X * X * Side effects: X * The given structure is removed from its containing list. X * X * ---------------------------------------------------------------------------- X */ Xvoid XList_Remove(itemPtr) X register List_Links *itemPtr; /* list element to remove */ X{ X if (itemPtr == (List_Links *) NIL || itemPtr == itemPtr->nextPtr X || !itemPtr) { X panic("List_Remove: invalid item to remove.\n"); X } X if (itemPtr->prevPtr->nextPtr != itemPtr || X itemPtr->nextPtr->prevPtr != itemPtr) { X panic("List_Remove: item's pointers are invalid.\n"); X } X itemPtr->prevPtr->nextPtr = itemPtr->nextPtr; X itemPtr->nextPtr->prevPtr = itemPtr->prevPtr; X} END_OF_FILE if test 1594 -ne `wc -c <'l_remove.c'`; then echo shar: \"'l_remove.c'\" unpacked with wrong size! fi # end of 'l_remove.c' fi if test -f 'panic.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'panic.c'\" else echo shar: Extracting \"'panic.c'\" \(1578 characters\) sed "s/^X//" >'panic.c' <<'END_OF_FILE' X/* X * panic.c -- X * X * Source code for the "panic" library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/etc/RCS/panic.c,v 1.7 89/04/12 12:43:02 ouster Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include X#include X X/* X *---------------------------------------------------------------------- X * X * panic -- X * X * Print an error message and kill the process. X * X * Results: X * None. X * X * Side effects: X * The process dies, entering the debugger if possible. X * X *---------------------------------------------------------------------- X */ X X#ifndef lint Xvoid Xpanic(va_alist) X va_dcl /* char *format, then any number of additional X * values to be printed under the control of X * format. This is all just the same as you'd X * pass to printf. */ X{ X char *format; X va_list args; X X va_start(args); X format = va_arg(args, char *); X (void) vfprintf(stderr, format, args); X (void) fflush(stderr); X abort(); X} X#else X/* VARARGS1 */ X/* ARGSUSED */ Xvoid Xpanic(format) X char *format; X{ X return; X} X#endif /* lint */ END_OF_FILE if test 1578 -ne `wc -c <'panic.c'`; then echo shar: \"'panic.c'\" unpacked with wrong size! fi # end of 'panic.c' fi if test -f 'sprite.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'sprite.h'\" else echo shar: Extracting \"'sprite.h'\" \(2160 characters\) sed "s/^X//" >'sprite.h' <<'END_OF_FILE' X/* X * sprite.h -- X * X * Common constants and type declarations for Sprite. X * X * Copyright 1985, 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X * X * $Header: /sprite/src/lib/include/RCS/sprite.h,v 1.6 89/09/08 16:27:43 mgbaker Exp $ SPRITE (Berkeley) X */ X X#ifndef _SPRITE X#define _SPRITE X X/* X * A boolean type is defined as an integer, not an enum. This allows a X * boolean argument to be an expression that isn't strictly 0 or 1 valued. X */ X X#ifndef TRUE X#define TRUE 1 X#endif X#ifndef FALSE X#define FALSE 0 X#endif X X#ifndef _ASM Xtypedef int Boolean; X X/* X * Functions that must return a status can return a ReturnStatus to X * indicate success or type of failure. X */ X Xtypedef int ReturnStatus; X#endif /* _ASM */ X X/* X * The following statuses overlap with the first 2 generic statuses X * defined in status.h: X * X * SUCCESS There was no error. X * FAILURE There was a general error. X */ X X#define SUCCESS 0x00000000 X#define FAILURE 0x00000001 X X X/* X * A nil pointer must be something that will cause an exception if X * referenced. There are two nils: the kernels nil and the nil used X * by user processes. X */ X X#define NIL 0xFFFFFFFF X#define USER_NIL 0 X#ifndef NULL X#define NULL 0 X#endif X X#ifndef _ASM X/* X * An address is just a pointer in C. It is defined as a character pointer X * so that address arithmetic will work properly, a byte at a time. X */ X Xtypedef char *Address; X X/* X * ClientData is an uninterpreted word. It is defined as an int so that X * kdbx will not interpret client data as a string. Unlike an "Address", X * client data will generally not be used in arithmetic. X */ X X#ifndef _CLIENTDATA Xtypedef int *ClientData; X#define _CLIENTDATA X#endif X X#ifndef __STDC__ X#define volatile X#define const X#endif X#endif /* _ASM */ X X X#endif /* _SPRITE */ END_OF_FILE if test 2160 -ne `wc -c <'sprite.h'`; then echo shar: \"'sprite.h'\" unpacked with wrong size! fi # end of 'sprite.h' fi if test -f 'stdlib.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stdlib.h'\" else echo shar: Extracting \"'stdlib.h'\" \(3667 characters\) sed "s/^X//" >'stdlib.h' <<'END_OF_FILE' X/* X * stdlib.h -- X * X * Declares facilities exported by the "stdlib" portion of X * the C library. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X * X * $Header: /sprite/src/lib/include/RCS/stdlib.h,v 1.12 90/01/06 13:45:29 rab Exp $ SPRITE (Berkeley) X */ X X#ifndef _STDLIB X#define _STDLIB X X#define EXIT_SUCCESS 0 X#define EXIT_FAILURE 1 X X/* X *---------------------------- X * String conversion routines: X *---------------------------- X */ X Xextern double atof(); Xextern int atoi(); Xextern long int atol(); Xextern double strtod(); Xextern long int strtol(); Xextern unsigned long strtoul(); X X/* X *------------------ X * Memory allocator: X *------------------ X */ X Xextern char * alloca(); Xextern char * calloc(); Xextern char * malloc(); Xextern char * realloc(); Xextern void Mem_Bin(); Xextern char * Mem_CallerPC(); Xextern void Mem_DumpTrace(); Xextern void Mem_PrintConfig(); Xextern void Mem_PrintInUse(); Xextern void Mem_PrintStats(); Xextern void Mem_PrintStatsInt(); Xextern void Mem_SetPrintProc(); Xextern void Mem_SetTraceSizes(); Xextern int Mem_Size(); X X/* X * The mips compiler cannot handle some coercions on the left hand side X */ X#if defined(KERNEL) && !defined(mips) Xextern _free(); X X#ifdef lint X#define free(ptr) _free(ptr) X#else X#define free(ptr) {_free(ptr); (ptr) = (char *) NIL; } X#endif /* lint */ X X#else Xextern free(); X#endif /* KERNEL */ X X/* X * Structure used to set up memory allocation traces. X */ X Xtypedef struct { X int size; /* Size of block to trace. */ X int flags; /* Flags defined below */ X} Mem_TraceInfo; X X/* X * Flags to determine what type of tracing to do. X * X * MEM_PRINT_TRACE A trace record will be printed each time that X * an object of this size is alloc'd or freed. X * MEM_STORE_TRACE The number of blocks in use by each caller X * up to a predefined maximum number of callers X * is kept in a trace array . X * MEM_DONT_USE_ORIG_SIZE Don't use the original size for tracing, but use X * the modified size used by malloc. X * MEM_TRACE_NOT_INIT The trace records stored for MEM_STORE_TRACE X * have not been initialized yet. X */ X X#define MEM_PRINT_TRACE 0x1 X#define MEM_STORE_TRACE 0x2 X#define MEM_DONT_USE_ORIG_SIZE 0x4 X#define MEM_TRACE_NOT_INIT 0x8 X Xextern int mem_SmallMinNum; Xextern int mem_LargeMinNum; Xextern int mem_LargeMaxSize; X X/* X * Statistics counters; only incremented when tracing is enabled. X */ X Xextern int mem_NumAllocs; Xextern int mem_NumFrees; X X/* X *---------------------------------------------------------------- X * Additional integer math routines, plus structures for returning X * results from them: X *---------------------------------------------------------------- X */ X Xtypedef struct div_t { X int quot; X int rem; X} div_t; X Xtypedef struct { X long int quot; X long int rem; X} ldiv_t; X Xextern int abs(); Xextern div_t div(); Xextern long int labs(); Xextern ldiv_t ldiv(); X X/* X *----------------------------------- X * Miscellaneous additional routines: X *----------------------------------- X */ X Xextern void abort(); Xextern int atexit(); Xextern char * bsearch(); Xextern exit(); Xextern char * getenv(); Xextern void qsort(); Xextern int rand(); Xextern long random(); Xextern void setenv(); Xextern srand(); Xextern srandom(); Xextern int system(); X X#endif /* _STDLIB */ END_OF_FILE if test 3667 -ne `wc -c <'stdlib.h'`; then echo shar: \"'stdlib.h'\" unpacked with wrong size! fi # end of 'stdlib.h' fi if test -f 'stream.5' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'stream.5'\" else echo shar: Extracting \"'stream.5'\" \(2694 characters\) sed "s/^X//" >'stream.5' <<'END_OF_FILE' X.TH STREAM 5 X.SH NAME Xstream \- Stream I/O commands for TCL X.SH SYNOPSIS X.B stream Xhandle X.B open Xname mode X.br X.B stream Xhandle X.B close X.br X.B stream Xhandle X.B gets X.br X.B stream Xhandle X.B puts Xline X.br X.B stream Xhandle X.B name X.br X.B stream Xhandle X.B error X.br X.B stream Xhandle X.B eof X.br X.B stream Xhandle X.B tell X.br X.B stream Xhandle X.B seek Xoffset [whence] X.SH DESCRIPTION X.PP X.B Stream Xis a set of commands that provide access from TCL to stdio routines. They Xuse a token called a "stream handle" to indicate what stream is beaing Xoperated on. You create a handle with "open", and delete it with "close". XWhen you open a stream, a new handle is always created. If an old handle Xof the same name existed, it will be "pushed" under the new one and be Xunavailable until the new one is deleted. This makes it simpler to handle Xtemporary files. X.PP XWhen stream starts up, the handles "stdin", "stdout", and "stderr" are Xalready open. X.SH COMMANDS X.PP XAll commands take a handle as a first argument, followed by the actual Xcommand: X.IP "\fBstream\fR handle \fBopen\fR name mode" XThis creates a new handle, referring to the named stream. The mode should Xbe the same as for fopen (r, w, w+, a, etc...). An error condition exists Xif the named file can not be opened. X.IP "\fBstream\fR handle \fBclose\fR" XThis closes the handle. It is an error for the handle not to exist on this Xor any of the remaining commands. X.IP "\fBstream\fR handle \fBgets\fR" XThis reads a line from the file, returning it as the result. There is no Xtrailing newline, so you can't distinguish an empty line from eof... use X"stream handle eof" for this purpose. X.IP "\fBstream\fR handle \fBputs\fR line" XThis writes a line to the file, plus a trailing newline. X.IP "\fBstream\fR handle \fBerror\fR" XThis returns an error message if an error condition exists for this handle, Xotherwise it returns a null string. X.IP "\fBstream\fR handle \fBname\fR" XThis returns the name of the file associated with this handle. X.IP "\fBstream\fR handle \fBeof\fR" XThis returns 1 if EOF has bean read on this handle, otherwise 0. X.IP "\fBstream\fR handle \fBtell\fR" XThis returns the current offset of this handle, in decimal. X.IP "\fBstream\fR handle \fBseek\fR offset [whence]" XThis seeks to the named offset. Whence is 0, 1, or 2 (as in fseek), and Xdefaults to 0 if not specified. X.SH SEE ALSO XTCL(1), John Ousterhout. X.SH BUGS X.PP XThe semantics are not quite the same as the STDIO functions, because of Xthe single return value. X.PP XNo method has yet been implemented to get the error status of a stream. XEventually "stream handle error" will return a null string if no error Xhas occurred on the stream, or a perror-style error text. END_OF_FILE if test 2694 -ne `wc -c <'stream.5'`; then echo shar: \"'stream.5'\" unpacked with wrong size! fi # end of 'stream.5' fi if test -f 'strerror.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'strerror.c'\" else echo shar: Extracting \"'strerror.c'\" \(5114 characters\) sed "s/^X//" >'strerror.c' <<'END_OF_FILE' X/* X * strerror.c -- X * X * Source code for the "strerror" library routine. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/string/RCS/strerror.c,v 1.5 89/03/22 16:06:57 rab Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include X X#ifdef BSD X/* X * List of known errors: X */ X Xchar *sys_errlist[] = { X "no error (operation succeeded", /* 0 */ X "not owner", /* EPERM */ X "no such file or directory", /* ENOENT */ X "no such process", /* ESRCH */ X "interrupted system call", /* EINTR */ X "I/O error", /* EIO */ X "no such device or address", /* ENXIO */ X "argument list too long", /* E2BIG */ X "exec format error", /* ENOEXEC */ X "bad file number", /* EBADF */ X "no children", /* ECHILD */ X "no more processes", /* EAGAIN */ X "not enough memory", /* ENOMEM */ X "permission denied", /* EACCESS */ X "bad address in system call argument", /* EFAULT */ X "block device required", /* ENOTBLK */ X "mount device busy", /* EBUSY */ X "file already exists", /* EEXIST */ X "cross-domain link", /* EXDEV */ X "no such device", /* ENODEV */ X "not a directory", /* ENOTDIR */ X "illegal operation on a directory", /* EISDIR */ X "invalid argument", /* EINVAL */ X "file table overflow", /* ENFILE */ X "too many open files", /* EMFILE */ X "inappropriate device for ioctl", /* ENOTTY */ X "text file or pseudo-device busy", /* ETXTBSY */ X "file too large", /* EFBIG */ X "no space left in file system domain", /* ENOSPC */ X "illegal seek", /* ESPIPE */ X "read-only file system", /* EROFS */ X "too many links", /* EMLINK */ X "broken pipe", /* EPIPE */ X "math argument out of range", /* EDOM */ X "math result unrepresentable", /* ERANGE */ X "operation would block", /* EWOULDBLOCK */ X "operation now in progress", /* EINPROGRESS */ X "operation already in progress", /* EALREADY */ X "socket operation on non-socket", /* ENOTSOCK */ X "destination address required", /* EDESTADDRREQ */ X "message too long", /* EMSGSIZE */ X "protocol wrong type for socket", /* EPROTOTYPE */ X "bad proocol option", /* ENOPROTOOPT */ X "protocol not suppored", /* EPROTONOSUPPORT */ X "socket type not supported", /* ESOCKTNOSUPPORT */ X "operation not supported on socket", /* EOPNOTSUPP */ X "protocol family not supported", /* EPFNOSUPPORT */ X "address family not supported by protocol family", /* EAFNOSUPPORT */ X "address already in use", /* EADDRINUSE */ X "can't assign requested address", /* EADDRNOTAVAIL */ X "network is down", /* ENETDOWN */ X "network is unreachable", /* ENETUNREACH */ X "network dropped connection on reset", /* ENETRESET */ X "software caused connection abort", /* ECONNABORTED */ X "connection reset by peer", /* ECONNRESET */ X "no buffer space available", /* ENOBUFS */ X "socket is already connected", /* EISCONN */ X "socket is not connected", /* ENOTCONN */ X "can't send afer socket shutdown", /* ESHUTDOWN */ X "undefined error (59)", /* not used */ X "connection timed out", /* ETIMEDOUT */ X "connection refused", /* ECONNREFUSED */ X "too many levels of symbolic links", /* ELOOP */ X "file name too long", /* ENAMETOOLONG */ X "host is down", /* EHOSTDOWN */ X "host is unreachable", /* EHOSTUNREACH */ X "directory not empty", /* ENOTEMPTY */ X "too many processes", /* EPROCLIM */ X "too many users", /* EUSERS */ X "disk quota exceeded", /* EDQUOT */ X "stale remote file handle", /* ESTALE */ X "pathname hit remote file system", /* EREMOTE */ X}; Xint sys_nerr = sizeof(sys_errlist)/sizeof(char *); X#else Xextern char *sys_errlist[]; Xextern int sys_nerr; X#endif X X/* X *---------------------------------------------------------------------- X * X * strerror -- X * X * Map an integer error number into a printable string. X * X * Results: X * The return value is a pointer to a string describing X * error. The first character of string isn't capitalized. X * X * Side effects: X * Each call to this procedure may overwrite the value returned X * by the previous call. X * X *---------------------------------------------------------------------- X */ X Xchar * Xstrerror(error) X int error; /* Integer identifying error (must be X * one of the officially-defined Sprite X * errors, as defined in errno.h). */ X{ X static char defaultMsg[50]; X X if ((error <= sys_nerr) && (error > 0)) { X return sys_errlist[error]; X } X (void) sprintf(defaultMsg, "unknown error (%d)", error); X return defaultMsg; X} END_OF_FILE if test 5114 -ne `wc -c <'strerror.c'`; then echo shar: \"'strerror.c'\" unpacked with wrong size! fi # end of 'strerror.c' fi if test -f 'string.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'string.h'\" else echo shar: Extracting \"'string.h'\" \(1276 characters\) sed "s/^X//" >'string.h' <<'END_OF_FILE' X/* X * string.h -- X * X * Declarations of ANSI C library procedures for string handling. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X * X * $Header: /sprite/src/lib/include/RCS/string.h,v 1.5 89/03/22 16:03:43 rab Exp $ SPRITE (Berkeley) X */ X X#ifndef _STRING X#define _STRING X Xextern char * memchr(); Xextern int memcmp(); Xextern char * memcpy(); Xextern char * memset(); X Xextern char * strcat(); Xextern char * strchr(); Xextern int strcmp(); Xextern char * strcpy(); Xextern int strcspn(); Xextern char * strerror(); Xextern int strlen(); Xextern char * strncat(); Xextern int strncmp(); Xextern char * strncpy(); Xextern char * strpbrk(); Xextern char * strrchr(); Xextern int strspn(); Xextern char * strstr(); Xextern char * strtok(); X X/* X * Obsolete library procedures from BSD, supported for compatibility: X */ X Xextern char *index(); Xextern char *rindex(); X X#endif /* _STRING */ END_OF_FILE if test 1276 -ne `wc -c <'string.h'`; then echo shar: \"'string.h'\" unpacked with wrong size! fi # end of 'string.h' fi if test -f 'strtol.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'strtol.c'\" else echo shar: Extracting \"'strtol.c'\" \(2282 characters\) sed "s/^X//" >'strtol.c' <<'END_OF_FILE' X/* X * strtol.c -- X * X * Source code for the "strtol" library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/stdlib/RCS/strtol.c,v 1.4 89/03/22 00:47:30 rab Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include X X X/* X *---------------------------------------------------------------------- X * X * strtol -- X * X * Convert an ASCII string into an integer. X * X * Results: X * The return value is the integer equivalent of string. If endPtr X * is non-NULL, then *endPtr is filled in with the character X * after the last one that was part of the integer. If string X * doesn't contain a valid integer value, then zero is returned X * and *endPtr is set to string. X * X * Side effects: X * None. X * X *---------------------------------------------------------------------- X */ X Xlong int Xstrtol(string, endPtr, base) X char *string; /* String of ASCII digits, possibly X * preceded by white space. For bases X * greater than 10, either lower- or X * upper-case digits may be used. X */ X char **endPtr; /* Where to store address of terminating X * character, or NULL. */ X int base; /* Base for conversion. Must be less X * than 37. If 0, then the base is chosen X * from the leading characters of string: X * "0x" means hex, "0" means octal, anything X * else means decimal. X */ X{ X register char *p; X int result; X X /* X * Skip any leading blanks. X */ X X p = string; X while (isspace(*p)) { X p += 1; X } X X /* X * Check for a sign. X */ X X if (*p == '-') { X p += 1; X result = -(strtoul(p, endPtr, base)); X } else { X if (*p == '+') { X p += 1; X } X result = strtoul(p, endPtr, base); X } X if ((result == 0) && (endPtr != 0) && (*endPtr == p)) { X *endPtr = string; X } X return result; X} END_OF_FILE if test 2282 -ne `wc -c <'strtol.c'`; then echo shar: \"'strtol.c'\" unpacked with wrong size! fi # end of 'strtol.c' fi if test -f 'strtoul.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'strtoul.c'\" else echo shar: Extracting \"'strtoul.c'\" \(4375 characters\) sed "s/^X//" >'strtoul.c' <<'END_OF_FILE' X/* X * strtoul.c -- X * X * Source code for the "strtoul" library procedure. X * X * Copyright 1988 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/c/stdlib/RCS/strtoul.c,v 1.2 89/03/22 00:47:33 rab Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#include X#include X X/* X * The table below is used to convert from ASCII digits to a X * numerical equivalent. It maps from '0' through 'z' to integers X * (100 for non-digit characters). X */ X Xstatic char cvtIn[] = { X 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, /* '0' - '9' */ X 100, 100, 100, 100, 100, 100, 100, /* punctuation */ X 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'A' - 'Z' */ X 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, X 30, 31, 32, 33, 34, 35, X 100, 100, 100, 100, 100, 100, /* punctuation */ X 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, /* 'a' - 'z' */ X 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, X 30, 31, 32, 33, 34, 35}; X X/* X *---------------------------------------------------------------------- X * X * strtoul -- X * X * Convert an ASCII string into an integer. X * X * Results: X * The return value is the integer equivalent of string. If endPtr X * is non-NULL, then *endPtr is filled in with the character X * after the last one that was part of the integer. If string X * doesn't contain a valid integer value, then zero is returned X * and *endPtr is set to string. X * X * Side effects: X * None. X * X *---------------------------------------------------------------------- X */ X Xunsigned long int Xstrtoul(string, endPtr, base) X char *string; /* String of ASCII digits, possibly X * preceded by white space. For bases X * greater than 10, either lower- or X * upper-case digits may be used. X */ X char **endPtr; /* Where to store address of terminating X * character, or NULL. */ X int base; /* Base for conversion. Must be less X * than 37. If 0, then the base is chosen X * from the leading characters of string: X * "0x" means hex, "0" means octal, anything X * else means decimal. X */ X{ X register char *p; X register unsigned long int result = 0; X register unsigned digit; X int anyDigits = FALSE; X X /* X * Skip any leading blanks. X */ X X p = string; X while (isspace(*p)) { X p += 1; X } X X /* X * If no base was provided, pick one from the leading characters X * of the string. X */ X X if (base == 0) X { X if (*p == '0') { X p += 1; X if (*p == 'x') { X p += 1; X base = 16; X } else { X X /* X * Must set anyDigits here, otherwise "0" produces a X * "no digits" error. X */ X X anyDigits = TRUE; X base = 8; X } X } X else base = 10; X } else if (base == 16) { X X /* X * Skip a leading "0x" from hex numbers. X */ X X if ((p[0] == '0') && (p[1] == 'x')) { X p += 2; X } X } X X /* X * Sorry this code is so messy, but speed seems important. Do X * different things for base 8, 10, 16, and other. X */ X X if (base == 8) { X for ( ; ; p += 1) { X digit = *p - '0'; X if (digit > 7) { X break; X } X result = (result << 3) + digit; X anyDigits = TRUE; X } X } else if (base == 10) { X for ( ; ; p += 1) { X digit = *p - '0'; X if (digit > 9) { X break; X } X result = (10*result) + digit; X anyDigits = TRUE; X } X } else if (base == 16) { X for ( ; ; p += 1) { X digit = *p - '0'; X if (digit > ('z' - '0')) { X break; X } X digit = cvtIn[digit]; X if (digit > 15) { X break; X } X result = (result << 4) + digit; X anyDigits = TRUE; X } X } else { X for ( ; ; p += 1) { X digit = *p - '0'; X if (digit > ('z' - '0')) { X break; X } X digit = cvtIn[digit]; X if (digit >= base) { X break; X } X result = result*base + digit; X anyDigits = TRUE; X } X } X X /* X * See if there were any digits at all. X */ X X if (!anyDigits) { X p = string; X } X X if (endPtr != NULL) { X *endPtr = p; X } X X return result; X} END_OF_FILE if test 4375 -ne `wc -c <'strtoul.c'`; then echo shar: \"'strtoul.c'\" unpacked with wrong size! fi # end of 'strtoul.c' fi if test -f 'tcl.h' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'tcl.h'\" else echo shar: Extracting \"'tcl.h'\" \(4504 characters\) sed "s/^X//" >'tcl.h' <<'END_OF_FILE' X/* X * tcl.h -- X * X * This header file describes the externally-visible facilities X * of the Tcl interpreter. X * X * Copyright 1987 Regents of the University of California X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X * X * $Header: /sprite/src/lib/tcl/RCS/tcl.h,v 1.33 90/01/15 14:06:02 ouster Exp $ SPRITE (Berkeley) X */ X X#ifndef _TCL X#define _TCL X X/* X * Data structures defined opaquely in this module. The definitions X * below just provide dummy types. A few fields are made visible in X * Tcl_Interp structures, namely those for returning string values. X * Note: any change to the Tcl_Interp definition below must be mirrored X * in the "real" definition in tclInt.h. X */ X Xtypedef struct { X char *result; /* Points to result string returned by last X * command. */ X int dynamic; /* Non-zero means result is dynamically- X * allocated and must be freed by Tcl_Eval X * before executing the next command. */ X int errorLine; /* When TCL_ERROR is returned, this gives X * the line number within the command where X * the error occurred (1 means first line). */ X} Tcl_Interp; Xtypedef int *Tcl_Trace; X X/* X * When a TCL command returns, the string pointer interp->result points to X * a string containing return information from the command. In addition, X * the command procedure returns an integer value, which is one of the X * following: X * X * TCL_OK Command completed normally; interp->result contains X * the command's result. X * TCL_ERROR The command couldn't be completed successfully; X * interp->result describes what went wrong. X * TCL_RETURN The command requests that the current procedure X * return; interp->result contains the procedure's X * return value. X * TCL_BREAK The command requests that the innermost loop X * be exited; interp->result is meaningless. X * TCL_CONTINUE Go on to the next iteration of the current loop; X * interp->result is meaninless. X */ X X#define TCL_OK 0 X#define TCL_ERROR 1 X#define TCL_RETURN 2 X#define TCL_BREAK 3 X#define TCL_CONTINUE 4 X X#define TCL_RESULT_SIZE 199 X X/* X * Flag values passed to Tcl_Eval (see the man page for details): X */ X X#define TCL_BRACKET_TERM 1 X X/* X * Flag values passed to Tcl_Return (see the man page for details): X */ X X#define TCL_STATIC 0 X#define TCL_DYNAMIC 1 X#define TCL_VOLATILE 2 X X/* X * Exported Tcl procedures: X */ X Xextern void Tcl_AddErrorInfo(); Xextern char Tcl_Backslash(); Xextern char * Tcl_Concat(); Xextern void Tcl_CreateCommand(); Xextern Tcl_Interp * Tcl_CreateInterp(); Xextern Tcl_Trace Tcl_CreateTrace(); Xextern void Tcl_DeleteCommand(); Xextern void Tcl_DeleteInterp(); Xextern void Tcl_DeleteTrace(); Xextern int Tcl_Eval(); Xextern int Tcl_Expr(); Xextern char * Tcl_GetVar(); Xextern char * Tcl_Merge(); Xextern char * Tcl_ParseVar(); Xextern void Tcl_Return(); Xextern void Tcl_SetVar(); Xextern int Tcl_SplitList(); Xextern int Tcl_StringMatch(); Xextern void Tcl_WatchInterp(); X X/* X * Built-in Tcl command procedures: X */ X Xextern int Tcl_BreakCmd(); Xextern int Tcl_CaseCmd(); Xextern int Tcl_CatchCmd(); Xextern int Tcl_ConcatCmd(); Xextern int Tcl_ContinueCmd(); Xextern int Tcl_ErrorCmd(); Xextern int Tcl_EvalCmd(); Xextern int Tcl_ExecCmd(); Xextern int Tcl_ExprCmd(); Xextern int Tcl_FileCmd(); Xextern int Tcl_ForCmd(); Xextern int Tcl_ForeachCmd(); Xextern int Tcl_FormatCmd(); Xextern int Tcl_GlobCmd(); Xextern int Tcl_GlobalCmd(); Xextern int Tcl_IfCmd(); Xextern int Tcl_InfoCmd(); Xextern int Tcl_IndexCmd(); Xextern int Tcl_LengthCmd(); Xextern int Tcl_ListCmd(); Xextern int Tcl_PrintCmd(); Xextern int Tcl_ProcCmd(); Xextern int Tcl_RangeCmd(); Xextern int Tcl_RenameCmd(); Xextern int Tcl_ReturnCmd(); Xextern int Tcl_ScanCmd(); Xextern int Tcl_SetCmd(); Xextern int Tcl_SourceCmd(); Xextern int Tcl_StringCmd(); Xextern int Tcl_TimeCmd(); Xextern int Tcl_UplevelCmd(); X X/* X * Miscellaneous declarations (to allow Tcl to be used stand-alone, X * without the rest of Sprite). X */ X X#ifndef NULL X#define NULL 0 X#endif X X#ifndef _CLIENTDATA Xtypedef int *ClientData; X#define _CLIENTDATA X#endif X X#include "ckalloc.h" X X/* Portability stuff */ X#ifndef BSD X#define bcopy(f,t,l) memcpy(t,f,l) X#endif X X#endif /* _TCL */ END_OF_FILE if test 4504 -ne `wc -c <'tcl.h'`; then echo shar: \"'tcl.h'\" unpacked with wrong size! fi # end of 'tcl.h' fi if test -f 'tclTest.c' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'tclTest.c'\" else echo shar: Extracting \"'tclTest.c'\" \(3733 characters\) sed "s/^X//" >'tclTest.c' <<'END_OF_FILE' X/* X * tcl.c -- X * X * Test driver for TCL. X * X * Copyright 1987 Regents of the University of California X * All rights reserved. X * Permission to use, copy, modify, and distribute this X * software and its documentation for any purpose and without X * fee is hereby granted, provided that the above copyright X * notice appear in all copies. The University of California X * makes no representations about the suitability of this X * software for any purpose. It is provided "as is" without X * express or implied warranty. X */ X X#ifndef lint Xstatic char rcsid[] = "$Header: /sprite/src/lib/tcl/tclTest/RCS/tclTest.c,v 1.6 90/02/09 08:34:14 ouster Exp $ SPRITE (Berkeley)"; X#endif /* not lint */ X X#include X#ifdef BSD X#include X#endif X#include "tcl.h" X XTcl_Interp *interp; X Xint XcmdEcho(clientData, interp, argc, argv) X char *clientData; X Tcl_Interp *interp; X int argc; X char **argv; X{ X int i; X X for (i = 1; ; i++) { X if (argv[i] == NULL) { X if (i != argc) { X echoError: X sprintf(interp->result, X "argument list wasn't properly NULL-terminated in \"%s\" command", X argv[0]); X } X break; X } X if (i >= argc) { X goto echoError; X } X fputs(argv[i], stdout); X if (i < (argc-1)) { X printf(" "); X } X } X printf("\n"); X return TCL_OK; X} X Xvoid XdeleteProc(clientData) X char *clientData; X{ X printf("Deleting command with clientData \"%s\".\n", clientData); X} X Xint XcmdCreate(clientData, interp, argc, argv) X ClientData clientData; /* Not used. */ X Tcl_Interp *interp; X int argc; X int *argv; X{ X int count; X if (argc != 2) { X sprintf(interp->result, "wrong # args: should be \"%.50s count\"", X argv[0]); X return TCL_ERROR; X } X count = atoi(argv[1]); X for (; count > 0; count--) { X Tcl_DeleteInterp(Tcl_CreateInterp()); X } X return TCL_OK; X} X Xint XcmdSleep(clientData, interp, argc, argv) X ClientData clientData; /* Not used. */ X Tcl_Interp *interp; X int argc; X int *argv; X{ X int count; X if (argc != 2) { X sprintf(interp->result, "wrong # args: should be \"%.50s seconds\"", X argv[0]); X return TCL_ERROR; X } X count = atoi(argv[1]); X sleep(count); X return TCL_OK; X} X Xmain() X{ X char cmd[1000], *p; X register char *p2; X int c, i, result; X X interp = Tcl_CreateInterp(); X Tcl_CreateCommand(interp, "echo", cmdEcho, (ClientData) "echo", X deleteProc); X Tcl_CreateCommand(interp, "create", cmdCreate, (ClientData) "create", X deleteProc); X Tcl_CreateCommand(interp, "sleep", cmdSleep, (ClientData) "sleep", X deleteProc); X stream_init(interp); X X while (1) { X clearerr(stdin); X fputs("% ", stdout); X fflush(stdout); X p = cmd; X while (1) { X c = getchar(); X if (c == EOF) { X if (p == cmd) { X exit(0); X } X goto gotCommand; X } X if (c == '\n') { X register char *p2; X int parens, brackets, numBytes; X X for (p2 = cmd, parens = 0, brackets = 0; p2 != p; p2++) { X switch (*p2) { X case '\\': X Tcl_Backslash(p2, &numBytes); X p2 += numBytes-1; X break; X case '{': X parens++; X break; X case '}': X parens--; X break; X case '[': X brackets++; X break; X case ']': X brackets--; X break; X } X } X if ((parens <= 0) && (brackets <= 0)) { X goto gotCommand; X } X } X *p = c; X p++; X } X gotCommand: X *p = 0; X X result = Tcl_Eval(interp, cmd, 0, &p); X if (result == TCL_OK) { X if (*interp->result != 0) { X printf("%s\n", interp->result); X } X } else { X if (result == TCL_ERROR) { X printf("Error"); X } else { X printf("Error %d", result); X } X if (*interp->result != 0) { X printf(": %s\n", interp->result); X } else { X printf("\n"); X } X } X } X} END_OF_FILE if test 3733 -ne `wc -c <'tclTest.c'`; then echo shar: \"'tclTest.c'\" unpacked with wrong size! fi # end of 'tclTest.c' fi echo shar: End of archive 1 \(of 6\). cp /dev/null ark1isdone MISSING="" for I in 1 2 3 4 5 6 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have unpacked all 6 archives. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0 -- _--_|\ `-_-' Peter da Silva. +1 713 274 5180. . / \ 'U` \_.--._/ "I've about decided that the net is not the place to do the right v thing. It might violate a charter somewhere ..." -- Spenser Aden