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 César 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