+++ /dev/null
-*~
-bak .bak *.bak
-Debug Release
-*.o
-*.exe
-samplestore
+++ /dev/null
-<html>
-<head>
-<title>Special Offer</title>
-</head>
-
-<body bgcolor="ffffff" text="000000" link="39848c" vlink="808080"
-alink="000000">
-<center>
-<img src="../Images/offer-hd.gif" alt="[Special Offer]">
-</center>
-<h3>Here's just the thing to accompany your <i>RMS Titanic</i>:</h3>
-<ul>
- <li>Add the<a href="../sample-store?op=AddItemToCart&item=YellowSubmarine">
- <i>Yellow Submarine</i></a> to your shopping cart.
-</ul>
-<p> <a href="../sample-store?op=DisplayStore">Return to shop.</a>
-<p> <a href="../sample-store?op=DisplayCart">View the contents of your shopping
- cart.</a>
-<p>
-
-<hr>
-</body>
-</html>
+++ /dev/null
-<html>
-<head>
-<title>Purchase</title>
-</head>
-
-<body bgcolor="ffffff" text="000000" link="39848c" vlink="808080"
-alink="000000">
-
-<center>
-<img src="../Images/purch-hd.gif" alt="[Purchase]">
-</center>
-
-This is only a sample program; you can't make real purchases.
-<p> <a href="../sample-store?op=Purchase">Complete the purchase (i.e. empty your
- cart).</a>
-<p> <a href="../sample-store?op=DisplayStore">Return to shop.</a>
-<p> <a href="../sample-store?op=DisplayCart">View the contents of your shopping
- cart.</a>
-<p>
-
-<hr>
-</body>
-</html>
+++ /dev/null
-<html>
-<head>
-<title>Thank You</title>
-</head>
-
-<body bgcolor="ffffff" text="000000" link="39848c" vlink="808080"
-alink="000000">
-<center>
-<img src="../Images/thank-hd.gif" alt="[Thank You]">
-</center>
-
-We look forward to your next visit.
-<p> <a href="../sample-store?op=DisplayStore">Return to shop.</a>
-<p>
-
-<hr>
-</body>
-</html>
+++ /dev/null
-/*
- * sample-store.c --
- *
- * FastCGI example program using fcgi_stdio library
- *
- *
- * Copyright (c) 1996 Open Market, Inc.
- *
- * See the file "LICENSE.TERMS" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- *
- * sample-store is a program designed to illustrate one technique
- * for writing a high-performance FastCGI application that maintains
- * permanent state. It is real enough to demonstrate a range of issues
- * that can arise in FastCGI application programming.
- *
- * sample-store implements per-user shopping carts. These carts are kept
- * in memory for speed but are backed up on disk for reliability; the
- * program can restart at any time, affecting at most one request. Unlike
- * CGI applications, the performance impact of sample-store's disk
- * use is negligible: no I/O for query requests, no reads and one write
- * for a typical update request.
- *
- * sample-store's on-disk representation is extremely simple. The
- * current state of all shopping carts managed by a process is kept
- * in two files, a snapshot and a log. Both files have the same format,
- * a sequence of ASCII records. On restart the current state is restored
- * by replaying the snapshot and the log. When the log grows to a certain
- * length, sample-store writes a new snapshot and empties the log.
- * This prevents the time needed for restart from growing without
- * bound.
- *
- * Since users "visit" Web sites, but never "leave", sample-store
- * deletes a shopping cart after the cart has been inactive
- * for a certain period of time. This policy prevents sample-store's
- * memory requirements from growing without bound.
- *
- * sample-store operates both as a FastCGI Responder and as an
- * Authorizer, showing how one program can play two roles.
- *
- * The techniques used in sample-store are not specific to shopping
- * carts; they apply equally well to maintaining all sorts of
- * information.
- *
- */
-
-#ifndef lint
-static const char rcsid[] = "$Id: sample-store.c,v 1.2 2001/06/19 17:49:26 robs Exp $";
-#endif /* not lint */
-
-#include <assert.h> /* assert */
-#include <dirent.h> /* readdir, closedir, DIR, dirent */
-#include <errno.h> /* errno, ENOENT */
-#include <stdlib.h> /* malloc/free, getenv, strtol */
-#include <string.h> /* strcmp, strncmp, strlen, strstr, strchr */
-#include <time.h> /* time, time_t */
-
-#include "fcgi_config.h"
-
-#ifdef HAVE_UNISTD_H
-#include <unistd.h> /* fsync */
-#endif
-
-#include "tcl.h" /* Tcl_*Hash* functions */
-
-#if defined __linux__
-int fsync(int fd);
-#endif
-
-#include "fcgi_stdio.h" /* FCGI_Accept, FCGI_Finish, stdio */
-
-/*
- * sample-store is designed to be configured as follows (for the OM server):
- *
- * SI_Department SampleStoreDept -EnableAnonymousTicketing 1
- * Region /SampleStore/ * { SI_RequireSI SampleStoreDept 1 }
- *
- * Filemap /SampleStore $fcgi-devel-kit/examples/SampleStore
- * AppClass SampleStoreAppClass \
- * $fcgi-devel-kit/examples/sample-store \
- * -initial-env STATE_DIR=$fcgi-devel-kit/examples/SampleStore.state \
- * -initial-env CKP_THRESHOLD=100 \
- * -initial-env CART_HOLD_MINUTES=240 \
- * -processes 2 -affinity
- * Responder SampleStoreAppClass /SampleStore/App
- * AuthorizeRegion /SampleStore/Protected/ * SampleStoreAppClass
- *
- * sample-store looks for three initial environment variables:
- *
- * STATE_DIR
- * When sample-store is run as a single process without affinity
- * this is the directory containing the permanent state of the
- * process. When sample-store is run as multiple processes
- * using session affinity, the state directory is
- * $STATE_DIR.$FCGI_PROCESS_ID, e.g. SampleStore.state.0
- * and SampleStore.state.1 in the config above. The process
- * state directory must exist, but may be empty.
- *
- * CKP_THRESHOLD
- * When the log grows to contain this many records the process
- * writes a new snapshot and truncates the log. Defaults
- * to CKP_THRESHOLD_DEFAULT.
- *
- * CART_HOLD_MINUTES
- * When a cart has not been accessed for this many minutes it
- * may be deleted. Defaults to CART_HOLD_MINUTES_DEFAULT.
- *
- * The program is prepared to run as multiple processes using
- * session affinity (illustrated in config above) or as a single process.
- *
- * The program does not depend upon the specific URL prefix /SampleStore.
- *
- */
-\f
-/*
- * This code is organized top-down, trying to put the most interesting
- * parts first. Unfortunately, organizing the program in this way requires
- * lots of extra declarations to take care of forward references.
- *
- * Utility functions for string/list processing and such
- * are left to the very end. The program uses the Tcl hash table
- * package because it is both adequate and readily available.
- */
-
-#ifndef FALSE
-#define FALSE (0)
-#endif
-
-#ifndef TRUE
-#define TRUE (1)
-#endif
-
-#ifndef max
-#define max(a,b) ((a) > (b) ? (a) : (b))
-#endif
-
-#define Strlen(str) (((str) == NULL) ? 0 : strlen(str))
-
-static void *Malloc(size_t size);
-static void Free(void *ptr);
-static char *StringNCopy(char *str, int strLen);
-static char *StringCopy(char *str);
-static char *StringCat(char *str1, char *str2);
-static char *StringCat4(char *str1, char *str2, char *str3, char *str4);
-static char *QueryLookup(char *query, char *name);
-static char *PathTail(char *path);
-
-typedef struct ListOfString {
- char *head;
- struct ListOfString *tail;
-} ListOfString;
-static char *ListOfString_Head(ListOfString *list);
-static ListOfString *ListOfString_Tail(ListOfString *list);
-static int ListOfString_Length(ListOfString *list);
-static int ListOfString_IsElement(ListOfString *list, char *element);
-static ListOfString *ListOfString_AppendElement(
- ListOfString *list, char *element);
-static ListOfString *ListOfString_RemoveElement(
- ListOfString *list, char *element);
-
-static int IntGetEnv(char *varName, int defaultValue);
-\f
-static void Initialize(void);
-static void PerformRequest(void);
-static void GarbageCollectStep(void);
-static void ConditionalCheckpoint(void);
-
-/*
- * A typical FastCGI main program: Initialize, then loop
- * calling FCGI_Accept and performing the accepted request.
- * Do cleanup operations incrementally between requests.
- */
-int main(void)
-{
- Initialize();
-
- while (FCGI_Accept() >= 0) {
- PerformRequest();
- FCGI_Finish();
- GarbageCollectStep();
- ConditionalCheckpoint();
- }
-
- return 0;
-}
-\f
-/*
- * All the global variables
- */
-typedef struct CartObj {
- int inactive; /* This cart not accessed since mark */
- ListOfString *items; /* Items in cart */
-} CartObj;
-static Tcl_HashTable *cartTablePtr; /* Table of CartObj, indexed by userId */
-static Tcl_HashTable cartTable;
-static char *fcgiProcessId; /* Id of this process in affinity group */
-static char *stateDir; /* Path to dir with snapshot and log */
-char *snapshotPath, *logPath; /* Paths to current snapshot and log */
-static int generation; /* Number embedded in paths, inc on ckp */
-static FILE *logFile = NULL; /* Open for append to current log file */
-static int numLogRecords; /* Number of records in current log file */
-static int checkpointThreshold; /* Do ckp when numLogRecords exceeds this */
-static int purge = TRUE; /* Cart collector is removing inactives */
-static time_t timeCartsMarked; /* Time all carts marked inactive */
-static int cartHoldSeconds; /* Begin purge when this interval elapsed */
-\f
-#define STATE_DIR_VAR "STATE_DIR"
-#define PID_VAR "FCGI_PROCESS_ID"
-#define CKP_THRESHOLD_VAR "CKP_THRESHOLD"
-#define CKP_THRESHOLD_DEFAULT 200
-#define CART_HOLD_MINUTES_VAR "CART_HOLD_MINUTES"
-#define CART_HOLD_MINUTES_DEFAULT 300
-
-#define SNP_PREFIX "snapshot"
-#define LOG_PREFIX "log"
-#define TMP_SNP_NAME "tmp-snapshot"
-
-#define LR_ADD_ITEM "Add"
-#define LR_REMOVE_ITEM "Rem"
-#define LR_EMPTY_CART "Emp"
-
-
-static char *MakePath(char *dir, char *prefix, int gen);
-static void AnalyzeStateDir(
- char *dir, char *prefix, int *largestP, ListOfString **fileListP);
-static int RecoverFile(char *pathname);
-static void Checkpoint(void);
-
-/*
- * Initialize the process by reading environment variables and files
- */
-static void Initialize(void)
-{
- ListOfString *fileList;
- int stateDirLen;
- /*
- * Process miscellaneous parameters from the initial environment.
- */
- checkpointThreshold =
- IntGetEnv(CKP_THRESHOLD_VAR, CKP_THRESHOLD_DEFAULT);
- cartHoldSeconds =
- IntGetEnv(CART_HOLD_MINUTES_VAR, CART_HOLD_MINUTES_DEFAULT)*60;
- /*
- * Create an empty in-memory shopping cart data structure.
- */
- cartTablePtr = &cartTable;
- Tcl_InitHashTable(cartTablePtr, TCL_STRING_KEYS);
- /*
- * Compute the state directory name from the initial environment
- * variables.
- */
- stateDir = getenv(STATE_DIR_VAR);
- stateDirLen = Strlen(stateDir);
- assert(stateDirLen > 0);
- if(stateDir[stateDirLen - 1] == '/') {
- stateDir[stateDirLen - 1] = '\000';
- }
- fcgiProcessId = getenv(PID_VAR);
- if(fcgiProcessId != NULL) {
- stateDir = StringCat4(stateDir, ".", fcgiProcessId, "/");
- } else {
- stateDir = StringCat(stateDir, "/");
- }
- /*
- * Read the state directory to determine the current
- * generation number and a list of files that may
- * need to be deleted (perhaps left over from an earlier
- * system crash). Recover the current generation
- * snapshot and log (either or both may be missing),
- * populating the in-memory shopping cart data structure.
- * Take a checkpoint, making the current log empty.
- */
- AnalyzeStateDir(stateDir, SNP_PREFIX, &generation, &fileList);
- snapshotPath = MakePath(stateDir, SNP_PREFIX, generation);
- RecoverFile(snapshotPath);
- logPath = MakePath(stateDir, LOG_PREFIX, generation);
- numLogRecords = RecoverFile(logPath);
- Checkpoint();
- /*
- * Clean up stateDir without removing the current snapshot and log.
- */
- while(fileList != NULL) {
- char *cur = ListOfString_Head(fileList);
- if(strcmp(snapshotPath, cur) && strcmp(logPath, cur)) {
- remove(cur);
- }
- fileList = ListOfString_RemoveElement(fileList, cur);
- }
-}
-
-static char *MakePath(char *dir, char *prefix, int gen)
-{
- char nameBuffer[24];
- sprintf(nameBuffer, "%s.%d", prefix, gen);
- return StringCat(dir, nameBuffer);
-}
-\f
-static void ConditionalCheckpoint(void)
-{
- if(numLogRecords >= checkpointThreshold) {
- Checkpoint();
- }
-}
-static void WriteSnapshot(char *snpPath);
-
-static void Checkpoint(void)
-{
- char *tempSnapshotPath, *newLogPath, *newSnapshotPath;
- /*
- * Close the current log file.
- */
- if(logFile != NULL) {
- fclose(logFile);
- }
- /*
- * Create a new snapshot with a temporary name.
- */
- tempSnapshotPath = StringCat(stateDir, TMP_SNP_NAME);
- WriteSnapshot(tempSnapshotPath);
- ++generation;
- /*
- * Ensure that the new log file doesn't already exist by removing it.
- */
- newLogPath = MakePath(stateDir, LOG_PREFIX, generation);
- remove(newLogPath);
- /*
- * Commit by renaming the snapshot. The rename atomically
- * makes the old snapshot and log obsolete.
- */
- newSnapshotPath = MakePath(stateDir, SNP_PREFIX, generation);
- rename(tempSnapshotPath, newSnapshotPath);
- /*
- * Clean up the old snapshot and log.
- */
- Free(tempSnapshotPath);
- remove(snapshotPath);
- Free(snapshotPath);
- snapshotPath = newSnapshotPath;
- remove(logPath);
- Free(logPath);
- logPath = newLogPath;
- /*
- * Open the new, empty log.
- */
- logFile = fopen(logPath, "a");
- numLogRecords = 0;
-}
-\f
-/*
- * Return *largestP = the largest int N such that the name prefix.N
- * is in the directory dir. 0 if no such name
- * *fileListP = list of all files in the directory dir,
- * excluding '.' and '..'
- */
-static void AnalyzeStateDir(
- char *dir, char *prefix, int *largestP, ListOfString **fileListP)
-{
- DIR *dp;
- struct dirent *dirp;
- int prefixLen = strlen(prefix);
- int largest = 0;
- int cur;
- char *curName;
- ListOfString *fileList = NULL;
- dp = opendir(dir);
- assert(dp != NULL);
- while((dirp = readdir(dp)) != NULL) {
- if(!strcmp(dirp->d_name, ".") || !strcmp(dirp->d_name, "..")) {
- continue;
- }
- curName = StringCat(dir, dirp->d_name);
- fileList = ListOfString_AppendElement(fileList, curName);
- if(!strncmp(dirp->d_name, prefix, prefixLen)
- && (dirp->d_name)[prefixLen] == '.') {
- cur = strtol(dirp->d_name + prefixLen + 1, NULL, 10);
- if(cur > largest) {
- largest = cur;
- }
- }
- }
- assert(closedir(dp) >= 0);
- *largestP = largest;
- *fileListP = fileList;
-}
-\f
-static int DoAddItemToCart(char *userId, char *item, int writeLog);
-static int DoRemoveItemFromCart(char *userId, char *item, int writeLog);
-static int DoEmptyCart(char *userId, int writeLog);
-
-/*
- * Read either a snapshot or a log and perform the specified
- * actions on the in-memory representation.
- */
-static int RecoverFile(char *pathname)
-{
- int numRecords;
- FILE *recoveryFile = fopen(pathname, "r");
- if(recoveryFile == NULL) {
- assert(errno == ENOENT);
- return 0;
- }
- for(numRecords = 0; ; numRecords++) {
- char buff[128];
- char op[32], userId[32], item[64];
- int count;
- char *status = fgets(buff, sizeof(buff), recoveryFile);
- if(status == NULL) {
- assert(feof(recoveryFile));
- fclose(recoveryFile);
- return numRecords;
- }
- count = sscanf(buff, "%31s %31s %63s", op, userId, item);
- assert(count == 3);
- if(!strcmp(op, LR_ADD_ITEM)) {
- assert(DoAddItemToCart(userId, item, FALSE) >= 0);
- } else if(!strcmp(op, LR_REMOVE_ITEM)) {
- assert(DoRemoveItemFromCart(userId, item, FALSE) >= 0);
- } else if(!strcmp(op, LR_EMPTY_CART)) {
- assert(DoEmptyCart(userId, FALSE) >= 0);
- } else {
- assert(FALSE);
- }
- }
-}
-\f
-static void WriteLog(char *command, char *userId, char *item, int force);
-
-/*
- * Read the in-memory representation and write a snapshot file
- * that captures it.
- */
-static void WriteSnapshot(char *snpPath)
-{
- Tcl_HashSearch search;
- Tcl_HashEntry *cartEntry;
- ListOfString *items;
- char *userId;
- logFile = fopen(snpPath, "w");
- assert(logFile != NULL);
- cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
- for(cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
- cartEntry != NULL; cartEntry = Tcl_NextHashEntry(&search)) {
- userId = Tcl_GetHashKey(cartTablePtr, cartEntry);
- for(items = ((CartObj *) Tcl_GetHashValue(cartEntry))->items;
- items != NULL; items = ListOfString_Tail(items)) {
- WriteLog(LR_ADD_ITEM, userId, ListOfString_Head(items), FALSE);
- }
- }
- fflush(logFile);
- fsync(fileno(logFile));
- fclose(logFile);
-}
-\f
-static void WriteLog(char *command, char *userId, char *item, int force)
-{
- fprintf(logFile, "%s %s %s\n", command, userId, item);
- ++numLogRecords;
- if(force) {
- fflush(logFile);
- fsync(fileno(logFile));
- }
-}
-\f
-static int RemoveOneInactiveCart(void);
-static void MarkAllCartsInactive(void);
-
-/*
- * Incremental garbage collection of inactive shopping carts:
- *
- * Each user access to a shopping cart clears its "inactive" bit via a
- * call to MarkThisCartActive. When restart creates a cart it
- * also marks the cart active.
- *
- * If purge == TRUE, each call to GarbageCollectStep scans for and removes
- * the first inactive cart found. If there are no inactive carts,
- * GarbageCollectStep marks *all* carts inactive, records the time in
- * timeCartsMarked, and sets purge = FALSE.
- *
- * If purge == FALSE, each call to GarbageCollectStep checks the
- * elapsed time since timeCartsMarked. If the elapsed time
- * exceeds a threshold, GarbageCollectStep sets purge = TRUE.
- */
-
-static void GarbageCollectStep(void)
-{
- if(purge) {
- if(!RemoveOneInactiveCart()) {
- MarkAllCartsInactive();
- timeCartsMarked = time(NULL);
- purge = FALSE;
- }
- } else {
- int diff = time(NULL)-timeCartsMarked;
- if(diff > cartHoldSeconds) {
- purge = TRUE;
- }
- }
-}
-\f
-static int RemoveOneInactiveCart(void)
-{
- Tcl_HashSearch search;
- Tcl_HashEntry *cartEntry;
- CartObj *cart;
- char *userId;
- cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
- for(cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
- cartEntry != NULL; cartEntry = Tcl_NextHashEntry(&search)) {
- cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- if(cart->inactive) {
- userId = Tcl_GetHashKey(cartTablePtr, cartEntry);
- DoEmptyCart(userId, TRUE);
- return TRUE;
- }
- }
- return FALSE;
-}
-
-static Tcl_HashEntry *GetCartEntry(char *userId);
-
-static void MarkAllCartsInactive(void)
-{
- Tcl_HashSearch search;
- Tcl_HashEntry *cartEntry;
- CartObj *cart;
- cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
- for(cartEntry = Tcl_FirstHashEntry(cartTablePtr, &search);
- cartEntry != NULL; cartEntry = Tcl_NextHashEntry(&search)) {
- cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- cart->inactive = TRUE;
- }
-}
-
-static void MarkThisCartActive(char *userId)
-{
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- CartObj *cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- cart->inactive = FALSE;
-}
-\f
-#define OP_DISPLAY_STORE "DisplayStore"
-#define OP_ADD_ITEM "AddItemToCart"
-#define OP_DISPLAY_CART "DisplayCart"
-#define OP_REMOVE_ITEM "RemoveItemFromCart"
-#define OP_PURCHASE "Purchase"
-
-static void DisplayStore(
- char *scriptName, char *parent, char *userId, char *processId);
-static void AddItemToCart(
- char *scriptName, char *parent, char *userId, char *processId,
- char *item);
-static void DisplayCart(
- char *scriptName, char *parent, char *userId, char *processId);
-static void RemoveItemFromCart(
- char *scriptName, char *parent, char *userId, char *processId,
- char *item);
-static void Purchase(
- char *scriptName, char *parent, char *userId, char *processId);
-static void InvalidRequest(char *code, char *message);
-static void Authorize(char *userId);
-
-/*
- * As a Responder, this application expects to be called with the
- * GET method and a URL of the form
- *
- * http://<host-port>/<script-name>?op=<op>&item=<item>
- *
- * The application expects the SI_UID variable to provide
- * a user ID, either authenticated or anonymous.
- *
- * The application expects the directory *containing* <script-name>
- * to contain various static HTML files related to the application.
- *
- * As an Authorizer, the application expects to be called with
- * SID_UID and URL_PATH set.
- */
-
-static void PerformRequest(void)
-{
- char *method = getenv("REQUEST_METHOD");
- char *role = getenv("FCGI_ROLE");
- char *scriptName = PathTail(getenv("SCRIPT_NAME"));
- char *parent = "";
- char *op = QueryLookup(getenv("QUERY_STRING"), "op");
- char *item = QueryLookup(getenv("QUERY_STRING"), "item");
- char *userId = getenv("SI_UID");
- if(userId == NULL) {
- InvalidRequest("405", "Incorrect configuration, no user id");
- goto done;
- } else {
- MarkThisCartActive(userId);
- }
- if(!strcmp(role, "RESPONDER")) {
- if(strcmp(method, "GET")) {
- InvalidRequest("405", "Only GET Method Allowed");
- } else if(op == NULL || !strcmp(op, OP_DISPLAY_STORE)) {
- DisplayStore(scriptName, parent, userId, fcgiProcessId);
- } else if(!strcmp(op, OP_ADD_ITEM)) {
- AddItemToCart(scriptName, parent, userId, fcgiProcessId, item);
- } else if(!strcmp(op, OP_DISPLAY_CART)) {
- DisplayCart(scriptName, parent, userId, fcgiProcessId);
- } else if(!strcmp(op, OP_REMOVE_ITEM)) {
- RemoveItemFromCart(scriptName, parent, userId, fcgiProcessId, item);
- } else if(!strcmp(op, OP_PURCHASE)) {
- Purchase(scriptName, parent, userId, fcgiProcessId);
- } else {
- InvalidRequest("404", "Invalid 'op' argument");
- }
- } else if(!strcmp(role, "AUTHORIZER")) {
- Authorize(userId);
- } else {
- InvalidRequest("404", "Invalid FastCGI Role");
- }
- done:
- Free(scriptName);
- Free(op);
- Free(item);
-}
-\f
-/*
- * Tiny database of shop inventory. The first form is the
- * item identifier used in a request, the second form is used
- * for HTML display. REQUIRED_ITEM is the item required
- * the the Authorizer. SPECIAL_ITEM is the item on the protected
- * page (must follow unprotected items in table).
- */
-
-char *ItemNames[] = {
- "BrooklynBridge",
- "RMSTitanic",
- "CometKohoutec",
- "YellowSubmarine",
- NULL
- };
-char *ItemDisplayNames[] = {
- "<i>Brooklyn Bridge</i>",
- "<i>RMS Titanic</i>",
- "<i>Comet Kohoutec</i>",
- "<i>Yellow Submarine</i>",
- NULL
- };
-#define REQUIRED_ITEM 1
-#define SPECIAL_ITEM 3
-
-
-static char *ItemDisplayName(char *item)
-{
- int i;
- if(item == NULL) {
- return NULL;
- }
- for(i = 0; ItemNames[i] != NULL; i++) {
- if(!strcmp(item, ItemNames[i])) {
- return ItemDisplayNames[i];
- }
- }
- return NULL;
-}
-\f
-static void DisplayNumberOfItems(int numberOfItems, char *processId);
-
-static void DisplayHead(char *title, char *parent, char *gif)
-{
- printf("Content-type: text/html\r\n"
- "\r\n"
- "<html>\n<head>\n<title>%s</title>\n</head>\n\n"
- "<body bgcolor=\"ffffff\" text=\"000000\" link=\"39848c\"\n"
- " vlink=\"808080\" alink=\"000000\">\n", title);
- if(parent != NULL && gif != NULL) {
- printf("<center>\n<img src=\"%s%s\" alt=\"[%s]\">\n</center>\n\n",
- parent, gif, title);
- } else {
- printf("<h2>%s</h2>\n<hr>\n\n", title);
- }
-}
-
-static void DisplayFoot(void)
-{
- printf("<hr>\n</body>\n</html>\n");
-}
-
-static void DisplayStore(
- char *scriptName, char *parent, char *userId, char *processId)
-{
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- ListOfString *items = ((CartObj *) Tcl_GetHashValue(cartEntry))->items;
- int numberOfItems = ListOfString_Length(items);
- int i;
-
- DisplayHead("FastCGI Shop!", parent, "Images/main-hd.gif");
- DisplayNumberOfItems(numberOfItems, processId);
- printf("<h3>Goods for sale:</h3>\n<ul>\n");
- for(i = 0; i < SPECIAL_ITEM; i++) {
- printf(" <li>Add the <a href=\"%s?op=AddItemToCart&item=%s\">%s</a>\n"
- " to your shopping cart.\n",
- scriptName, ItemNames[i], ItemDisplayNames[i]);
- }
- printf("</ul><p>\n\n");
- printf("If the %s is in your shopping cart,\n"
- "<a href=\"%sProtected/%s.html\">go see a special offer</a>\n"
- "available only to %s purchasers.<p>\n\n",
- ItemDisplayNames[REQUIRED_ITEM], parent,
- ItemNames[REQUIRED_ITEM], ItemDisplayNames[REQUIRED_ITEM]);
- printf("<a href=\"%sUnprotected/Purchase.html\">Purchase\n"
- "the contents of your shopping cart.</a><p>\n\n", parent);
- printf("<a href=\"%s?op=DisplayCart\">View the contents\n"
- "of your shopping cart.</a><p>\n\n", scriptName);
- DisplayFoot();
-}
-\f
-static Tcl_HashEntry *GetCartEntry(char *userId)
-{
- Tcl_HashEntry *cartEntry = Tcl_FindHashEntry(cartTablePtr, userId);
- int newCartEntry;
- if(cartEntry == NULL) {
- CartObj *cart = (CartObj *)Malloc(sizeof(CartObj));
- cart->inactive = FALSE;
- cart->items = NULL;
- cartEntry = Tcl_CreateHashEntry(cartTablePtr, userId, &newCartEntry);
- assert(newCartEntry);
- Tcl_SetHashValue(cartEntry, cart);
- }
- return cartEntry;
-}
-\f
-static void AddItemToCart(
- char *scriptName, char *parent, char *userId, char *processId,
- char *item)
-{
- if(DoAddItemToCart(userId, item, TRUE) < 0) {
- InvalidRequest("404", "Invalid 'item' argument");
- } else {
- /*
- * Would call
- * DisplayStore(scriptName, parent, userId, processId);
- * except for browser reload issue. Redirect instead.
- */
- printf("Location: %s?op=%s\r\n"
- "\r\n", scriptName, OP_DISPLAY_STORE);
- }
-}
-
-static int DoAddItemToCart(char *userId, char *item, int writeLog)
-{
- if(ItemDisplayName(item) == NULL) {
- return -1;
- } else {
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- CartObj *cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- cart->items = ListOfString_AppendElement(
- cart->items, StringCopy(item));
- if(writeLog) {
- WriteLog(LR_ADD_ITEM, userId, item, TRUE);
- }
- }
- return 0;
-}
-\f
-static void DisplayCart(
- char *scriptName, char *parent, char *userId, char *processId)
-{
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- CartObj *cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- ListOfString *items = cart->items;
- int numberOfItems = ListOfString_Length(items);
-
- DisplayHead("Your shopping cart", parent, "Images/cart-hd.gif");
- DisplayNumberOfItems(numberOfItems, processId);
- printf("<ul>\n");
- for(; items != NULL; items = ListOfString_Tail(items)) {
- char *item = ListOfString_Head(items);
- printf(" <li>%s . . . . . \n"
- " <a href=\"%s?op=RemoveItemFromCart&item=%s\">Click\n"
- " to remove</a> from your shopping cart.\n",
- ItemDisplayName(item), scriptName, item);
- }
- printf("</ul><p>\n\n");
- printf("<a href=\"%sUnprotected/Purchase.html\">Purchase\n"
- "the contents of your shopping cart.</a><p>\n\n", parent);
- printf("<a href=\"%s?op=DisplayStore\">Return to shop.</a><p>\n\n",
- scriptName);
- DisplayFoot();
-}
-\f
-static void RemoveItemFromCart(
- char *scriptName, char *parent, char *userId, char *processId,
- char *item)
-{
- if(DoRemoveItemFromCart(userId, item, TRUE) < 0) {
- InvalidRequest("404", "Invalid 'item' argument");
- } else {
- /*
- * Would call
- * DisplayCart(scriptName, parent, userId, processId);
- * except for browser reload issue. Redirect instead.
- */
- printf("Location: %s?op=%s\r\n"
- "\r\n", scriptName, OP_DISPLAY_CART);
- }
-}
-
-static int DoRemoveItemFromCart(char *userId, char *item, int writeLog)
-{
- if(ItemDisplayName(item) == NULL) {
- return -1;
- } else {
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- CartObj *cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- if(ListOfString_IsElement(cart->items, item)) {
- cart->items = ListOfString_RemoveElement(cart->items, item);
- if (writeLog) {
- WriteLog(LR_REMOVE_ITEM, userId, item, TRUE);
- }
- }
- }
- return 0;
-}
-\f
-static void Purchase(
- char *scriptName, char *parent, char *userId, char *processId)
-{
- DoEmptyCart(userId, TRUE);
- printf("Location: %sUnprotected/ThankYou.html\r\n"
- "\r\n", parent);
-}
-
-static int DoEmptyCart(char *userId, int writeLog)
-{
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- CartObj *cart = (CartObj *)Tcl_GetHashValue(cartEntry);
- ListOfString *items = cart->items;
- /*
- * Write log *before* tearing down cart structure because userId
- * is part of the structure. (Thanks, Purify.)
- */
- if (writeLog) {
- WriteLog(LR_EMPTY_CART, userId, "NullItem", TRUE);
- }
- while(items != NULL) {
- items = ListOfString_RemoveElement(
- items, ListOfString_Head(items));
- }
- Free(cart);
- Tcl_DeleteHashEntry(cartEntry);
- return 0;
-}
-\f
-static void NotAuthorized(void);
-
-static void Authorize(char *userId)
-{
- Tcl_HashEntry *cartEntry = GetCartEntry(userId);
- ListOfString *items = ((CartObj *) Tcl_GetHashValue(cartEntry))->items;
- for( ; items != NULL; items = ListOfString_Tail(items)) {
- if(!strcmp(ListOfString_Head(items), ItemNames[REQUIRED_ITEM])) {
- printf("Status: 200 OK\r\n"
- "Variable-Foo: Bar\r\n"
- "\r\n");
- return;
- }
- }
- NotAuthorized();
-}
-\f
-static void DisplayNumberOfItems(int numberOfItems, char *processId)
-{
- if(processId != NULL) {
- printf("FastCGI process %s is serving you today.<br>\n", processId);
- }
- if(numberOfItems == 0) {
- printf("Your shopping cart is empty.<p>\n\n");
- } else if(numberOfItems == 1) {
- printf("Your shopping cart contains 1 item.<p>\n\n");
- } else {
- printf("Your shopping cart contains %d items.<p>\n\n", numberOfItems);
- };
-}
-\f
-static void InvalidRequest(char *code, char *message)
-{
- printf("Status: %s %s\r\n", code, message);
- DisplayHead("Invalid request", NULL, NULL);
- printf("%s.\n\n", message);
- DisplayFoot();
-}
-
-static void NotAuthorized(void)
-{
- printf("Status: 403 Forbidden\r\n");
- DisplayHead("Access Denied", NULL, NULL);
- printf("Put the %s in your cart to access this page.\n\n",
- ItemDisplayNames[REQUIRED_ITEM]);
- DisplayFoot();
-}
-\f
-/*
- * Mundane utility functions, not specific to this application:
- */
-
-
-/*
- * Fail-fast version of 'malloc'
- */
-static void *Malloc(size_t size)
-{
- void *result = malloc(size);
- assert(size == 0 || result != NULL);
- return result;
-}
-
-/*
- * Protect against old, broken implementations of 'free'
- */
-static void Free(void *ptr)
-{
- if(ptr != NULL) {
- free(ptr);
- }
-}
-
-/*
- * Return a new string created by calling Malloc, copying strLen
- * characters from str to the new string, then appending a null.
- */
-static char *StringNCopy(char *str, int strLen)
-{
- char *newString = (char *)Malloc(strLen + 1);
- memcpy(newString, str, strLen);
- newString[strLen] = '\000';
- return newString;
-}
-
-/*
- * Return a new string that's a copy of str, including the null
- */
-static char *StringCopy(char *str)
-{
- return StringNCopy(str, strlen(str));
-}
-
-/*
- * Return a new string that's a copy of str1 followed by str2,
- * including the null
- */
-static char *StringCat(char *str1, char *str2)
-{
- return StringCat4(str1, str2, NULL, NULL);
-}
-
-static char *StringCat4(char *str1, char *str2, char *str3, char *str4)
-{
- int str1Len = Strlen(str1);
- int str2Len = Strlen(str2);
- int str3Len = Strlen(str3);
- int str4Len = Strlen(str4);
- char *newString = (char *)Malloc(str1Len + str2Len + str3Len + str4Len + 1);
- memcpy(newString, str1, str1Len);
- memcpy(newString + str1Len, str2, str2Len);
- memcpy(newString + str1Len + str2Len, str3, str3Len);
- memcpy(newString + str1Len + str2Len + str3Len, str4, str4Len);
- newString[str1Len + str2Len + str3Len + str4Len] = '\000';
- return newString;
-}
-
-/*
- * Return a copy of the value associated with 'name' in 'query'.
- * XXX: does not perform URL-decoding of query.
- */
-static char *QueryLookup(char *query, char *name)
-{
- int nameLen = strlen(name);
- char *queryTail, *nameFirst, *valueFirst, *valueLast;
-
- if(query == NULL) {
- return NULL;
- }
- queryTail = query;
- for(;;) {
- nameFirst = strstr(queryTail, name);
- if(nameFirst == NULL) {
- return NULL;
- }
- if(((nameFirst == query) || (nameFirst[-1] == '&')) &&
- (nameFirst[nameLen] == '=')) {
- valueFirst = nameFirst + nameLen + 1;
- valueLast = strchr(valueFirst, '&');
- if(valueLast == NULL) {
- valueLast = strchr(valueFirst, '\000');
- };
- return StringNCopy(valueFirst, valueLast - valueFirst);
- }
- queryTail = nameFirst + 1;
- }
-}
-
-/*
- * Return a copy of the characters following the final '/' character
- * of path.
- */
-static char *PathTail(char *path)
-{
- char *afterSlash, *slash;
- if(path == NULL) {
- return NULL;
- }
- afterSlash = path;
- while((slash = strchr(afterSlash, '/')) != NULL) {
- afterSlash = slash + 1;
- }
- return StringCopy(afterSlash);
-}
-
-/*
- * Return the integer value of the specified environment variable,
- * or a specified default value if the variable is unbound.
- */
-static int IntGetEnv(char *varName, int defaultValue)
-{
- char *strValue = getenv(varName);
- int value = 0;
- if(strValue != NULL) {
- value = strtol(strValue, NULL, 10);
- }
- if(value <= 0) {
- value = defaultValue;
- }
- return value;
-}
-
-/*
- * ListOfString abstraction
- */
-
-static char *ListOfString_Head(ListOfString *list)
-{
- return list->head;
-}
-
-static ListOfString *ListOfString_Tail(ListOfString *list)
-{
- return list->tail;
-}
-
-static int ListOfString_Length(ListOfString *list)
-{
- int length = 0;
- for(; list != NULL; list = list->tail) {
- length++;
- }
- return length;
-}
-
-static int ListOfString_IsElement(ListOfString *list, char *element)
-{
- for(; list != NULL; list = list->tail) {
- if(!strcmp(list->head, element)) {
- return TRUE;
- }
- }
- return FALSE;
-}
-
-static ListOfString *ListOfString_AppendElement(
- ListOfString *list, char *element)
-{
- ListOfString *cur;
- ListOfString *newCell = (ListOfString *)Malloc(sizeof(ListOfString));
- newCell->head = element;
- newCell->tail = NULL;
- if(list == NULL) {
- return newCell;
- } else {
- for(cur = list; cur->tail != NULL; cur = cur->tail) {
- }
- cur->tail = newCell;
- return list;
- }
-}
-
-static ListOfString *ListOfString_RemoveElement(
- ListOfString *list, char *element)
-{
- ListOfString *cur;
- ListOfString *prevCell = NULL;
- for(cur = list; cur != NULL; cur = cur->tail) {
- if(!strcmp(cur->head, element)) {
- if(prevCell == NULL) {
- list = cur->tail;
- } else {
- prevCell->tail = cur->tail;
- }
- free(cur->head);
- free(cur);
- return list;
- }
- prevCell = cur;
- }
- return list;
-}
-
-
-/*
- * End
- */
+++ /dev/null
-/*
- * tcl.h --
- *
- * This header file describes the externally-visible facilities
- * of the Tcl interpreter.
- *
- * Copyright (c) 1987-1994 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
- *
- * This software is copyrighted by the Regents of the University of
- * California, Sun Microsystems, Inc., and other parties. The following
- * terms apply to all files associated with the software unless explicitly
- * disclaimed in individual files.
- *
- * The authors hereby grant permission to use, copy, modify, distribute,
- * and license this software and its documentation for any purpose, provided
- * that existing copyright notices are retained in all copies and that this
- * notice is included verbatim in any distributions. No written agreement,
- * license, or royalty fee is required for any of the authorized uses.
- * Modifications to this software may be copyrighted by their authors
- * and need not follow the licensing terms described here, provided that
- * the new terms are clearly indicated on the first page of each file where
- * they apply.
- *
- * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
- * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
- * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
- * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- *
- * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
- * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
- * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
- * MODIFICATIONS.
- *
- * RESTRICTED RIGHTS: Use, duplication or disclosure by the government
- * is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
- * of the Rights in Technical Data and Computer Software Clause as DFARS
- * 252.227-7013 and FAR 52.227-19.
- *
- * $Id: tcl.h,v 1.1 1999/07/28 01:11:46 roberts Exp $
- *
- * @(#) tcl.h 1.153 95/06/27 15:42:31
- */
-
-#ifndef _TCL
-#define _TCL
-
-#ifndef BUFSIZ
-#include <stdio.h>
-#endif
-
-#define TCL_VERSION "7.4"
-#define TCL_MAJOR_VERSION 7
-#define TCL_MINOR_VERSION 4
-
-/*
- * Definitions that allow this header file to be used either with or
- * without ANSI C features like function prototypes.
- */
-
-#undef _ANSI_ARGS_
-#undef CONST
-#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus)
-# define _USING_PROTOTYPES_ 1
-# define _ANSI_ARGS_(x) x
-# define CONST const
-# ifdef __cplusplus
-# define VARARGS(first) (first, ...)
-# else
-# define VARARGS(first) ()
-# endif
-#else
-# define _ANSI_ARGS_(x) ()
-# define CONST
-#endif
-
-#ifdef __cplusplus
-# define EXTERN extern "C"
-#else
-# define EXTERN extern
-#endif
-
-/*
- * Macro to use instead of "void" for arguments that must have
- * type "void *" in ANSI C; maps them to type "char *" in
- * non-ANSI systems.
- */
-
-#ifndef VOID
-# ifdef __STDC__
-# define VOID void
-# else
-# define VOID char
-# endif
-#endif
-
-/*
- * Miscellaneous declarations (to allow Tcl to be used stand-alone,
- * without the rest of Sprite).
- */
-
-#ifndef NULL
-#define NULL 0
-#endif
-
-#ifndef _CLIENTDATA
-# if defined(__STDC__) || defined(__cplusplus)
- typedef void *ClientData;
-# else
- typedef int *ClientData;
-# endif /* __STDC__ */
-#define _CLIENTDATA
-#endif
-
-/*
- * Data structures defined opaquely in this module. The definitions
- * below just provide dummy types. A few fields are made visible in
- * Tcl_Interp structures, namely those for returning string values.
- * Note: any change to the Tcl_Interp definition below must be mirrored
- * in the "real" definition in tclInt.h.
- */
-
-typedef struct Tcl_Interp{
- char *result; /* Points to result string returned by last
- * command. */
- void (*freeProc) _ANSI_ARGS_((char *blockPtr));
- /* Zero means result is statically allocated.
- * If non-zero, gives address of procedure
- * to invoke to free the result. Must be
- * freed by Tcl_Eval before executing next
- * command. */
- int errorLine; /* When TCL_ERROR is returned, this gives
- * the line number within the command where
- * the error occurred (1 means first line). */
-} Tcl_Interp;
-
-typedef int *Tcl_Trace;
-typedef int *Tcl_Command;
-typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
-typedef struct Tcl_RegExp_ *Tcl_RegExp;
-
-/*
- * When a TCL command returns, the string pointer interp->result points to
- * a string containing return information from the command. In addition,
- * the command procedure returns an integer value, which is one of the
- * following:
- *
- * TCL_OK Command completed normally; interp->result contains
- * the command's result.
- * TCL_ERROR The command couldn't be completed successfully;
- * interp->result describes what went wrong.
- * TCL_RETURN The command requests that the current procedure
- * return; interp->result contains the procedure's
- * return value.
- * TCL_BREAK The command requests that the innermost loop
- * be exited; interp->result is meaningless.
- * TCL_CONTINUE Go on to the next iteration of the current loop;
- * interp->result is meaningless.
- */
-
-#define TCL_OK 0
-#define TCL_ERROR 1
-#define TCL_RETURN 2
-#define TCL_BREAK 3
-#define TCL_CONTINUE 4
-
-#define TCL_RESULT_SIZE 200
-
-/*
- * Argument descriptors for math function callbacks in expressions:
- */
-
-typedef enum {TCL_INT, TCL_DOUBLE, TCL_EITHER} Tcl_ValueType;
-typedef struct Tcl_Value {
- Tcl_ValueType type; /* Indicates intValue or doubleValue is
- * valid, or both. */
- long intValue; /* Integer value. */
- double doubleValue; /* Double-precision floating value. */
-} Tcl_Value;
-
-/*
- * Procedure types defined by Tcl:
- */
-
-typedef int (Tcl_AppInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef int (Tcl_AsyncProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int code));
-typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData));
-typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char *argv[]));
-typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc,
- ClientData cmdClientData, int argc, char *argv[]));
-typedef void (Tcl_FreeProc) _ANSI_ARGS_((char *blockPtr));
-typedef void (Tcl_InterpDeleteProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp));
-typedef int (Tcl_MathProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr));
-typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *part1, char *part2, int flags));
-
-/*
- * The structure returned by Tcl_GetCmdInfo and passed into
- * Tcl_SetCmdInfo:
- */
-
-typedef struct Tcl_CmdInfo {
- Tcl_CmdProc *proc; /* Procedure that implements command. */
- ClientData clientData; /* ClientData passed to proc. */
- Tcl_CmdDeleteProc *deleteProc; /* Procedure to call when command
- * is deleted. */
- ClientData deleteData; /* Value to pass to deleteProc (usually
- * the same as clientData). */
-} Tcl_CmdInfo;
-
-/*
- * The structure defined below is used to hold dynamic strings. The only
- * field that clients should use is the string field, and they should
- * never modify it.
- */
-
-#define TCL_DSTRING_STATIC_SIZE 200
-typedef struct Tcl_DString {
- char *string; /* Points to beginning of string: either
- * staticSpace below or a malloc'ed array. */
- int length; /* Number of non-NULL characters in the
- * string. */
- int spaceAvl; /* Total number of bytes available for the
- * string and its terminating NULL char. */
- char staticSpace[TCL_DSTRING_STATIC_SIZE];
- /* Space to use in common case where string
- * is small. */
-} Tcl_DString;
-
-#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
-#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
-#define Tcl_DStringTrunc Tcl_DStringSetLength
-
-/*
- * Definitions for the maximum number of digits of precision that may
- * be specified in the "tcl_precision" variable, and the number of
- * characters of buffer space required by Tcl_PrintDouble.
- */
-
-#define TCL_MAX_PREC 17
-#define TCL_DOUBLE_SPACE (TCL_MAX_PREC+10)
-
-/*
- * Flag that may be passed to Tcl_ConvertElement to force it not to
- * output braces (careful! if you change this flag be sure to change
- * the definitions at the front of tclUtil.c).
- */
-
-#define TCL_DONT_USE_BRACES 1
-
-/*
- * Flag values passed to Tcl_RecordAndEval.
- * WARNING: these bit choices must not conflict with the bit choices
- * for evalFlag bits in tclInt.h!!
- */
-
-#define TCL_NO_EVAL 0x10000
-#define TCL_EVAL_GLOBAL 0x20000
-
-/*
- * Special freeProc values that may be passed to Tcl_SetResult (see
- * the man page for details):
- */
-
-#define TCL_VOLATILE ((Tcl_FreeProc *) 1)
-#define TCL_STATIC ((Tcl_FreeProc *) 0)
-#define TCL_DYNAMIC ((Tcl_FreeProc *) 3)
-
-/*
- * Flag values passed to variable-related procedures.
- */
-
-#define TCL_GLOBAL_ONLY 1
-#define TCL_APPEND_VALUE 2
-#define TCL_LIST_ELEMENT 4
-#define TCL_TRACE_READS 0x10
-#define TCL_TRACE_WRITES 0x20
-#define TCL_TRACE_UNSETS 0x40
-#define TCL_TRACE_DESTROYED 0x80
-#define TCL_INTERP_DESTROYED 0x100
-#define TCL_LEAVE_ERR_MSG 0x200
-
-/*
- * Types for linked variables:
- */
-
-#define TCL_LINK_INT 1
-#define TCL_LINK_DOUBLE 2
-#define TCL_LINK_BOOLEAN 3
-#define TCL_LINK_STRING 4
-#define TCL_LINK_READ_ONLY 0x80
-
-/*
- * Permission flags for files:
- */
-
-#define TCL_FILE_READABLE 1
-#define TCL_FILE_WRITABLE 2
-
-/*
- * The following declarations either map ckalloc and ckfree to
- * malloc and free, or they map them to procedures with all sorts
- * of debugging hooks defined in tclCkalloc.c.
- */
-
-#ifdef TCL_MEM_DEBUG
-
-EXTERN char * Tcl_DbCkalloc _ANSI_ARGS_((unsigned int size,
- char *file, int line));
-EXTERN int Tcl_DbCkfree _ANSI_ARGS_((char *ptr,
- char *file, int line));
-EXTERN char * Tcl_DbCkrealloc _ANSI_ARGS_((char *ptr,
- unsigned int size, char *file, int line));
-EXTERN int Tcl_DumpActiveMemory _ANSI_ARGS_((char *fileName));
-EXTERN void Tcl_ValidateAllMemory _ANSI_ARGS_((char *file,
- int line));
-# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
-# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
-# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
-
-#else
-
-# define ckalloc(x) malloc(x)
-# define ckfree(x) free(x)
-# define ckrealloc(x,y) realloc(x,y)
-# define Tcl_DumpActiveMemory(x)
-# define Tcl_ValidateAllMemory(x,y)
-
-#endif /* TCL_MEM_DEBUG */
-
-/*
- * Macro to free up result of interpreter.
- */
-
-#define Tcl_FreeResult(interp) \
- if ((interp)->freeProc != 0) { \
- if ((interp)->freeProc == (Tcl_FreeProc *) free) { \
- ckfree((interp)->result); \
- } else { \
- (*(interp)->freeProc)((interp)->result); \
- } \
- (interp)->freeProc = 0; \
- }
-
-/*
- * Forward declaration of Tcl_HashTable. Needed by some C++ compilers
- * to prevent errors when the forward reference to Tcl_HashTable is
- * encountered in the Tcl_HashEntry structure.
- */
-
-#ifdef __cplusplus
-struct Tcl_HashTable;
-#endif
-
-/*
- * Structure definition for an entry in a hash table. No-one outside
- * Tcl should access any of these fields directly; use the macros
- * defined below.
- */
-
-typedef struct Tcl_HashEntry {
- struct Tcl_HashEntry *nextPtr; /* Pointer to next entry in this
- * hash bucket, or NULL for end of
- * chain. */
- struct Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
- struct Tcl_HashEntry **bucketPtr; /* Pointer to bucket that points to
- * first entry in this entry's chain:
- * used for deleting the entry. */
- ClientData clientData; /* Application stores something here
- * with Tcl_SetHashValue. */
- union { /* Key has one of these forms: */
- char *oneWordValue; /* One-word value for key. */
- int words[1]; /* Multiple integer words for key.
- * The actual size will be as large
- * as necessary for this table's
- * keys. */
- char string[4]; /* String for key. The actual size
- * will be as large as needed to hold
- * the key. */
- } key; /* MUST BE LAST FIELD IN RECORD!! */
-} Tcl_HashEntry;
-
-/*
- * Structure definition for a hash table. Must be in tcl.h so clients
- * can allocate space for these structures, but clients should never
- * access any fields in this structure.
- */
-
-#define TCL_SMALL_HASH_TABLE 4
-typedef struct Tcl_HashTable {
- Tcl_HashEntry **buckets; /* Pointer to bucket array. Each
- * element points to first entry in
- * bucket's hash chain, or NULL. */
- Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE];
- /* Bucket array used for small tables
- * (to avoid mallocs and frees). */
- int numBuckets; /* Total number of buckets allocated
- * at **bucketPtr. */
- int numEntries; /* Total number of entries present
- * in table. */
- int rebuildSize; /* Enlarge table when numEntries gets
- * to be this large. */
- int downShift; /* Shift count used in hashing
- * function. Designed to use high-
- * order bits of randomized keys. */
- int mask; /* Mask value used in hashing
- * function. */
- int keyType; /* Type of keys used in this table.
- * It's either TCL_STRING_KEYS,
- * TCL_ONE_WORD_KEYS, or an integer
- * giving the number of ints in a
- */
- Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
- char *key));
- Tcl_HashEntry *(*createProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
- char *key, int *newPtr));
-} Tcl_HashTable;
-
-/*
- * Structure definition for information used to keep track of searches
- * through hash tables:
- */
-
-typedef struct Tcl_HashSearch {
- Tcl_HashTable *tablePtr; /* Table being searched. */
- int nextIndex; /* Index of next bucket to be
- * enumerated after present one. */
- Tcl_HashEntry *nextEntryPtr; /* Next entry to be enumerated in the
- * the current bucket. */
-} Tcl_HashSearch;
-
-/*
- * Acceptable key types for hash tables:
- */
-
-#define TCL_STRING_KEYS 0
-#define TCL_ONE_WORD_KEYS 1
-
-/*
- * Macros for clients to use to access fields of hash entries:
- */
-
-#define Tcl_GetHashValue(h) ((h)->clientData)
-#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
-#define Tcl_GetHashKey(tablePtr, h) \
- ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
- : (h)->key.string))
-
-/*
- * Macros to use for clients to use to invoke find and create procedures
- * for hash tables:
- */
-
-#define Tcl_FindHashEntry(tablePtr, key) \
- (*((tablePtr)->findProc))(tablePtr, key)
-#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
- (*((tablePtr)->createProc))(tablePtr, key, newPtr)
-
-/*
- * Exported Tcl variables:
- */
-
-EXTERN int tcl_AsyncReady;
-EXTERN void (*tcl_FileCloseProc) _ANSI_ARGS_((FILE *f));
-EXTERN char * tcl_RcFileName;
-
-/*
- * Exported Tcl procedures:
- */
-
-EXTERN void Tcl_AddErrorInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *message));
-EXTERN void Tcl_AllowExceptions _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_AppendElement _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN void Tcl_AppendResult _ANSI_ARGS_(
- VARARGS(Tcl_Interp *interp));
-EXTERN int Tcl_AppInit _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_AsyncMark _ANSI_ARGS_((Tcl_AsyncHandler async));
-EXTERN Tcl_AsyncHandler Tcl_AsyncCreate _ANSI_ARGS_((Tcl_AsyncProc *proc,
- ClientData clientData));
-EXTERN void Tcl_AsyncDelete _ANSI_ARGS_((Tcl_AsyncHandler async));
-EXTERN int Tcl_AsyncInvoke _ANSI_ARGS_((Tcl_Interp *interp,
- int code));
-EXTERN char Tcl_Backslash _ANSI_ARGS_((char *src,
- int *readPtr));
-EXTERN void Tcl_CallWhenDeleted _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_InterpDeleteProc *proc,
- ClientData clientData));
-EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char *cmd));
-EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, char **argv));
-EXTERN int Tcl_ConvertElement _ANSI_ARGS_((char *src,
- char *dst, int flags));
-EXTERN Tcl_Command Tcl_CreateCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, Tcl_CmdProc *proc,
- ClientData clientData,
- Tcl_CmdDeleteProc *deleteProc));
-EXTERN Tcl_Interp * Tcl_CreateInterp _ANSI_ARGS_((void));
-EXTERN void Tcl_CreateMathFunc _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, int numArgs, Tcl_ValueType *argTypes,
- Tcl_MathProc *proc, ClientData clientData));
-EXTERN int Tcl_CreatePipeline _ANSI_ARGS_((Tcl_Interp *interp,
- int argc, char **argv, int **pidArrayPtr,
- int *inPipePtr, int *outPipePtr,
- int *errFilePtr));
-EXTERN Tcl_Trace Tcl_CreateTrace _ANSI_ARGS_((Tcl_Interp *interp,
- int level, Tcl_CmdTraceProc *proc,
- ClientData clientData));
-EXTERN int Tcl_DeleteCommand _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName));
-EXTERN void Tcl_DeleteHashEntry _ANSI_ARGS_((
- Tcl_HashEntry *entryPtr));
-EXTERN void Tcl_DeleteHashTable _ANSI_ARGS_((
- Tcl_HashTable *tablePtr));
-EXTERN void Tcl_DeleteInterp _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_DeleteTrace _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Trace trace));
-EXTERN void Tcl_DetachPids _ANSI_ARGS_((int numPids, int *pidPtr));
-EXTERN void Tcl_DontCallWhenDeleted _ANSI_ARGS_((
- Tcl_Interp *interp, Tcl_InterpDeleteProc *proc,
- ClientData clientData));
-EXTERN char * Tcl_DStringAppend _ANSI_ARGS_((Tcl_DString *dsPtr,
- char *string, int length));
-EXTERN char * Tcl_DStringAppendElement _ANSI_ARGS_((
- Tcl_DString *dsPtr, char *string));
-EXTERN void Tcl_DStringEndSublist _ANSI_ARGS_((Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringFree _ANSI_ARGS_((Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringGetResult _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringInit _ANSI_ARGS_((Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringResult _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_DString *dsPtr));
-EXTERN void Tcl_DStringSetLength _ANSI_ARGS_((Tcl_DString *dsPtr,
- int length));
-EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_((
- Tcl_DString *dsPtr));
-EXTERN void Tcl_EnterFile _ANSI_ARGS_((Tcl_Interp *interp,
- FILE *file, int permissions));
-EXTERN char * Tcl_ErrnoId _ANSI_ARGS_((void));
-EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp *interp, char *cmd));
-EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp *interp,
- char *fileName));
-EXTERN int Tcl_ExprBoolean _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *ptr));
-EXTERN int Tcl_ExprDouble _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, double *ptr));
-EXTERN int Tcl_ExprLong _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, long *ptr));
-EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN int Tcl_FilePermissions _ANSI_ARGS_((FILE *file));
-EXTERN Tcl_HashEntry * Tcl_FirstHashEntry _ANSI_ARGS_((
- Tcl_HashTable *tablePtr,
- Tcl_HashSearch *searchPtr));
-EXTERN int Tcl_GetBoolean _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *boolPtr));
-EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, Tcl_CmdInfo *infoPtr));
-EXTERN char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_Command command));
-EXTERN int Tcl_GetDouble _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, double *doublePtr));
-EXTERN int Tcl_GetInt _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *intPtr));
-EXTERN int Tcl_GetOpenFile _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int write, int checkUsage,
- FILE **filePtr));
-EXTERN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags));
-EXTERN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags));
-EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp *interp,
- char *command));
-EXTERN char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable *tablePtr));
-EXTERN int Tcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_InitHashTable _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- int keyType));
-EXTERN void Tcl_InitMemory _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, char *addr, int type));
-EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
- Tcl_AppInitProc *appInitProc));
-EXTERN char * Tcl_Merge _ANSI_ARGS_((int argc, char **argv));
-EXTERN Tcl_HashEntry * Tcl_NextHashEntry _ANSI_ARGS_((
- Tcl_HashSearch *searchPtr));
-EXTERN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char **termPtr));
-EXTERN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp *interp));
-EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp *interp,
- double value, char *dst));
-EXTERN void Tcl_ReapDetachedProcs _ANSI_ARGS_((void));
-EXTERN int Tcl_RecordAndEval _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmd, int flags));
-EXTERN Tcl_RegExp Tcl_RegExpCompile _ANSI_ARGS_((Tcl_Interp *interp,
- char *string));
-EXTERN int Tcl_RegExpExec _ANSI_ARGS_((Tcl_Interp *interp,
- Tcl_RegExp regexp, char *string, char *start));
-EXTERN int Tcl_RegExpMatch _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char *pattern));
-EXTERN void Tcl_RegExpRange _ANSI_ARGS_((Tcl_RegExp regexp,
- int index, char **startPtr, char **endPtr));
-EXTERN void Tcl_ResetResult _ANSI_ARGS_((Tcl_Interp *interp));
-#define Tcl_Return Tcl_SetResult
-EXTERN int Tcl_ScanElement _ANSI_ARGS_((char *string,
- int *flagPtr));
-EXTERN int Tcl_SetCommandInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *cmdName, Tcl_CmdInfo *infoPtr));
-EXTERN void Tcl_SetErrorCode _ANSI_ARGS_(
- VARARGS(Tcl_Interp *interp));
-EXTERN int Tcl_SetRecursionLimit _ANSI_ARGS_((Tcl_Interp *interp,
- int depth));
-EXTERN void Tcl_SetResult _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, Tcl_FreeProc *freeProc));
-EXTERN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, char *newValue, int flags));
-EXTERN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, char *newValue,
- int flags));
-EXTERN char * Tcl_SignalId _ANSI_ARGS_((int sig));
-EXTERN char * Tcl_SignalMsg _ANSI_ARGS_((int sig));
-EXTERN int Tcl_SplitList _ANSI_ARGS_((Tcl_Interp *interp,
- char *list, int *argcPtr, char ***argvPtr));
-EXTERN int Tcl_StringMatch _ANSI_ARGS_((char *string,
- char *pattern));
-EXTERN char * Tcl_TildeSubst _ANSI_ARGS_((Tcl_Interp *interp,
- char *name, Tcl_DString *bufferPtr));
-EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags, Tcl_VarTraceProc *proc,
- ClientData clientData));
-EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags,
- Tcl_VarTraceProc *proc, ClientData clientData));
-EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName));
-EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags));
-EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags));
-EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags, Tcl_VarTraceProc *proc,
- ClientData clientData));
-EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags,
- Tcl_VarTraceProc *proc, ClientData clientData));
-EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp *interp,
- char *frameName, char *varName,
- char *localName, int flags));
-EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *frameName, char *part1, char *part2,
- char *localName, int flags));
-EXTERN int Tcl_VarEval _ANSI_ARGS_(VARARGS(Tcl_Interp *interp));
-EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp *interp,
- char *varName, int flags,
- Tcl_VarTraceProc *procPtr,
- ClientData prevClientData));
-EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp *interp,
- char *part1, char *part2, int flags,
- Tcl_VarTraceProc *procPtr,
- ClientData prevClientData));
-
-#endif /* _TCL */
+++ /dev/null
-/*
- * tclHash.c --
- *
- * Implementation of in-memory hash tables for Tcl and Tcl-based
- * applications.
- *
- * Copyright (c) 1991-1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * This software is copyrighted by the Regents of the University of
- * California, Sun Microsystems, Inc., and other parties. The following
- * terms apply to all files associated with the software unless explicitly
- * disclaimed in individual files.
- *
- * The authors hereby grant permission to use, copy, modify, distribute,
- * and license this software and its documentation for any purpose, provided
- * that existing copyright notices are retained in all copies and that this
- * notice is included verbatim in any distributions. No written agreement,
- * license, or royalty fee is required for any of the authorized uses.
- * Modifications to this software may be copyrighted by their authors
- * and need not follow the licensing terms described here, provided that
- * the new terms are clearly indicated on the first page of each file where
- * they apply.
- *
- * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
- * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
- * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
- * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- *
- * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
- * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
- * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
- * MODIFICATIONS.
- *
- * RESTRICTED RIGHTS: Use, duplication or disclosure by the government
- * is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
- * of the Rights in Technical Data and Computer Software Clause as DFARS
- * 252.227-7013 and FAR 52.227-19.
- *
- * $Id: tclHash.c,v 1.1 1999/07/28 01:11:47 roberts Exp $
- *
- */
-
-#ifndef lint
-static const char rcsid[] = "$Id: tclHash.c,v 1.1 1999/07/28 01:11:47 roberts Exp $";
-#endif /* not lint */
-
-#include "tclInt.h"
-
-/*
- * When there are this many entries per bucket, on average, rebuild
- * the hash table to make it larger.
- */
-
-#define REBUILD_MULTIPLIER 3
-
-
-/*
- * The following macro takes a preliminary integer hash value and
- * produces an index into a hash tables bucket list. The idea is
- * to make it so that preliminary values that are arbitrarily similar
- * will end up in different buckets. The hash function was taken
- * from a random-number generator.
- */
-
-#define RANDOM_INDEX(tablePtr, i) \
- (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
-
-/*
- * Procedure prototypes for static procedures in this file:
- */
-
-static Tcl_HashEntry * ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key));
-static Tcl_HashEntry * ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key, int *newPtr));
-static Tcl_HashEntry * BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key));
-static Tcl_HashEntry * BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key, int *newPtr));
-static unsigned int HashString _ANSI_ARGS_((char *string));
-static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
-static Tcl_HashEntry * StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key));
-static Tcl_HashEntry * StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key, int *newPtr));
-static Tcl_HashEntry * OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key));
-static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
- char *key, int *newPtr));
-\f
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitHashTable --
- *
- * Given storage for a hash table, set up the fields to prepare
- * the hash table for use.
- *
- * Results:
- * None.
- *
- * Side effects:
- * TablePtr is now ready to be passed to Tcl_FindHashEntry and
- * Tcl_CreateHashEntry.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_InitHashTable(register Tcl_HashTable *tablePtr, int keyType)
-{
- tablePtr->buckets = tablePtr->staticBuckets;
- tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
- tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
- tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
- tablePtr->numEntries = 0;
- tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
- tablePtr->downShift = 28;
- tablePtr->mask = 3;
- tablePtr->keyType = keyType;
- if (keyType == TCL_STRING_KEYS) {
- tablePtr->findProc = StringFind;
- tablePtr->createProc = StringCreate;
- } else if (keyType == TCL_ONE_WORD_KEYS) {
- tablePtr->findProc = OneWordFind;
- tablePtr->createProc = OneWordCreate;
- } else {
- tablePtr->findProc = ArrayFind;
- tablePtr->createProc = ArrayCreate;
- };
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteHashEntry --
- *
- * Remove a single entry from a hash table.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The entry given by entryPtr is deleted from its table and
- * should never again be used by the caller. It is up to the
- * caller to free the clientData field of the entry, if that
- * is relevant.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
-{
- register Tcl_HashEntry *prevPtr;
-
- if (*entryPtr->bucketPtr == entryPtr) {
- *entryPtr->bucketPtr = entryPtr->nextPtr;
- } else {
- for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
- if (prevPtr == NULL) {
- panic("malformed bucket chain in Tcl_DeleteHashEntry");
- }
- if (prevPtr->nextPtr == entryPtr) {
- prevPtr->nextPtr = entryPtr->nextPtr;
- break;
- }
- }
- }
- entryPtr->tablePtr->numEntries--;
- ckfree((char *) entryPtr);
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteHashTable --
- *
- * Free up everything associated with a hash table except for
- * the record for the table itself.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The hash table is no longer useable.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DeleteHashTable(register Tcl_HashTable *tablePtr)
-{
- register Tcl_HashEntry *hPtr, *nextPtr;
- int i;
-
- /*
- * Free up all the entries in the table.
- */
-
- for (i = 0; i < tablePtr->numBuckets; i++) {
- hPtr = tablePtr->buckets[i];
- while (hPtr != NULL) {
- nextPtr = hPtr->nextPtr;
- ckfree((char *) hPtr);
- hPtr = nextPtr;
- }
- }
-
- /*
- * Free up the bucket array, if it was dynamically allocated.
- */
-
- if (tablePtr->buckets != tablePtr->staticBuckets) {
- ckfree((char *) tablePtr->buckets);
- }
-
- /*
- * Arrange for panics if the table is used again without
- * re-initialization.
- */
-
- tablePtr->findProc = BogusFind;
- tablePtr->createProc = BogusCreate;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FirstHashEntry --
- *
- * Locate the first entry in a hash table and set up a record
- * that can be used to step through all the remaining entries
- * of the table.
- *
- * Results:
- * The return value is a pointer to the first entry in tablePtr,
- * or NULL if tablePtr has no entries in it. The memory at
- * *searchPtr is initialized so that subsequent calls to
- * Tcl_NextHashEntry will return all of the entries in the table,
- * one at a time.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_HashEntry *
-Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr)
-{
- searchPtr->tablePtr = tablePtr;
- searchPtr->nextIndex = 0;
- searchPtr->nextEntryPtr = NULL;
- return Tcl_NextHashEntry(searchPtr);
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_NextHashEntry --
- *
- * Once a hash table enumeration has been initiated by calling
- * Tcl_FirstHashEntry, this procedure may be called to return
- * successive elements of the table.
- *
- * Results:
- * The return value is the next entry in the hash table being
- * enumerated, or NULL if the end of the table is reached.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-Tcl_HashEntry *
-Tcl_NextHashEntry(register Tcl_HashSearch *searchPtr)
-{
- Tcl_HashEntry *hPtr;
-
- while (searchPtr->nextEntryPtr == NULL) {
- if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
- return NULL;
- }
- searchPtr->nextEntryPtr =
- searchPtr->tablePtr->buckets[searchPtr->nextIndex];
- searchPtr->nextIndex++;
- }
- hPtr = searchPtr->nextEntryPtr;
- searchPtr->nextEntryPtr = hPtr->nextPtr;
- return hPtr;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_HashStats --
- *
- * Return statistics describing the layout of the hash table
- * in its hash buckets.
- *
- * Results:
- * The return value is a malloc-ed string containing information
- * about tablePtr. It is the caller's responsibility to free
- * this string.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-char *
-Tcl_HashStats(Tcl_HashTable *tablePtr)
-{
-#define NUM_COUNTERS 10
- int count[NUM_COUNTERS], overflow, i, j;
- double average, tmp;
- register Tcl_HashEntry *hPtr;
- char *result, *p;
-
- /*
- * Compute a histogram of bucket usage.
- */
-
- for (i = 0; i < NUM_COUNTERS; i++) {
- count[i] = 0;
- }
- overflow = 0;
- average = 0.0;
- for (i = 0; i < tablePtr->numBuckets; i++) {
- j = 0;
- for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
- j++;
- }
- if (j < NUM_COUNTERS) {
- count[j]++;
- } else {
- overflow++;
- }
- tmp = j;
- average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
- }
-
- /*
- * Print out the histogram and a few other pieces of information.
- */
-
- result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
- sprintf(result, "%d entries in table, %d buckets\n",
- tablePtr->numEntries, tablePtr->numBuckets);
- p = result + strlen(result);
- for (i = 0; i < NUM_COUNTERS; i++) {
- sprintf(p, "number of buckets with %d entries: %d\n",
- i, count[i]);
- p += strlen(p);
- }
- sprintf(p, "number of buckets with %d or more entries: %d\n",
- NUM_COUNTERS, overflow);
- p += strlen(p);
- sprintf(p, "average search distance for entry: %.1f", average);
- return result;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * HashString --
- *
- * Compute a one-word summary of a text string, which can be
- * used to generate a hash index.
- *
- * Results:
- * The return value is a one-word summary of the information in
- * string.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static unsigned int
-HashString(register char *string)
-{
- register unsigned int result;
- register int c;
-
- /*
- * I tried a zillion different hash functions and asked many other
- * people for advice. Many people had their own favorite functions,
- * all different, but no-one had much idea why they were good ones.
- * I chose the one below (multiply by 9 and add new character)
- * because of the following reasons:
- *
- * 1. Multiplying by 10 is perfect for keys that are decimal strings,
- * and multiplying by 9 is just about as good.
- * 2. Times-9 is (shift-left-3) plus (old). This means that each
- * character's bits hang around in the low-order bits of the
- * hash value for ever, plus they spread fairly rapidly up to
- * the high-order bits to fill out the hash value. This seems
- * works well both for decimal and non-decimal strings.
- */
-
- result = 0;
- while (1) {
- c = *string;
- string++;
- if (c == 0) {
- break;
- }
- result += (result<<3) + c;
- }
- return result;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * StringFind --
- *
- * Given a hash table with string keys, and a string key, find
- * the entry with a matching key.
- *
- * Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-StringFind(Tcl_HashTable *tablePtr, char *key)
-{
- register Tcl_HashEntry *hPtr;
- register char *p1, *p2;
- int index;
-
- index = HashString(key) & tablePtr->mask;
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
- if (*p1 != *p2) {
- break;
- }
- if (*p1 == '\0') {
- return hPtr;
- }
- }
- }
- return NULL;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * StringCreate --
- *
- * Given a hash table with string keys, and a string key, find
- * the entry with a matching key. If there is no matching entry,
- * then create a new entry that does match.
- *
- * Results:
- * The return value is a pointer to the matching entry. If this
- * is a newly-created entry, then *newPtr will be set to a non-zero
- * value; otherwise *newPtr will be set to 0. If this is a new
- * entry the value stored in the entry will initially be 0.
- *
- * Side effects:
- * A new entry may be added to the hash table.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-StringCreate(Tcl_HashTable *tablePtr, char *key, int *newPtr)
-{
- register Tcl_HashEntry *hPtr;
- register char *p1, *p2;
- int index;
-
- index = HashString(key) & tablePtr->mask;
-
- /*
- * Search all of the entries in this bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
- if (*p1 != *p2) {
- break;
- }
- if (*p1 == '\0') {
- *newPtr = 0;
- return hPtr;
- }
- }
- }
-
- /*
- * Entry not found. Add a new one to the bucket.
- */
-
- *newPtr = 1;
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
- (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
- hPtr->tablePtr = tablePtr;
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- hPtr->clientData = 0;
- strcpy(hPtr->key.string, key);
- *hPtr->bucketPtr = hPtr;
- tablePtr->numEntries++;
-
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
-
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
- return hPtr;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * OneWordFind --
- *
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key.
- *
- * Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-OneWordFind(Tcl_HashTable *tablePtr, register char *key)
-{
- register Tcl_HashEntry *hPtr;
- int index;
-
- index = RANDOM_INDEX(tablePtr, key);
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- if (hPtr->key.oneWordValue == key) {
- return hPtr;
- }
- }
- return NULL;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * OneWordCreate --
- *
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key. If there is no matching entry,
- * then create a new entry that does match.
- *
- * Results:
- * The return value is a pointer to the matching entry. If this
- * is a newly-created entry, then *newPtr will be set to a non-zero
- * value; otherwise *newPtr will be set to 0. If this is a new
- * entry the value stored in the entry will initially be 0.
- *
- * Side effects:
- * A new entry may be added to the hash table.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-OneWordCreate(Tcl_HashTable *tablePtr, register char *key, int *newPtr)
-{
- register Tcl_HashEntry *hPtr;
- int index;
-
- index = RANDOM_INDEX(tablePtr, key);
-
- /*
- * Search all of the entries in this bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- if (hPtr->key.oneWordValue == key) {
- *newPtr = 0;
- return hPtr;
- }
- }
-
- /*
- * Entry not found. Add a new one to the bucket.
- */
-
- *newPtr = 1;
- hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
- hPtr->tablePtr = tablePtr;
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- hPtr->clientData = 0;
- hPtr->key.oneWordValue = key;
- *hPtr->bucketPtr = hPtr;
- tablePtr->numEntries++;
-
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
-
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
- return hPtr;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * ArrayFind --
- *
- * Given a hash table with array-of-int keys, and a key, find
- * the entry with a matching key.
- *
- * Results:
- * The return value is a token for the matching entry in the
- * hash table, or NULL if there was no matching entry.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-ArrayFind(Tcl_HashTable *tablePtr, char *key)
-{
- register Tcl_HashEntry *hPtr;
- int *arrayPtr = (int *) key;
- register int *iPtr1, *iPtr2;
- int index, count;
-
- for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
- count > 0; count--, iPtr1++) {
- index += *iPtr1;
- }
- index = RANDOM_INDEX(tablePtr, index);
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
- count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
- if (count == 0) {
- return hPtr;
- }
- if (*iPtr1 != *iPtr2) {
- break;
- }
- }
- }
- return NULL;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * ArrayCreate --
- *
- * Given a hash table with one-word keys, and a one-word key, find
- * the entry with a matching key. If there is no matching entry,
- * then create a new entry that does match.
- *
- * Results:
- * The return value is a pointer to the matching entry. If this
- * is a newly-created entry, then *newPtr will be set to a non-zero
- * value; otherwise *newPtr will be set to 0. If this is a new
- * entry the value stored in the entry will initially be 0.
- *
- * Side effects:
- * A new entry may be added to the hash table.
- *
- *----------------------------------------------------------------------
- */
-
-static Tcl_HashEntry *
-ArrayCreate(Tcl_HashTable *tablePtr, register char *key, int *newPtr)
-{
- register Tcl_HashEntry *hPtr;
- int *arrayPtr = (int *) key;
- register int *iPtr1, *iPtr2;
- int index, count;
-
- for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
- count > 0; count--, iPtr1++) {
- index += *iPtr1;
- }
- index = RANDOM_INDEX(tablePtr, index);
-
- /*
- * Search all of the entries in the appropriate bucket.
- */
-
- for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
- hPtr = hPtr->nextPtr) {
- for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
- count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
- if (count == 0) {
- *newPtr = 0;
- return hPtr;
- }
- if (*iPtr1 != *iPtr2) {
- break;
- }
- }
- }
-
- /*
- * Entry not found. Add a new one to the bucket.
- */
-
- *newPtr = 1;
- hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
- + (tablePtr->keyType*sizeof(int)) - 4));
- hPtr->tablePtr = tablePtr;
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- hPtr->clientData = 0;
- for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
- count > 0; count--, iPtr1++, iPtr2++) {
- *iPtr2 = *iPtr1;
- }
- *hPtr->bucketPtr = hPtr;
- tablePtr->numEntries++;
-
- /*
- * If the table has exceeded a decent size, rebuild it with many
- * more buckets.
- */
-
- if (tablePtr->numEntries >= tablePtr->rebuildSize) {
- RebuildTable(tablePtr);
- }
- return hPtr;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * BogusFind --
- *
- * This procedure is invoked when an Tcl_FindHashEntry is called
- * on a table that has been deleted.
- *
- * Results:
- * If panic returns (which it shouldn't) this procedure returns
- * NULL.
- *
- * Side effects:
- * Generates a panic.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static Tcl_HashEntry *
-BogusFind(Tcl_HashTable *tablePtr, char *key)
-{
- panic("called Tcl_FindHashEntry on deleted table");
- return NULL;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * BogusCreate --
- *
- * This procedure is invoked when an Tcl_CreateHashEntry is called
- * on a table that has been deleted.
- *
- * Results:
- * If panic returns (which it shouldn't) this procedure returns
- * NULL.
- *
- * Side effects:
- * Generates a panic.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static Tcl_HashEntry *
-BogusCreate(Tcl_HashTable *tablePtr, char *key, int *newPtr)
-{
- panic("called Tcl_CreateHashEntry on deleted table");
- return NULL;
-}
-\f
-/*
- *----------------------------------------------------------------------
- *
- * RebuildTable --
- *
- * This procedure is invoked when the ratio of entries to hash
- * buckets becomes too large. It creates a new table with a
- * larger bucket array and moves all of the entries into the
- * new table.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory gets reallocated and entries get re-hashed to new
- * buckets.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-RebuildTable(register Tcl_HashTable *tablePtr)
-{
- int oldSize, count, index;
- Tcl_HashEntry **oldBuckets;
- register Tcl_HashEntry **oldChainPtr, **newChainPtr;
- register Tcl_HashEntry *hPtr;
-
- oldSize = tablePtr->numBuckets;
- oldBuckets = tablePtr->buckets;
-
- /*
- * Allocate and initialize the new bucket array, and set up
- * hashing constants for new array size.
- */
-
- tablePtr->numBuckets *= 4;
- tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
- (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
- for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
- count > 0; count--, newChainPtr++) {
- *newChainPtr = NULL;
- }
- tablePtr->rebuildSize *= 4;
- tablePtr->downShift -= 2;
- tablePtr->mask = (tablePtr->mask << 2) + 3;
-
- /*
- * Rehash all of the existing entries into the new bucket array.
- */
-
- for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
- for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
- *oldChainPtr = hPtr->nextPtr;
- if (tablePtr->keyType == TCL_STRING_KEYS) {
- index = HashString(hPtr->key.string) & tablePtr->mask;
- } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
- index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
- } else {
- register int *iPtr;
- int count;
-
- for (index = 0, count = tablePtr->keyType,
- iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
- index += *iPtr;
- }
- index = RANDOM_INDEX(tablePtr, index);
- }
- hPtr->bucketPtr = &(tablePtr->buckets[index]);
- hPtr->nextPtr = *hPtr->bucketPtr;
- *hPtr->bucketPtr = hPtr;
- }
- }
-
- /*
- * Free up the old bucket array, if it was dynamically allocated.
- */
-
- if (oldBuckets != tablePtr->staticBuckets) {
- ckfree((char *) oldBuckets);
- }
-}
+++ /dev/null
-/*
- * tclInt.h --
- *
- * Declarations of things used internally by the Tcl interpreter.
- *
- * Copyright (c) 1987-1993 The Regents of the University of California.
- * Copyright (c) 1994-1995 Sun Microsystems, Inc.
- *
- * This software is copyrighted by the Regents of the University of
- * California, Sun Microsystems, Inc., and other parties. The following
- * terms apply to all files associated with the software unless explicitly
- * disclaimed in individual files.
- *
- * The authors hereby grant permission to use, copy, modify, distribute,
- * and license this software and its documentation for any purpose, provided
- * that existing copyright notices are retained in all copies and that this
- * notice is included verbatim in any distributions. No written agreement,
- * license, or royalty fee is required for any of the authorized uses.
- * Modifications to this software may be copyrighted by their authors
- * and need not follow the licensing terms described here, provided that
- * the new terms are clearly indicated on the first page of each file where
- * they apply.
- *
- * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
- * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
- * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
- * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
- * POSSIBILITY OF SUCH DAMAGE.
- *
- * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
- * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
- * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
- * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
- * MODIFICATIONS.
- *
- * RESTRICTED RIGHTS: Use, duplication or disclosure by the government
- * is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
- * of the Rights in Technical Data and Computer Software Clause as DFARS
- * 252.227-7013 and FAR 52.227-19.
- *
- * $Id: tclInt.h,v 1.1 1999/07/28 01:11:47 roberts Exp $
- *
- * @(#) tclInt.h 1.106 95/08/25 15:44:50
- */
-
-#ifndef _TCLINT
-#define _TCLINT
-
-/*
- * Common include files needed by most of the Tcl source files are
- * included here, so that system-dependent personalizations for the
- * include files only have to be made in once place. This results
- * in a few extra includes, but greater modularity. The order of
- * the three groups of #includes is important. For example, stdio.h
- * is needed by tcl.h, and the _ANSI_ARGS_ declaration in tcl.h is
- * needed by stdlib.h in some configurations.
- */
-
-#include <stdio.h>
-#include <assert.h>
-
-#ifndef _TCL
-#include "tcl.h"
-#endif
-#ifndef _REGEXP
-#include "tclRegexp.h"
-#endif
-
-#include <ctype.h>
-#ifdef NO_LIMITS_H
-# include "compat/limits.h"
-#else
-# include <limits.h>
-#endif
-#ifdef NO_STDLIB_H
-# include "compat/stdlib.h"
-#else
-# include <stdlib.h>
-#endif
-#ifdef NO_STRING_H
-#include "compat/string.h"
-#else
-#include <string.h>
-#endif
-#include <varargs.h>
-
-/*
- * At present (12/91) not all stdlib.h implementations declare strtod.
- * The declaration below is here to ensure that it's declared, so that
- * the compiler won't take the default approach of assuming it returns
- * an int. There's no ANSI prototype for it because there would end
- * up being too many conflicts with slightly-different prototypes.
- */
-
-extern double strtod();
-
-/*
- *----------------------------------------------------------------
- * Data structures related to variables. These are used primarily
- * in tclVar.c
- *----------------------------------------------------------------
- */
-
-/*
- * The following structure defines a variable trace, which is used to
- * invoke a specific C procedure whenever certain operations are performed
- * on a variable.
- */
-
-typedef struct VarTrace {
- Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given
- * by flags are performed on variable. */
- ClientData clientData; /* Argument to pass to proc. */
- int flags; /* What events the trace procedure is
- * interested in: OR-ed combination of
- * TCL_TRACE_READS, TCL_TRACE_WRITES, and
- * TCL_TRACE_UNSETS. */
- struct VarTrace *nextPtr; /* Next in list of traces associated with
- * a particular variable. */
-} VarTrace;
-
-/*
- * When a variable trace is active (i.e. its associated procedure is
- * executing), one of the following structures is linked into a list
- * associated with the variable's interpreter. The information in
- * the structure is needed in order for Tcl to behave reasonably
- * if traces are deleted while traces are active.
- */
-
-typedef struct ActiveVarTrace {
- struct Var *varPtr; /* Variable that's being traced. */
- struct ActiveVarTrace *nextPtr;
- /* Next in list of all active variable
- * traces for the interpreter, or NULL
- * if no more. */
- VarTrace *nextTracePtr; /* Next trace to check after current
- * trace procedure returns; if this
- * trace gets deleted, must update pointer
- * to avoid using free'd memory. */
-} ActiveVarTrace;
-
-/*
- * The following structure describes an enumerative search in progress on
- * an array variable; this are invoked with options to the "array"
- * command.
- */
-
-typedef struct ArraySearch {
- int id; /* Integer id used to distinguish among
- * multiple concurrent searches for the
- * same array. */
- struct Var *varPtr; /* Pointer to array variable that's being
- * searched. */
- Tcl_HashSearch search; /* Info kept by the hash module about
- * progress through the array. */
- Tcl_HashEntry *nextEntry; /* Non-null means this is the next element
- * to be enumerated (it's leftover from
- * the Tcl_FirstHashEntry call or from
- * an "array anymore" command). NULL
- * means must call Tcl_NextHashEntry
- * to get value to return. */
- struct ArraySearch *nextPtr;/* Next in list of all active searches
- * for this variable, or NULL if this is
- * the last one. */
-} ArraySearch;
-
-/*
- * The structure below defines a variable, which associates a string name
- * with a string value. Pointers to these structures are kept as the
- * values of hash table entries, and the name of each variable is stored
- * in the hash entry.
- */
-
-typedef struct Var {
- int valueLength; /* Holds the number of non-null bytes
- * actually occupied by the variable's
- * current value in value.string (extra
- * space is sometimes left for expansion).
- * For array and global variables this is
- * meaningless. */
- int valueSpace; /* Total number of bytes of space allocated
- * at value.string. 0 means there is no
- * space allocated. */
- union {
- char *string; /* String value of variable, used for scalar
- * variables and array elements. Malloc-ed. */
- Tcl_HashTable *tablePtr;/* For array variables, this points to
- * information about the hash table used
- * to implement the associative array.
- * Points to malloc-ed data. */
- struct Var *upvarPtr; /* If this is a global variable being
- * referred to in a procedure, or a variable
- * created by "upvar", this field points to
- * the record for the higher-level variable. */
- } value;
- Tcl_HashEntry *hPtr; /* Hash table entry that refers to this
- * variable, or NULL if the variable has
- * been detached from its hash table (e.g.
- * an array is deleted, but some of its
- * elements are still referred to in upvars). */
- int refCount; /* Counts number of active uses of this
- * variable, not including its main hash
- * table entry: 1 for each additional variable
- * whose upVarPtr points here, 1 for each
- * nested trace active on variable. This
- * record can't be deleted until refCount
- * becomes 0. */
- VarTrace *tracePtr; /* First in list of all traces set for this
- * variable. */
- ArraySearch *searchPtr; /* First in list of all searches active
- * for this variable, or NULL if none. */
- int flags; /* Miscellaneous bits of information about
- * variable. See below for definitions. */
-} Var;
-
-/*
- * Flag bits for variables:
- *
- * VAR_ARRAY - 1 means this is an array variable rather
- * than a scalar variable.
- * VAR_UPVAR - 1 means this variable just contains a
- * pointer to another variable that has the
- * real value. Variables like this come
- * about through the "upvar" and "global"
- * commands.
- * VAR_UNDEFINED - 1 means that the variable is currently
- * undefined. Undefined variables usually
- * go away completely, but if an undefined
- * variable has a trace on it, or if it is
- * a global variable being used by a procedure,
- * then it stays around even when undefined.
- * VAR_TRACE_ACTIVE - 1 means that trace processing is currently
- * underway for a read or write access, so
- * new read or write accesses should not cause
- * trace procedures to be called and the
- * variable can't be deleted.
- */
-
-#define VAR_ARRAY 1
-#define VAR_UPVAR 2
-#define VAR_UNDEFINED 4
-#define VAR_TRACE_ACTIVE 0x10
-
-/*
- *----------------------------------------------------------------
- * Data structures related to procedures. These are used primarily
- * in tclProc.c
- *----------------------------------------------------------------
- */
-
-/*
- * The structure below defines an argument to a procedure, which
- * consists of a name and an (optional) default value.
- */
-
-typedef struct Arg {
- struct Arg *nextPtr; /* Next argument for this procedure,
- * or NULL if this is the last argument. */
- char *defValue; /* Pointer to arg's default value, or NULL
- * if no default value. */
- char name[4]; /* Name of argument starts here. The name
- * is followed by space for the default,
- * if there is one. The actual size of this
- * field will be as large as necessary to
- * hold both name and default value. THIS
- * MUST BE THE LAST FIELD IN THE STRUCTURE!! */
-} Arg;
-
-/*
- * The structure below defines a command procedure, which consists of
- * a collection of Tcl commands plus information about arguments and
- * variables.
- */
-
-typedef struct Proc {
- struct Interp *iPtr; /* Interpreter for which this command
- * is defined. */
- int refCount; /* Reference count: 1 if still present
- * in command table plus 1 for each call
- * to the procedure that is currently
- * active. This structure can be freed
- * when refCount becomes zero. */
- char *command; /* Command that constitutes the body of
- * the procedure (dynamically allocated). */
- Arg *argPtr; /* Pointer to first of procedure's formal
- * arguments, or NULL if none. */
-} Proc;
-
-/*
- * The structure below defines a command trace. This is used to allow Tcl
- * clients to find out whenever a command is about to be executed.
- */
-
-typedef struct Trace {
- int level; /* Only trace commands at nesting level
- * less than or equal to this. */
- Tcl_CmdTraceProc *proc; /* Procedure to call to trace command. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
- struct Trace *nextPtr; /* Next in list of traces for this interp. */
-} Trace;
-
-/*
- * The stucture below defines a deletion callback, which is
- * a procedure to invoke just before an interpreter is deleted.
- */
-
-typedef struct DeleteCallback {
- Tcl_InterpDeleteProc *proc; /* Procedure to call. */
- ClientData clientData; /* Value to pass to procedure. */
- struct DeleteCallback *nextPtr;
- /* Next in list of callbacks for this
- * interpreter (or NULL for end of list). */
-} DeleteCallback;
-
-/*
- * The structure below defines a frame, which is a procedure invocation.
- * These structures exist only while procedures are being executed, and
- * provide a sort of call stack.
- */
-
-typedef struct CallFrame {
- Tcl_HashTable varTable; /* Hash table containing all of procedure's
- * local variables. */
- int level; /* Level of this procedure, for "uplevel"
- * purposes (i.e. corresponds to nesting of
- * callerVarPtr's, not callerPtr's). 1 means
- * outer-most procedure, 0 means top-level. */
- int argc; /* This and argv below describe name and
- * arguments for this procedure invocation. */
- char **argv; /* Array of arguments. */
- struct CallFrame *callerPtr;
- /* Value of interp->framePtr when this
- * procedure was invoked (i.e. next in
- * stack of all active procedures). */
- struct CallFrame *callerVarPtr;
- /* Value of interp->varFramePtr when this
- * procedure was invoked (i.e. determines
- * variable scoping within caller; same
- * as callerPtr unless an "uplevel" command
- * or something equivalent was active in
- * the caller). */
-} CallFrame;
-
-/*
- * The structure below defines one history event (a previously-executed
- * command that can be re-executed in whole or in part).
- */
-
-typedef struct {
- char *command; /* String containing previously-executed
- * command. */
- int bytesAvl; /* Total # of bytes available at *event (not
- * all are necessarily in use now). */
-} HistoryEvent;
-
-/*
- *----------------------------------------------------------------
- * Data structures related to history. These are used primarily
- * in tclHistory.c
- *----------------------------------------------------------------
- */
-
-/*
- * The structure below defines a pending revision to the most recent
- * history event. Changes are linked together into a list and applied
- * during the next call to Tcl_RecordHistory. See the comments at the
- * beginning of tclHistory.c for information on revisions.
- */
-
-typedef struct HistoryRev {
- int firstIndex; /* Index of the first byte to replace in
- * current history event. */
- int lastIndex; /* Index of last byte to replace in
- * current history event. */
- int newSize; /* Number of bytes in newBytes. */
- char *newBytes; /* Replacement for the range given by
- * firstIndex and lastIndex (malloced). */
- struct HistoryRev *nextPtr; /* Next in chain of revisions to apply, or
- * NULL for end of list. */
-} HistoryRev;
-
-/*
- *----------------------------------------------------------------
- * Data structures related to files. These are used primarily in
- * tclUnixUtil.c and tclUnixAZ.c.
- *----------------------------------------------------------------
- */
-
-/*
- * The data structure below defines an open file (or connection to
- * a process pipeline) as returned by the "open" command.
- */
-
-typedef struct OpenFile {
- FILE *f; /* Stdio file to use for reading and/or
- * writing. */
- FILE *f2; /* Normally NULL. In the special case of
- * a command pipeline with pipes for both
- * input and output, this is a stdio file
- * to use for writing to the pipeline. */
- int permissions; /* OR-ed combination of TCL_FILE_READABLE
- * and TCL_FILE_WRITABLE. */
- int numPids; /* If this is a connection to a process
- * pipeline, gives number of processes
- * in pidPtr array below; otherwise it
- * is 0. */
- int *pidPtr; /* Pointer to malloc-ed array of child
- * process ids (numPids of them), or NULL
- * if this isn't a connection to a process
- * pipeline. */
- int errorId; /* File id of file that receives error
- * output from pipeline. -1 means not
- * used (i.e. this is a normal file). */
-} OpenFile;
-
-/*
- *----------------------------------------------------------------
- * Data structures related to expressions. These are used only in
- * tclExpr.c.
- *----------------------------------------------------------------
- */
-
-/*
- * The data structure below defines a math function (e.g. sin or hypot)
- * for use in Tcl expressions.
- */
-
-#define MAX_MATH_ARGS 5
-typedef struct MathFunc {
- int numArgs; /* Number of arguments for function. */
- Tcl_ValueType argTypes[MAX_MATH_ARGS];
- /* Acceptable types for each argument. */
- Tcl_MathProc *proc; /* Procedure that implements this function. */
- ClientData clientData; /* Additional argument to pass to the function
- * when invoking it. */
-} MathFunc;
-
-/*
- *----------------------------------------------------------------
- * One of the following structures exists for each command in
- * an interpreter. The Tcl_Command opaque type actually refers
- * to these structures.
- *----------------------------------------------------------------
- */
-
-typedef struct Command {
- Tcl_HashEntry *hPtr; /* Pointer to the hash table entry in
- * interp->commandTable that refers to
- * this command. Used to get a command's
- * name from its Tcl_Command handle. NULL
- * means that the hash table entry has
- * been removed already (this can happen
- * if deleteProc causes the command to be
- * deleted or recreated). */
- Tcl_CmdProc *proc; /* Procedure to process command. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
- Tcl_CmdDeleteProc *deleteProc;
- /* Procedure to invoke when deleting
- * command. */
- ClientData deleteData; /* Arbitrary value to pass to deleteProc
- * (usually the same as clientData). */
- int deleted; /* Means that the command is in the process
- * of being deleted (its deleteProc is
- * currently executing). Any other attempts
- * to delete the command should be ignored. */
-} Command;
-
-/*
- *----------------------------------------------------------------
- * This structure defines an interpreter, which is a collection of
- * commands plus other state information related to interpreting
- * commands, such as variable storage. Primary responsibility for
- * this data structure is in tclBasic.c, but almost every Tcl
- * source file uses something in here.
- *----------------------------------------------------------------
- */
-
-typedef struct Interp {
-
- /*
- * Note: the first three fields must match exactly the fields in
- * a Tcl_Interp struct (see tcl.h). If you change one, be sure to
- * change the other.
- */
-
- char *result; /* Points to result returned by last
- * command. */
- Tcl_FreeProc *freeProc; /* Zero means result is statically allocated.
- * If non-zero, gives address of procedure
- * to invoke to free the result. Must be
- * freed by Tcl_Eval before executing next
- * command. */
- int errorLine; /* When TCL_ERROR is returned, this gives
- * the line number within the command where
- * the error occurred (1 means first line). */
- Tcl_HashTable commandTable; /* Contains all of the commands currently
- * registered in this interpreter. Indexed
- * by strings; values have type (Command *). */
- Tcl_HashTable mathFuncTable;/* Contains all of the math functions currently
- * defined for the interpreter. Indexed by
- * strings (function names); values have
- * type (MathFunc *). */
-
- /*
- * Information related to procedures and variables. See tclProc.c
- * and tclvar.c for usage.
- */
-
- Tcl_HashTable globalTable; /* Contains all global variables for
- * interpreter. */
- int numLevels; /* Keeps track of how many nested calls to
- * Tcl_Eval are in progress for this
- * interpreter. It's used to delay deletion
- * of the table until all Tcl_Eval invocations
- * are completed. */
- int maxNestingDepth; /* If numLevels exceeds this value then Tcl
- * assumes that infinite recursion has
- * occurred and it generates an error. */
- CallFrame *framePtr; /* Points to top-most in stack of all nested
- * procedure invocations. NULL means there
- * are no active procedures. */
- CallFrame *varFramePtr; /* Points to the call frame whose variables
- * are currently in use (same as framePtr
- * unless an "uplevel" command is being
- * executed). NULL means no procedure is
- * active or "uplevel 0" is being exec'ed. */
- ActiveVarTrace *activeTracePtr;
- /* First in list of active traces for interp,
- * or NULL if no active traces. */
- int returnCode; /* Completion code to return if current
- * procedure exits with a TCL_RETURN code. */
- char *errorInfo; /* Value to store in errorInfo if returnCode
- * is TCL_ERROR. Malloc'ed, may be NULL */
- char *errorCode; /* Value to store in errorCode if returnCode
- * is TCL_ERROR. Malloc'ed, may be NULL */
-
- /*
- * Information related to history:
- */
-
- int numEvents; /* Number of previously-executed commands
- * to retain. */
- HistoryEvent *events; /* Array containing numEvents entries
- * (dynamically allocated). */
- int curEvent; /* Index into events of place where current
- * (or most recent) command is recorded. */
- int curEventNum; /* Event number associated with the slot
- * given by curEvent. */
- HistoryRev *revPtr; /* First in list of pending revisions. */
- char *historyFirst; /* First char. of current command executed
- * from history module or NULL if none. */
- int revDisables; /* 0 means history revision OK; > 0 gives
- * a count of number of times revision has
- * been disabled. */
- char *evalFirst; /* If TCL_RECORD_BOUNDS flag set, Tcl_Eval
- * sets this field to point to the first
- * char. of text from which the current
- * command came. Otherwise Tcl_Eval sets
- * this to NULL. */
- char *evalLast; /* Similar to evalFirst, except points to
- * last character of current command. */
-
- /*
- * Information used by Tcl_AppendResult to keep track of partial
- * results. See Tcl_AppendResult code for details.
- */
-
- char *appendResult; /* Storage space for results generated
- * by Tcl_AppendResult. Malloc-ed. NULL
- * means not yet allocated. */
- int appendAvl; /* Total amount of space available at
- * partialResult. */
- int appendUsed; /* Number of non-null bytes currently
- * stored at partialResult. */
-
- /*
- * A cache of compiled regular expressions. See Tcl_RegExpCompile
- * in tclUtil.c for details.
- */
-
-#define NUM_REGEXPS 5
- char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled
- * regular expression patterns. NULL
- * means that this slot isn't used.
- * Malloc-ed. */
- int patLengths[NUM_REGEXPS];/* Number of non-null characters in
- * corresponding entry in patterns.
- * -1 means entry isn't used. */
- regexp *regexps[NUM_REGEXPS];
- /* Compiled forms of above strings. Also
- * malloc-ed, or NULL if not in use yet. */
-
- /*
- * Information used by Tcl_PrintDouble:
- */
-
- char pdFormat[10]; /* Format string used by Tcl_PrintDouble. */
- int pdPrec; /* Current precision (used to restore the
- * the tcl_precision variable after a bogus
- * value has been put into it). */
-
- /*
- * Miscellaneous information:
- */
-
- int cmdCount; /* Total number of times a command procedure
- * has been called for this interpreter. */
- int noEval; /* Non-zero means no commands should actually
- * be executed: just parse only. Used in
- * expressions when the result is already
- * determined. */
- int evalFlags; /* Flags to control next call to Tcl_Eval.
- * Normally zero, but may be set before
- * calling Tcl_Eval. See below for valid
- * values. */
- char *termPtr; /* Character just after the last one in
- * a command. Set by Tcl_Eval before
- * returning. */
- char *scriptFile; /* NULL means there is no nested source
- * command active; otherwise this points to
- * the name of the file being sourced (it's
- * not malloc-ed: it points to an argument
- * to Tcl_EvalFile. */
- int flags; /* Various flag bits. See below. */
- Trace *tracePtr; /* List of traces for this interpreter. */
- DeleteCallback *deleteCallbackPtr;
- /* First in list of callbacks to invoke when
- * interpreter is deleted. */
- char resultSpace[TCL_RESULT_SIZE+1];
- /* Static space for storing small results. */
-} Interp;
-
-/*
- * EvalFlag bits for Interp structures:
- *
- * TCL_BRACKET_TERM 1 means that the current script is terminated by
- * a close bracket rather than the end of the string.
- * TCL_RECORD_BOUNDS Tells Tcl_Eval to record information in the
- * evalFirst and evalLast fields for each command
- * executed directly from the string (top-level
- * commands and those from command substitution).
- * TCL_ALLOW_EXCEPTIONS 1 means it's OK for the script to terminate with
- * a code other than TCL_OK or TCL_ERROR; 0 means
- * codes other than these should be turned into errors.
- */
-
-#define TCL_BRACKET_TERM 1
-#define TCL_RECORD_BOUNDS 2
-#define TCL_ALLOW_EXCEPTIONS 4
-
-/*
- * Flag bits for Interp structures:
- *
- * DELETED: Non-zero means the interpreter has been deleted:
- * don't process any more commands for it, and destroy
- * the structure as soon as all nested invocations of
- * Tcl_Eval are done.
- * ERR_IN_PROGRESS: Non-zero means an error unwind is already in progress.
- * Zero means a command proc has been invoked since last
- * error occured.
- * ERR_ALREADY_LOGGED: Non-zero means information has already been logged
- * in $errorInfo for the current Tcl_Eval instance,
- * so Tcl_Eval needn't log it (used to implement the
- * "error message log" command).
- * ERROR_CODE_SET: Non-zero means that Tcl_SetErrorCode has been
- * called to record information for the current
- * error. Zero means Tcl_Eval must clear the
- * errorCode variable if an error is returned.
- * EXPR_INITIALIZED: 1 means initialization specific to expressions has
- * been carried out.
- */
-
-#define DELETED 1
-#define ERR_IN_PROGRESS 2
-#define ERR_ALREADY_LOGGED 4
-#define ERROR_CODE_SET 8
-#define EXPR_INITIALIZED 0x10
-
-/*
- * Default value for the pdPrec and pdFormat fields of interpreters:
- */
-
-#define DEFAULT_PD_PREC 6
-#define DEFAULT_PD_FORMAT "%g"
-
-/*
- *----------------------------------------------------------------
- * Data structures related to command parsing. These are used in
- * tclParse.c and its clients.
- *----------------------------------------------------------------
- */
-
-/*
- * The following data structure is used by various parsing procedures
- * to hold information about where to store the results of parsing
- * (e.g. the substituted contents of a quoted argument, or the result
- * of a nested command). At any given time, the space available
- * for output is fixed, but a procedure may be called to expand the
- * space available if the current space runs out.
- */
-
-typedef struct ParseValue {
- char *buffer; /* Address of first character in
- * output buffer. */
- char *next; /* Place to store next character in
- * output buffer. */
- char *end; /* Address of the last usable character
- * in the buffer. */
- void (*expandProc) _ANSI_ARGS_((struct ParseValue *pvPtr, int needed));
- /* Procedure to call when space runs out;
- * it will make more space. */
- ClientData clientData; /* Arbitrary information for use of
- * expandProc. */
-} ParseValue;
-
-/*
- * A table used to classify input characters to assist in parsing
- * Tcl commands. The table should be indexed with a signed character
- * using the CHAR_TYPE macro. The character may have a negative
- * value.
- */
-
-extern char tclTypeTable[];
-#define CHAR_TYPE(c) (tclTypeTable+128)[c]
-
-/*
- * Possible values returned by CHAR_TYPE:
- *
- * TCL_NORMAL - All characters that don't have special significance
- * to the Tcl language.
- * TCL_SPACE - Character is space, tab, or return.
- * TCL_COMMAND_END - Character is newline or null or semicolon or
- * close-bracket.
- * TCL_QUOTE - Character is a double-quote.
- * TCL_OPEN_BRACKET - Character is a "[".
- * TCL_OPEN_BRACE - Character is a "{".
- * TCL_CLOSE_BRACE - Character is a "}".
- * TCL_BACKSLASH - Character is a "\".
- * TCL_DOLLAR - Character is a "$".
- */
-
-#define TCL_NORMAL 0
-#define TCL_SPACE 1
-#define TCL_COMMAND_END 2
-#define TCL_QUOTE 3
-#define TCL_OPEN_BRACKET 4
-#define TCL_OPEN_BRACE 5
-#define TCL_CLOSE_BRACE 6
-#define TCL_BACKSLASH 7
-#define TCL_DOLLAR 8
-
-/*
- * Maximum number of levels of nesting permitted in Tcl commands (used
- * to catch infinite recursion).
- */
-
-#define MAX_NESTING_DEPTH 1000
-
-/*
- * The macro below is used to modify a "char" value (e.g. by casting
- * it to an unsigned character) so that it can be used safely with
- * macros such as isspace.
- */
-
-#define UCHAR(c) ((unsigned char) (c))
-
-/*
- * Given a size or address, the macro below "aligns" it to the machine's
- * memory unit size (e.g. an 8-byte boundary) so that anything can be
- * placed at the aligned address without fear of an alignment error.
- */
-
-#define TCL_ALIGN(x) ((x + 7) & ~7)
-
-/*
- * Variables shared among Tcl modules but not used by the outside
- * world:
- */
-
-extern int tclNumFiles;
-extern OpenFile ** tclOpenFiles;
-
-/*
- *----------------------------------------------------------------
- * Procedures shared among Tcl modules but not used by the outside
- * world:
- *----------------------------------------------------------------
- */
-
-#define panic(a) assert(a)
-extern void TclCopyAndCollapse _ANSI_ARGS_((int count, char *src,
- char *dst));
-extern void TclDeleteVars _ANSI_ARGS_((Interp *iPtr,
- Tcl_HashTable *tablePtr));
-extern void TclExpandParseValue _ANSI_ARGS_((ParseValue *pvPtr,
- int needed));
-extern void TclExprFloatError _ANSI_ARGS_((Tcl_Interp *interp,
- double value));
-extern int TclFindElement _ANSI_ARGS_((Tcl_Interp *interp,
- char *list, char **elementPtr, char **nextPtr,
- int *sizePtr, int *bracePtr));
-extern Proc * TclFindProc _ANSI_ARGS_((Interp *iPtr,
- char *procName));
-extern int TclGetFrame _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, CallFrame **framePtrPtr));
-extern int TclGetListIndex _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int *indexPtr));
-extern Proc * TclIsProc _ANSI_ARGS_((Command *cmdPtr));
-extern int TclNeedSpace _ANSI_ARGS_((char *start, char *end));
-extern int TclParseBraces _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, char **termPtr, ParseValue *pvPtr));
-extern int TclParseNestedCmd _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int flags, char **termPtr,
- ParseValue *pvPtr));
-extern int TclParseQuotes _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int termChar, int flags,
- char **termPtr, ParseValue *pvPtr));
-extern int TclParseWords _ANSI_ARGS_((Tcl_Interp *interp,
- char *string, int flags, int maxWords,
- char **termPtr, int *argcPtr, char **argv,
- ParseValue *pvPtr));
-extern char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, char *name1, char *name2,
- int flags));
-extern void TclSetupEnv _ANSI_ARGS_((Tcl_Interp *interp));
-extern int TclUpdateReturnInfo _ANSI_ARGS_((Interp *iPtr));
-extern char * TclWordEnd _ANSI_ARGS_((char *start, int nested,
- int *semiPtr));
-
-/*
- *----------------------------------------------------------------
- * Command procedures in the generic core:
- *----------------------------------------------------------------
- */
-
-extern int Tcl_AppendCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ArrayCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_BreakCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_CaseCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_CatchCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ConcatCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ContinueCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ErrorCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_EvalCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ExprCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ForCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ForeachCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_FormatCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_GlobalCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_HistoryCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_IfCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_IncrCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_InfoCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_JoinCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LappendCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LindexCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LinsertCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LlengthCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ListCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LrangeCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LreplaceCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LsearchCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_LsortCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ProcCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_RegexpCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_RegsubCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_RenameCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ReturnCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ScanCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_SetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_SplitCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_StringCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_SubstCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_SwitchCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_TraceCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_UnsetCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_UplevelCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_UpvarCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_WhileCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_Cmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_Cmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-
-/*
- *----------------------------------------------------------------
- * Command procedures in the UNIX core:
- *----------------------------------------------------------------
- */
-
-extern int Tcl_CdCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_CloseCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_EofCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ExecCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ExitCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_FileCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_FlushCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_GetsCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_GlobCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_OpenCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_PutsCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_PidCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_PwdCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_ReadCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_SeekCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_SourceCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_TellCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-extern int Tcl_TimeCmd _ANSI_ARGS_((ClientData clientData,
- Tcl_Interp *interp, int argc, char **argv));
-
-#endif /* _TCLINT */
+++ /dev/null
-/*
- * Definitions etc. for regexp(3) routines.
- *
- * Caveat: this is V8 regexp(3) [actually, a reimplementation thereof],
- * not the System V one.
- *
- * @(#) tclRegexp.h 1.4 95/05/03 17:07:16
- */
-
-#ifndef _REGEXP
-#define _REGEXP 1
-
-#ifndef _TCL
-#include "tcl.h"
-#endif
-
-#define NSUBEXP 50
-typedef struct regexp {
- char *startp[NSUBEXP];
- char *endp[NSUBEXP];
- char regstart; /* Internal use only. */
- char reganch; /* Internal use only. */
- char *regmust; /* Internal use only. */
- int regmlen; /* Internal use only. */
- char program[1]; /* Unwarranted chumminess with compiler. */
-} regexp;
-
-EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp));
-EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
-EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
-EXTERN void TclRegError _ANSI_ARGS_((char *msg));
-EXTERN char *TclGetRegError _ANSI_ARGS_((void));
-
-#endif /* REGEXP */
projects / catagits/fcgi2.git / commitdiff
