Initial revision

1 files changed, 536 insertions, 0 deletions

diff --git a/lisp/private.h b/lisp/private.h
new file mode 100644
index 0000000..6e5b128
--- /dev/null
+++ b/lisp/private.h
@@ -0,0 +1,536 @@
+/*
+ * Copyright (c) 2001 by The XFree86 Project, Inc.
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a
+ * copy of this software and associated documentation files (the "Software"),
+ * to deal in the Software without restriction, including without limitation
+ * the rights to use, copy, modify, merge, publish, distribute, sublicense,
+ * and/or sell copies of the Software, and to permit persons to whom the
+ * Software is furnished to do so, subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in
+ * all copies or substantial portions of the Software.
+ *  
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+ * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
+ * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+ * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+ * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+ * SOFTWARE.
+ *
+ * Except as contained in this notice, the name of the XFree86 Project shall
+ * not be used in advertising or otherwise to promote the sale, use or other
+ * dealings in this Software without prior written authorization from the
+ * XFree86 Project.
+ *
+ * Author: Paulo César Pereira de Andrade
+ */
+
+/* $XFree86: xc/programs/xedit/lisp/private.h,v 1.39 2002/12/20 04:32:46 paulo Exp $ */
+
+#ifndef Lisp_private_h
+#define Lisp_private_h
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <setjmp.h>
+#include <unistd.h>
+#include <sys/time.h>
+#include "internal.h"
+
+#include "core.h"
+#ifdef DEBUGGER
+#include "debugger.h"
+#endif
+#include "helper.h"
+#include "string.h"
+#include "struct.h"
+
+/*
+ * Defines
+ */
+#define	STRTBLSZ		23
+#define MULTIPLE_VALUES_LIMIT	127
+#define MAX_STACK_DEPTH		16384
+
+#define FEATURES						\
+    lisp__data.features->data.atom->a_object ?			\
+	lisp__data.features->data.atom->property->value :	\
+	NIL
+#define PACK	lisp__data.packlist
+#define PACKAGE	lisp__data.package->data.atom->property->value
+#define MOD	lisp__data.modlist
+#define COD	lisp__data.codlist
+#define RUN	lisp__data.runlist
+#define RES	lisp__data.reslist
+#define DBG	lisp__data.dbglist
+#define BRK	lisp__data.brklist
+#define PRO	lisp__data.prolist
+
+#define SINPUT	lisp__data.input
+#define SOUTPUT	lisp__data.output
+#define STANDARD_INPUT						\
+    lisp__data.standard_input->data.atom->property->value
+#define STANDARD_OUTPUT						\
+    lisp__data.standard_output->data.atom->property->value
+#define STANDARDSTREAM(file, desc, flags)			\
+	LispNewStandardStream(file, desc, flags)
+
+/*
+ * Types
+ */
+typedef struct _LispStream LispStream;
+typedef struct _LispBlock LispBlock;
+typedef struct _LispOpaque LispOpaque;
+typedef struct _LispModule LispModule;
+typedef struct _LispProperty LispProperty;
+typedef struct _LispObjList LispObjList;
+typedef struct _LispStringHash LispStringHash;
+typedef struct _LispCharInfo LispCharInfo;
+
+
+/* Normal function/macro arguments */
+typedef struct _LispNormalArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+} LispNormalArgs;
+
+/* &optional function/macro arguments */
+typedef struct _LispOptionalArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+    LispObj **defaults;		/* default values, when unspecifed */
+    LispObj **sforms;		/* T if variable specified, NIL otherwise */
+} LispOptionalArgs;
+
+/* &key function/macro arguments */
+typedef struct _LispKeyArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+    LispObj **defaults;		/* default values */
+    LispObj **sforms;		/* T if variable specified, NIL otherwise */
+    LispObj **keys;		/* key names, for special keywords */
+} LispKeyArgs;
+
+/* &aux function/macro arguments */
+typedef struct _LispAuxArgs {
+    int num_symbols;
+    LispObj **symbols;		/* symbol names */
+    LispObj **initials;		/* initial values */
+} LispAuxArgs;
+
+/* characters in the field description have the format:
+ *	'.'	normals has a list of normal arguments
+ *	'o'	optionals has a list of &optional arguments
+ *	'k'	keys has a list of &key arguments
+ *	'r'	rest is a valid pointer to a &rest symbol
+ *	'a'	auxs has a list of &aux arguments
+ */
+typedef struct _LispArgList {
+    LispNormalArgs normals;
+    LispOptionalArgs optionals;
+    LispKeyArgs keys;
+    LispObj *rest;
+    LispAuxArgs auxs;
+    int num_arguments;
+    char *description;
+} LispArgList;
+
+typedef enum _LispDocType_t {
+    LispDocVariable,
+    LispDocFunction,
+    LispDocStructure,
+    LispDocType,
+    LispDocSetf
+} LispDocType_t;
+
+struct _LispProperty {
+    /* may be used by multiple packages */
+    unsigned int refcount;
+
+    /* package where the property was created */
+    LispPackage *package;
+
+    /* value of variable attached to symbol */
+    LispObj *value;
+
+    union {
+	/* function attached to symbol */
+	LispObj *function;
+	/* builtin function attached to symbol*/
+	LispBuiltin *builtin;
+    } fun;
+    /* function/macro argument list description */
+    LispArgList *alist;
+
+    /* symbol properties list */
+    LispObj *properties;
+
+    /* setf method */
+    LispObj *setf;
+    /* setf argument list description */
+    LispArgList *salist;
+
+    /* structure information */
+    struct {
+	LispObj *definition;
+#define STRUCT_NAME		-3
+#define STRUCT_CHECK		-2
+#define STRUCT_CONSTRUCTOR	-1
+	int function;		/* if >= 0, it is a structure field index */
+    } structure;
+};
+
+struct _LispAtom {
+    /* hint: dynamically binded variable */
+    unsigned int dyn : 1;
+
+    /* Property has useful data in value field */
+    unsigned int a_object : 1;
+    /* Property has useful data in fun.function field */
+    unsigned int a_function : 1;
+    /* Property has useful data in fun.builtin field */
+    unsigned int a_builtin : 1;
+    /* Property has useful data in fun.function field */
+    unsigned int a_compiled : 1;
+    /* Property has useful data in properties field */
+    unsigned int a_property : 1;
+    /* Property has useful data in setf field */
+    unsigned int a_defsetf : 1;
+    /* Property has useful data in defstruct field */
+    unsigned int a_defstruct : 1;
+
+    /* Symbol is extern */
+    unsigned int ext : 1;
+
+    /* Symbol must be quoted with '|' to be allow reading back */
+    unsigned int unreadable : 1;
+
+    /* Symbol value may need special handling when changed */
+    unsigned int watch : 1;
+
+    /* Symbol value is constant, cannot be changed */
+    unsigned int constant : 1;
+
+    char *string;
+    LispObj *object;		/* backpointer to object ATOM */
+    int offset;			/* in the environment list */
+    LispObj *package;		/* package home of symbol */
+    LispObj *function;		/* symbol function */
+    LispObj *name;		/* symbol string */
+    LispProperty *property;
+    struct _LispAtom *next;
+
+    LispObj *documentation[5];
+};
+
+struct _LispObjList {
+    LispObj **pairs;		/* name0 ... nameN */
+    int length;			/* number of objects */
+    int space;			/* space allocated in field pairs */
+};
+
+struct _LispPackage {
+    LispObjList glb;		/* global symbols in package */
+    LispObjList use;		/* inherited packages */
+    LispAtom *atoms[STRTBLSZ];	/* atoms in this package */
+};
+
+struct _LispOpaque {
+    int type;
+    char *desc;
+    LispOpaque *next;
+};
+
+/* These strings are never released, they are used to avoid
+ * the need of strcmp() on two symbol names, just compare pointers */
+struct _LispStringHash {
+    char *string;
+    LispStringHash *next;
+};
+
+typedef enum _LispBlockType {
+    LispBlockNone,	/* no block */
+    LispBlockTag,	/* may become "invisible" */
+    LispBlockCatch,	/* can be used to jump across function calls */
+    LispBlockClosure,	/* hides blocks of type LispBlockTag bellow it */
+    LispBlockProtect,	/* used by unwind-protect */
+    LispBlockBody	/* used by tagbody and go */
+} LispBlockType;
+
+struct _LispBlock {
+    LispBlockType type;
+    LispObj *tag;
+    jmp_buf jmp;
+    int stack;
+    int protect;
+    int block_level;
+#ifdef DEBUGGER
+    int debug_level;
+    int debug_step;
+#endif
+};
+
+struct _LispModule {
+    LispModule *next;
+    void *handle;
+    LispModuleData *data;
+};
+
+typedef struct _LispUngetInfo {
+    char buffer[16];
+    int offset;
+} LispUngetInfo;
+
+struct _LispMac {
+    /* stack for builtin function arguments */
+    struct {
+	LispObj **values;
+	int base;		/* base of arguments to function */
+	int length;
+	int space;
+    } stack;
+
+    /* environment */
+    struct {
+	LispObj **values;
+	Atom_id *names;
+	int lex;		/* until where variables are visible */
+	int head;		/* top of environment */
+	int length;		/* number of used pairs */
+	int space;		/* number of objects in pairs */
+    } env;
+
+    struct {
+	LispObj **values;
+	int count;
+    } returns;
+
+    struct {
+	LispObj **objects;
+	int length;
+	int space;
+    } protect;
+
+    LispObj *package;		/* package object */
+    LispPackage *pack;		/* pointer to lisp__data.package->data.package.package */
+
+    /* fast access to the KEYWORD package */
+    LispObj *keyword;
+    LispPackage *key;
+
+    /* the LISP package */
+    LispObj *lisp;
+
+    /* only used if the package was changed, but an error generated
+     * before returning to the toplevel */
+    LispObj *savepackage;
+    LispPackage *savepack;
+
+    struct {
+	int block_level;
+	int block_size;
+	LispObj *block_ret;
+	LispBlock **block;
+    } block;
+
+    sigjmp_buf jmp;
+
+    struct {
+	unsigned int expandbits : 3;	/* code doesn't look like reusing cells
+					 * so try to have a larger number of
+					 * free cells */
+	unsigned int immutablebits : 1;	/* need to reset immutable bits */
+	unsigned int timebits : 1;	/* update gctime counter */
+	unsigned int count;
+	long gctime;
+	int average;			/* of cells freed after gc calls */
+    } gc;
+
+    LispStringHash *strings[STRTBLSZ];
+    LispOpaque *opqs[STRTBLSZ];
+    int opaque;
+
+    LispObj *standard_input, *input, *input_list;
+    LispObj *standard_output, *output, *output_list;
+    LispObj *error_stream;
+    LispUngetInfo **unget;
+    int iunget, nunget;
+    int eof;
+
+    int interactive;
+    int errexit;
+
+    struct {
+	int index;
+	int level;
+	int space;
+	void **mem;
+    } mem;		/* memory from Lisp*Alloc, to be release in error */
+    LispModule *module;
+    LispObj *modules;
+    char *prompt;
+
+    LispObj *features;
+
+    LispObj *modlist;		/* module list */
+    LispObj *packlist;		/* list of packages */
+    LispObj *codlist;		/* current code */
+    LispObj *runlist[3];	/* +, ++, and +++ */
+    LispObj *reslist[3];	/* *, **, and *** */
+#ifdef DEBUGGER
+    LispObj *dbglist;		/* debug information */
+    LispObj *brklist;		/* breakpoints information */
+#endif
+    LispObj *prolist;		/* protect objects list */
+
+#ifdef SIGNALRETURNSINT
+    int (*sigint)(int);
+    int (*sigfpe)(int);
+#else
+    void (*sigint)(int);
+    void (*sigfpe)(int);
+#endif
+
+    int destroyed;		/* reached LispDestroy, used by unwind-protect */
+    int running;		/* there is somewhere to siglongjmp */
+
+    int ignore_errors;		/* inside a ignore-errors block */
+    LispObj *error_condition;	/* actually, a string */
+
+    int debugging;		/* debugger enabled? */
+#ifdef DEBUGGER
+    int debug_level;		/* almost always the same as lisp__data.level */
+    int debug_step;		/* control for stoping and printing output */
+    int debug_break;		/* next breakpoint number */
+    LispDebugState debug;
+#endif
+};
+
+struct _LispCharInfo {
+    char **names;
+};
+
+
+/*
+ * Prototypes
+ */
+void LispUseArgList(LispArgList*);
+void LispFreeArgList(LispArgList*);
+LispArgList *LispCheckArguments(LispFunType, LispObj*, char*, int);
+LispObj *LispListProtectedArguments(LispArgList*);
+
+LispObj *LispGetDoc(LispObj*);
+LispObj *LispGetVar(LispObj*);
+#ifdef DEBUGGER
+void *LispGetVarAddr(LispObj*);	/* used by debugger */
+#endif
+LispObj *LispAddVar(LispObj*, LispObj*);
+LispObj *LispSetVar(LispObj*, LispObj*);
+void LispUnsetVar(LispObj*);
+
+	/* only used at initialization time */
+LispObj *LispNewStandardStream(LispFile*, LispObj*, int);
+
+	/* create a new package */
+LispObj *LispNewPackage(LispObj*, LispObj*);
+	/* add package to use-list of current, and imports all extern symbols */
+void LispUsePackage(LispObj*);
+	/* make symbol extern in the current package */
+void LispExportSymbol(LispObj*);
+	/* imports symbol to current package */
+void LispImportSymbol(LispObj*);
+
+	/* always returns the same string */
+char *LispGetAtomString(char*, int);
+
+/* destructive fast reverse, note that don't receive a LispMac* argument */
+LispObj *LispReverse(LispObj *list);
+
+char *LispIntToOpaqueType(int);
+
+/* (print) */
+void LispPrint(LispObj*, LispObj*, int);
+
+LispBlock *LispBeginBlock(LispObj*, LispBlockType);
+#define BLOCKJUMP(block)				\
+    lisp__data.stack.length = (block)->stack;		\
+    lisp__data.protect.length = (block)->protect;	\
+    longjmp((block)->jmp, 1)
+void LispEndBlock(LispBlock*);
+	/* if unwind-protect active, jump to cleanup code, else do nothing */
+void LispBlockUnwind(LispBlock*);
+
+void LispUpdateResults(LispObj*, LispObj*);
+void LispTopLevel(void);
+
+#define STRHASH(string)		LispDoHashString(string)
+int LispDoHashString(char*);
+LispAtom *LispDoGetAtom(char *str, int);
+	/* get value from atom's property list */
+LispObj *LispGetAtomProperty(LispAtom*, LispObj*);
+	/* put value in atom's property list */
+LispObj *LispPutAtomProperty(LispAtom*, LispObj*, LispObj*);
+	/* remove value from atom's property list */
+LispObj *LispRemAtomProperty(LispAtom*, LispObj*);
+	/* replace atom's property list */
+LispObj *LispReplaceAtomPropertyList(LispAtom*, LispObj*);
+
+	/* returns function associated with symbol */
+LispObj *LispSymbolFunction(LispObj*);
+	/* returns symbol string name */
+LispObj *LispSymbolName(LispObj*);
+
+	/* define byte compiled function, or replace definition */
+void LispSetAtomCompiledProperty(LispAtom*, LispObj*);
+	/* remove byte compiled function property */
+void LispRemAtomCompiledProperty(LispAtom*);
+	/* define function, or replace function definition */
+void LispSetAtomFunctionProperty(LispAtom*, LispObj*, LispArgList*);
+	/* remove function property */
+void LispRemAtomFunctionProperty(LispAtom*);
+	/* define builtin, or replace builtin definition */
+void LispSetAtomBuiltinProperty(LispAtom*, LispBuiltin*, LispArgList*);
+	/* remove builtin property */
+void LispRemAtomBuiltinProperty(LispAtom*);
+	/* define setf macro, or replace current definition */
+void LispSetAtomSetfProperty(LispAtom*, LispObj*, LispArgList*);
+	/* remove setf macro */
+void LispRemAtomSetfProperty(LispAtom*);
+	/* create or change structure property */
+void LispSetAtomStructProperty(LispAtom*, LispObj*, int);
+	/* remove structure property */
+void LispRemAtomStructProperty(LispAtom*);
+
+void LispProclaimSpecial(LispObj*, LispObj*, LispObj*);
+void LispDefconstant(LispObj*, LispObj*, LispObj*);
+
+void LispAddDocumentation(LispObj*, LispObj*, LispDocType_t);
+void LispRemDocumentation(LispObj*, LispDocType_t);
+LispObj *LispGetDocumentation(LispObj*, LispDocType_t);
+
+/* increases storage for functions returning multiple values */
+void LispMoreReturns(void);
+
+/* increases storage for temporarily protected data */
+void LispMoreProtects(void);
+
+/* Initialization */
+extern int LispArgList_t;
+extern LispCharInfo LispChars[256];
+
+/* This function will return if the interpreter cannot be stopped */
+extern void LispSignal(int);
+
+void LispDisableInterrupts(void);
+void LispEnableInterrupts(void);
+#define DISABLE_INTERRUPTS()	LispDisableInterrupts()
+#define ENABLE_INTERRUPTS()	LispEnableInterrupts()
+
+/* Value returned by LispBegin, used everywhere in the code.
+ * Only one interpreter instance allowed. */
+extern LispMac lisp__data;
+
+#endif /* Lisp_private_h */