Home | History | Annotate | Line # | Download | only in lisp
      1 /*
      2  * Copyright (c) 2001 by The XFree86 Project, Inc.
      3  *
      4  * Permission is hereby granted, free of charge, to any person obtaining a
      5  * copy of this software and associated documentation files (the "Software"),
      6  * to deal in the Software without restriction, including without limitation
      7  * the rights to use, copy, modify, merge, publish, distribute, sublicense,
      8  * and/or sell copies of the Software, and to permit persons to whom the
      9  * Software is furnished to do so, subject to the following conditions:
     10  *
     11  * The above copyright notice and this permission notice shall be included in
     12  * all copies or substantial portions of the Software.
     13  *
     14  * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     15  * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
     16  * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL
     17  * THE XFREE86 PROJECT BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
     18  * WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
     19  * OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
     20  * SOFTWARE.
     21  *
     22  * Except as contained in this notice, the name of the XFree86 Project shall
     23  * not be used in advertising or otherwise to promote the sale, use or other
     24  * dealings in this Software without prior written authorization from the
     25  * XFree86 Project.
     26  *
     27  * Author: Paulo Csar Pereira de Andrade
     28  */
     29 
     30 /* $XdotOrg: xc/programs/xedit/lisp/private.h,v 1.2 2004/04/23 19:54:44 eich Exp $ */
     31 /* $XFree86: xc/programs/xedit/lisp/private.h,v 1.41 2003/05/27 22:27:04 tsi Exp $ */
     32 
     33 #ifndef Lisp_private_h
     34 #define Lisp_private_h
     35 
     36 #include <X11/Xos.h>
     37 #include <stdio.h>
     38 #include <stdlib.h>
     39 #include <string.h>
     40 #if defined(X_POSIX_C_SOURCE)
     41 #define _POSIX_C_SOURCE X_POSIX_C_SOURCE
     42 #include <setjmp.h>
     43 #undef _POSIX_C_SOURCE
     44 #else
     45 #include <setjmp.h>
     46 #endif
     47 #include <unistd.h>
     48 #include <sys/time.h>
     49 #include "lisp/internal.h"
     50 
     51 #include "lisp/core.h"
     52 #ifdef DEBUGGER
     53 #include "lisp/debugger.h"
     54 #endif
     55 #include "lisp/helper.h"
     56 #include "lisp/string.h"
     57 #include "lisp/struct.h"
     58 
     59 /*
     60  * Defines
     61  */
     62 #define	STRTBLSZ		23
     63 #define MULTIPLE_VALUES_LIMIT	127
     64 #define MAX_STACK_DEPTH		16384
     65 
     66 #define FEATURES							\
     67     (lisp__data.features->data.atom->a_object ?				\
     68 	(LispObj *)lisp__data.features->data.atom->property->value :	\
     69 	NIL)
     70 #define PACK	lisp__data.packlist
     71 #undef PACKAGE /* avoid conflicts with autoconf's #define in config.h */
     72 #define PACKAGE	lisp__data.package->data.atom->property->value
     73 #define MOD	lisp__data.modlist
     74 #define COD	lisp__data.codlist
     75 #define RUN	lisp__data.runlist
     76 #define RES	lisp__data.reslist
     77 #define DBG	lisp__data.dbglist
     78 #define BRK	lisp__data.brklist
     79 #define PRO	lisp__data.prolist
     80 
     81 #define SINPUT	lisp__data.input
     82 #define SOUTPUT	lisp__data.output
     83 #define STANDARD_INPUT						\
     84     lisp__data.standard_input->data.atom->property->value
     85 #define STANDARD_OUTPUT						\
     86     lisp__data.standard_output->data.atom->property->value
     87 #define STANDARDSTREAM(file, desc, flags)			\
     88 	LispNewStandardStream(file, desc, flags)
     89 
     90 /*
     91  * Types
     92  */
     93 typedef struct _LispStream LispStream;
     94 typedef struct _LispBlock LispBlock;
     95 typedef struct _LispOpaque LispOpaque;
     96 typedef struct _LispModule LispModule;
     97 typedef struct _LispProperty LispProperty;
     98 typedef struct _LispObjList LispObjList;
     99 typedef struct _LispStringHash LispStringHash;
    100 typedef struct _LispCharInfo LispCharInfo;
    101 
    102 
    103 /* Normal function/macro arguments */
    104 typedef struct _LispNormalArgs {
    105     int num_symbols;
    106     LispObj **symbols;		/* symbol names */
    107 } LispNormalArgs;
    108 
    109 /* &optional function/macro arguments */
    110 typedef struct _LispOptionalArgs {
    111     int num_symbols;
    112     LispObj **symbols;		/* symbol names */
    113     LispObj **defaults;		/* default values, when unspecifed */
    114     LispObj **sforms;		/* T if variable specified, NIL otherwise */
    115 } LispOptionalArgs;
    116 
    117 /* &key function/macro arguments */
    118 typedef struct _LispKeyArgs {
    119     int num_symbols;
    120     LispObj **symbols;		/* symbol names */
    121     LispObj **defaults;		/* default values */
    122     LispObj **sforms;		/* T if variable specified, NIL otherwise */
    123     LispObj **keys;		/* key names, for special keywords */
    124 } LispKeyArgs;
    125 
    126 /* &aux function/macro arguments */
    127 typedef struct _LispAuxArgs {
    128     int num_symbols;
    129     LispObj **symbols;		/* symbol names */
    130     LispObj **initials;		/* initial values */
    131 } LispAuxArgs;
    132 
    133 /* characters in the field description have the format:
    134  *	'.'	normals has a list of normal arguments
    135  *	'o'	optionals has a list of &optional arguments
    136  *	'k'	keys has a list of &key arguments
    137  *	'r'	rest is a valid pointer to a &rest symbol
    138  *	'a'	auxs has a list of &aux arguments
    139  */
    140 typedef struct _LispArgList {
    141     LispNormalArgs normals;
    142     LispOptionalArgs optionals;
    143     LispKeyArgs keys;
    144     LispObj *rest;
    145     LispAuxArgs auxs;
    146     int num_arguments;
    147     char *description;
    148 } LispArgList;
    149 
    150 typedef enum _LispDocType_t {
    151     LispDocVariable,
    152     LispDocFunction,
    153     LispDocStructure,
    154     LispDocType,
    155     LispDocSetf
    156 } LispDocType_t;
    157 
    158 struct _LispProperty {
    159     /* may be used by multiple packages */
    160     unsigned int refcount;
    161 
    162     /* package where the property was created */
    163     LispPackage *package;
    164 
    165     /* value of variable attached to symbol */
    166     LispObj *value;
    167 
    168     union {
    169 	/* function attached to symbol */
    170 	LispObj *function;
    171 	/* builtin function attached to symbol*/
    172 	LispBuiltin *builtin;
    173     } fun;
    174     /* function/macro argument list description */
    175     LispArgList *alist;
    176 
    177     /* symbol properties list */
    178     LispObj *properties;
    179 
    180     /* setf method */
    181     LispObj *setf;
    182     /* setf argument list description */
    183     LispArgList *salist;
    184 
    185     /* structure information */
    186     struct {
    187 	LispObj *definition;
    188 #define STRUCT_NAME		-3
    189 #define STRUCT_CHECK		-2
    190 #define STRUCT_CONSTRUCTOR	-1
    191 	int function;		/* if >= 0, it is a structure field index */
    192     } structure;
    193 };
    194 
    195 struct _LispAtom {
    196     hash_key *key;
    197     struct _LispAtom *next;
    198 
    199     /* hint: dynamically binded variable */
    200     unsigned int dyn : 1;
    201 
    202     /* Property has useful data in value field */
    203     unsigned int a_object : 1;
    204     /* Property has useful data in fun.function field */
    205     unsigned int a_function : 1;
    206     /* Property has useful data in fun.builtin field */
    207     unsigned int a_builtin : 1;
    208     /* Property has useful data in fun.function field */
    209     unsigned int a_compiled : 1;
    210     /* Property has useful data in properties field */
    211     unsigned int a_property : 1;
    212     /* Property has useful data in setf field */
    213     unsigned int a_defsetf : 1;
    214     /* Property has useful data in defstruct field */
    215     unsigned int a_defstruct : 1;
    216 
    217     /* Symbol is extern */
    218     unsigned int ext : 1;
    219 
    220     /* Symbol must be quoted with '|' to be allow reading back */
    221     unsigned int unreadable : 1;
    222 
    223     /* Symbol value may need special handling when changed */
    224     unsigned int watch : 1;
    225 
    226     /* Symbol value is constant, cannot be changed */
    227     unsigned int constant : 1;
    228 
    229     LispObj *object;		/* backpointer to object ATOM */
    230     int offset;			/* in the environment list */
    231     LispObj *package;		/* package home of symbol */
    232     LispObj *function;		/* symbol function */
    233     LispObj *name;		/* symbol string */
    234     LispProperty *property;
    235 
    236     LispObj *documentation[5];
    237 };
    238 
    239 struct _LispObjList {
    240     LispObj **pairs;		/* name0 ... nameN */
    241     int length;			/* number of objects */
    242     int space;			/* space allocated in field pairs */
    243 };
    244 
    245 struct _LispPackage {
    246     LispObjList glb;		/* global symbols in package */
    247     LispObjList use;		/* inherited packages */
    248     hash_table *atoms;		/* atoms in this package */
    249 };
    250 
    251 struct _LispOpaque {
    252     hash_key *desc;
    253     LispOpaque *next;
    254     int type;
    255 };
    256 
    257 typedef enum _LispBlockType {
    258     LispBlockNone,	/* no block */
    259     LispBlockTag,	/* may become "invisible" */
    260     LispBlockCatch,	/* can be used to jump across function calls */
    261     LispBlockClosure,	/* hides blocks of type LispBlockTag bellow it */
    262     LispBlockProtect,	/* used by unwind-protect */
    263     LispBlockBody	/* used by tagbody and go */
    264 } LispBlockType;
    265 
    266 struct _LispBlock {
    267     LispBlockType type;
    268     LispObj *tag;
    269     jmp_buf jmp;
    270     int stack;
    271     int protect;
    272     int block_level;
    273 #ifdef DEBUGGER
    274     int debug_level;
    275     int debug_step;
    276 #endif
    277 };
    278 
    279 struct _LispModule {
    280     LispModule *next;
    281     void *handle;
    282     LispModuleData *data;
    283 };
    284 
    285 typedef struct _LispUngetInfo {
    286     char buffer[16];
    287     int offset;
    288 } LispUngetInfo;
    289 
    290 struct _LispMac {
    291     /* stack for builtin function arguments */
    292     struct {
    293 	LispObj **values;
    294 	int base;		/* base of arguments to function */
    295 	int length;
    296 	int space;
    297     } stack;
    298 
    299     /* environment */
    300     struct {
    301 	LispObj **values;
    302 	Atom_id *names;
    303 	int lex;		/* until where variables are visible */
    304 	int head;		/* top of environment */
    305 	int length;		/* number of used pairs */
    306 	int space;		/* number of objects in pairs */
    307     } env;
    308 
    309     struct {
    310 	LispObj **values;
    311 	int count;
    312     } returns;
    313 
    314     struct {
    315 	LispObj **objects;
    316 	int length;
    317 	int space;
    318     } protect;
    319 
    320     LispObj *package;		/* package object */
    321     LispPackage *pack;		/* pointer to lisp__data.package->data.package.package */
    322 
    323     /* fast access to the KEYWORD package */
    324     LispObj *keyword;
    325     LispPackage *key;
    326 
    327     /* the LISP package */
    328     LispObj *lisp;
    329 
    330     /* only used if the package was changed, but an error generated
    331      * before returning to the toplevel */
    332     LispObj *savepackage;
    333     LispPackage *savepack;
    334 
    335     struct {
    336 	int block_level;
    337 	int block_size;
    338 	LispObj *block_ret;
    339 	LispBlock **block;
    340     } block;
    341 
    342     sigjmp_buf jmp;
    343 
    344     struct {
    345 	unsigned int expandbits : 3;	/* code doesn't look like reusing cells
    346 					 * so try to have a larger number of
    347 					 * free cells */
    348 	unsigned int immutablebits : 1;	/* need to reset immutable bits */
    349 	unsigned int timebits : 1;	/* update gctime counter */
    350 	unsigned int count;
    351 	long gctime;
    352 	int average;			/* of cells freed after gc calls */
    353     } gc;
    354 
    355     hash_table	*strings;
    356     hash_table	*opqs;
    357     int opaque;
    358 
    359     LispObj *standard_input, *input, *input_list;
    360     LispObj *standard_output, *output, *output_list;
    361     LispObj *error_stream;
    362     LispUngetInfo **unget;
    363     int iunget, nunget;
    364     int eof;
    365 
    366     int interactive;
    367     int errexit;
    368 
    369     struct {
    370 	int index;
    371 	int level;
    372 	int space;
    373 	void **mem;
    374     } mem;		/* memory from Lisp*Alloc, to be release in error */
    375     LispModule *module;
    376     LispObj *modules;
    377     const char *prompt;
    378 
    379     LispObj *features;
    380 
    381     LispObj *modlist;		/* module list */
    382     LispObj *packlist;		/* list of packages */
    383     LispObj *codlist;		/* current code */
    384     LispObj *runlist[3];	/* +, ++, and +++ */
    385     LispObj *reslist[3];	/* *, **, and *** */
    386 #ifdef DEBUGGER
    387     LispObj *dbglist;		/* debug information */
    388     LispObj *brklist;		/* breakpoints information */
    389 #endif
    390     LispObj *prolist;		/* protect objects list */
    391 
    392     void (*sigint)(int);
    393     void (*sigfpe)(int);
    394 
    395     int destroyed;		/* reached LispDestroy, used by unwind-protect */
    396     int running;		/* there is somewhere to siglongjmp */
    397 
    398     int ignore_errors;		/* inside a ignore-errors block */
    399     LispObj *error_condition;	/* actually, a string */
    400 
    401     int debugging;		/* debugger enabled? */
    402 #ifdef DEBUGGER
    403     int debug_level;		/* almost always the same as lisp__data.level */
    404     int debug_step;		/* control for stoping and printing output */
    405     int debug_break;		/* next breakpoint number */
    406     LispDebugState debug;
    407 #endif
    408 };
    409 
    410 struct _LispCharInfo {
    411     const char * const *names;
    412 };
    413 
    414 
    415 /*
    416  * Prototypes
    417  */
    418 void LispUseArgList(LispArgList*);
    419 void LispFreeArgList(LispArgList*);
    420 LispArgList *LispCheckArguments(LispFunType, LispObj*, const char*, int);
    421 LispObj *LispListProtectedArguments(LispArgList*);
    422 
    423 LispObj *LispGetDoc(LispObj*);
    424 LispObj *LispGetVar(LispObj*);
    425 #ifdef DEBUGGER
    426 void *LispGetVarAddr(LispObj*);	/* used by debugger */
    427 #endif
    428 LispObj *LispAddVar(LispObj*, LispObj*);
    429 LispObj *LispSetVar(LispObj*, LispObj*);
    430 void LispUnsetVar(LispObj*);
    431 
    432 	/* only used at initialization time */
    433 LispObj *LispNewStandardStream(LispFile*, LispObj*, int);
    434 
    435 	/* create a new package */
    436 LispObj *LispNewPackage(LispObj*, LispObj*);
    437 	/* add package to use-list of current, and imports all extern symbols */
    438 void LispUsePackage(LispObj*);
    439 	/* make symbol extern in the current package */
    440 void LispExportSymbol(LispObj*);
    441 	/* imports symbol to current package */
    442 void LispImportSymbol(LispObj*);
    443 
    444 	/* always returns the same string */
    445 hash_key *LispGetAtomKey(const char*, int);
    446 
    447 /* destructive fast reverse, note that don't receive a LispMac* argument */
    448 LispObj *LispReverse(LispObj *list);
    449 
    450 char *LispIntToOpaqueType(int);
    451 
    452 /* (print) */
    453 void LispPrint(LispObj*, LispObj*, int);
    454 
    455 LispBlock *LispBeginBlock(LispObj*, LispBlockType);
    456 #define BLOCKJUMP(block)				\
    457     lisp__data.stack.length = (block)->stack;		\
    458     lisp__data.protect.length = (block)->protect;	\
    459     longjmp((block)->jmp, 1)
    460 void LispEndBlock(LispBlock*);
    461 	/* if unwind-protect active, jump to cleanup code, else do nothing */
    462 void LispBlockUnwind(LispBlock*);
    463 
    464 void LispUpdateResults(LispObj*, LispObj*);
    465 void LispTopLevel(void);
    466 
    467 LispAtom *LispDoGetAtom(const char *str, int);
    468 	/* get value from atom's property list */
    469 LispObj *LispGetAtomProperty(LispAtom*, LispObj*);
    470 	/* put value in atom's property list */
    471 LispObj *LispPutAtomProperty(LispAtom*, LispObj*, LispObj*);
    472 	/* remove value from atom's property list */
    473 LispObj *LispRemAtomProperty(LispAtom*, LispObj*);
    474 	/* replace atom's property list */
    475 LispObj *LispReplaceAtomPropertyList(LispAtom*, LispObj*);
    476 
    477 	/* returns function associated with symbol */
    478 LispObj *LispSymbolFunction(LispObj*);
    479 	/* returns symbol string name */
    480 LispObj *LispSymbolName(LispObj*);
    481 
    482 	/* define byte compiled function, or replace definition */
    483 void LispSetAtomCompiledProperty(LispAtom*, LispObj*);
    484 	/* remove byte compiled function property */
    485 void LispRemAtomCompiledProperty(LispAtom*);
    486 	/* define function, or replace function definition */
    487 void LispSetAtomFunctionProperty(LispAtom*, LispObj*, LispArgList*);
    488 	/* remove function property */
    489 void LispRemAtomFunctionProperty(LispAtom*);
    490 	/* define builtin, or replace builtin definition */
    491 void LispSetAtomBuiltinProperty(LispAtom*, LispBuiltin*, LispArgList*);
    492 	/* remove builtin property */
    493 void LispRemAtomBuiltinProperty(LispAtom*);
    494 	/* define setf macro, or replace current definition */
    495 void LispSetAtomSetfProperty(LispAtom*, LispObj*, LispArgList*);
    496 	/* remove setf macro */
    497 void LispRemAtomSetfProperty(LispAtom*);
    498 	/* create or change structure property */
    499 void LispSetAtomStructProperty(LispAtom*, LispObj*, int);
    500 	/* remove structure property */
    501 void LispRemAtomStructProperty(LispAtom*);
    502 
    503 void LispProclaimSpecial(LispObj*, LispObj*, LispObj*);
    504 void LispDefconstant(LispObj*, LispObj*, LispObj*);
    505 
    506 void LispAddDocumentation(LispObj*, LispObj*, LispDocType_t);
    507 void LispRemDocumentation(LispObj*, LispDocType_t);
    508 LispObj *LispGetDocumentation(LispObj*, LispDocType_t);
    509 
    510 /* increases storage for functions returning multiple values */
    511 void LispMoreReturns(void);
    512 
    513 /* increases storage for temporarily protected data */
    514 void LispMoreProtects(void);
    515 
    516 /* Initialization */
    517 extern int LispArgList_t;
    518 extern const LispCharInfo LispChars[256];
    519 
    520 /* This function will return if the interpreter cannot be stopped */
    521 extern void LispSignal(int);
    522 
    523 void LispDisableInterrupts(void);
    524 void LispEnableInterrupts(void);
    525 #define DISABLE_INTERRUPTS()	LispDisableInterrupts()
    526 #define ENABLE_INTERRUPTS()	LispEnableInterrupts()
    527 
    528 /* Value returned by LispBegin, used everywhere in the code.
    529  * Only one interpreter instance allowed. */
    530 extern LispMac lisp__data;
    531 
    532 #endif /* Lisp_private_h */
    533