[unix-history] / usr / src / ucb / lisp / franz / data.c

#ifndef lint
static char *rcsid =
   "$Header: data.c,v 1.8 85/03/24 11:02:24 sklower Exp $";
#endif

/*					-[Sun Jun 19 14:41:00 1983 by jkf]-
 * 	data.c				$Locker:  $
 * static storage declarations
 *
 * (c) copyright 1982, Regents of the University of California
 */


#include 	"global.h"
#include	"gtabs.h"
#include	"structs.h"
#include	"frame.h"
#include	<stdio.h>

/*char firstalloc[NBPG] = { 'x' };	/* first thing allocated in file */
lispval lispsys[SIGNIF];	/* lisp data used by system */

lispval gftab[GFTABLEN];	/* global function table for interpreter */

lispval gctab[GCTABLEN] = 	/* global constant table for interpreter */
	{nil,0,SMALL(-1),SMALL(0),SMALL(1),SMALL(2),SMALL(3),SMALL(4)};


/* Port definitions *****************************************************/
FILE	*piport,		/* standard input port		*/
	*poport,		/* standard output port		*/
	*errport,		/* port for error messages	*/
	*rdrport,		/* temporary port for readr	*/
	*proport;		/* port for protocal		*/
int	lineleng =	80;		/* line length desired		*/
int	rlevel;			/* used to indicate depth of recursion
				   in reader.  No longer really necessary */
char	keybin =	FALSE;		/* logical flag: using keyboard	*/
char	protflag =	FALSE;		/* logical flag: want protocall */
char	rbktf;				/* logical flag: ] mode		*/

#ifdef RTPORTS
lispval ioname[128];		/* strings of names of files currently open	*/
#else 
lispval ioname[_NFILE];		/* strings of names of files currently open	*/
#endif

/* name stack ***********************************************************/
struct argent *orgnp;		/* used by top level to reset to start  */
struct argent		*namptr,		/* temporary pointer	*/
#ifndef NPINREG
			*lbot,			/* beginning of frame	*/
			*np,			/* first free entry   	*/
#endif
			*nplim;			/* don't have this = np	*/
struct nament		*bnp,			/* top of bind stack    */
			*orgbnp,		/* absolute bottom of ""*/
			*bnplim;		/* absolute top of ""   */


/* hashing things *******************************************************/
int	hash;					/* set by ratom		*/
int	atmlen;			/* length of atom including final null	*/


/* big string buffer for whomever needs it ******************************/
static char	i_strbuf[600];
char	*strbuf		= i_strbuf;
char	*endstrb	= i_strbuf + 599;

/* in the case we can't use the C stack for extending automatics */
#ifdef SPISFP
long xstack[16384];
long *xsp;
long *exsp = xstack + ((sizeof xstack)/(sizeof (long)));
#endif

/* strings needed by the two hand crafted atoms, nil and eof */
char nilpname[] = "nil";
char eofpname[] = "eof";

/* set by sstatus commands */
int uctolc = 0;		/* when set, uc chars in atoms go to lc */
			/* default mode for dumplisp 
			   (note this is decimal not octal) */
#if os_unisoft || os_unix_ts
int dmpmode = 410;
#else
int dmpmode = 413;
#endif

/* break and error declarations *****************************************/
int	depth =	0;		/* depth of nested breaks		*/
lispval	contval;		/* the value being returned up		*/
int	retval;			/* used by each error/prog call		*/
lispval lispretval;		/* used by non-local goto's		*/
int	rsetsw;			/* when set, trace frames built		*/
int	bcdtrsw;		/* when set with rsetsw, trace bcd too	*/
int 	evalhcallsw;		/* when set will not evalhook next eval */
int 	funhcallsw;		/* when set will not funcallhook next eval */


/* exception handling stuff *********************************************/
int exception;			/* true if an exception is pending */
int sigintcnt;			/* number of SIGINT's pending	   */

/* current state of the hole (for fasling into) *************************/
#ifndef HOLE
#define HOLE 0
#endif
extern char holbeg[];
char *curhbeg = holbeg;			/* next location to fasl into */
int usehole = HOLE;			/* if TRUE, fasl tries to use hole */
int holesize = HOLE;			/* This avoids an ifdef in dumplisp */

/* other stuff **********************************************************/
lispval	ftemp,vtemp,argptr,ttemp;	/* temporaries: use briefly	*/
int itemp;
lispval sigacts[16];			/* for catching interrupts	*/
int sigstruck,sigdelay;			/* for catching interrupts	*/
lispval stattab[16];			/* miscelleneous options	*/
lispval Vprintsym;			/* value is the symbol 'print'  */

/*  interpreter globals    */

int lctrace;
int fvirgin = 1;		/* set to 1 initially 			*/
int gctime;
struct frame *errp;		/* stack of error frames 		*/


/* global pointers to the transfer tables */


struct trtab *trhead=		/* first in list of transfer tables 	   */
      (struct trtab *) 0;
struct trent *trcur;		/* next entry to allocate	    	   */
int trleft = 0;			/* number of entries left in current table */

/* globals from sysat.c  */

int *beginsweep;		/* place for sweeper to begin 		*/
int initflag = TRUE;		/* inhibit gcing initially		*/
int tgcthresh = 15;
int page_limit = (5 * TTSIZE) / 6;
int ttsize = TTSIZE;


/* global used in io.c */

lispval lastrtab;

/* globals from [VT]alloc.c  */


char purepage[TTSIZE];
int fakettsize = TTSIZE - 8;
int gcstrings;				/*  Do we mark and sweep strings? */
int  *bind_lists = (int *) CNIL;	/*  lisp data for compiled code */


struct str_x str_current[2];		/*  next free string spaces */

struct types
	atom_str =
	{
		(char *)CNIL,	0,	ATOMSPP,	ATOM,	5,
		&atom_items,	&atom_pages,	&atom_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	strng_str =
	{
		(char *) CNIL,	0,	STRSPP,		STRNG,	128,
		&str_items,	&str_pages,	&str_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	int_str =
	{
		(char *) CNIL,	0,	INTSPP,		INT,	1,
		&int_items,	&int_pages,	&int_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	dtpr_str =
	{
		(char *) CNIL,	0,	DTPRSPP,	DTPR,	2,
		&dtpr_items,	&dtpr_pages,	&dtpr_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	doub_str =
	{
		(char *) CNIL,	0,	DOUBSPP,	DOUB,	2,
		&doub_items,	&doub_pages,	&doub_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	array_str =
	{
		(char *) CNIL,	0,	ARRAYSPP,	ARRAY,	5,
		&array_items,	&array_pages,	&array_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	other_str =
	{
		(char *) CNIL,	0,	STRSPP,		OTHER,	128,
		&other_items,	&other_pages,	&other_name,
		(struct heads *) CNIL, (char *)CNIL
	},

	sdot_str =
	{
		(char *) CNIL,	0,	SDOTSPP,	SDOT,	2,
		&sdot_items,	&sdot_pages,	&sdot_name,
		(struct heads *) CNIL, (char *)CNIL
	},
	val_str =
	{
		(char *) CNIL,	0,	VALSPP,		VALUE,	1,
		&val_items,	&val_pages,	&val_name,
		(struct heads *) CNIL, (char *)CNIL
	},
funct_str =
	{
		(char *) CNIL,	0,	BCDSPP,		BCD,	2,
		&funct_items,	&funct_pages,	&funct_name,
		(struct heads *) CNIL, (char *)CNIL
	},
vect_str =
	{
	        
		(char *) CNIL,	0,	VECTORSPP,	VECTOR,	1,
		&vect_items,	&vect_pages,	&vect_name,
		(struct heads *) CNIL, (char *)CNIL
	},
vecti_str =
	{
	        
		(char *) CNIL,	0,	VECTORSPP,	VECTORI, 1,
		&vect_items,	&vecti_pages,	&vecti_name,
		(struct heads *) CNIL, (char *)CNIL
	},

hunk_str[7] =
	{
		{
			(char *) CNIL,	0,	HUNK2SPP,	HUNK2,	2,
			&hunk_items[0],	&hunk_pages[0],	&hunk_name[0],
			(struct heads *) CNIL, (char *)CNIL
		},
		{
			(char *) CNIL,	0,	HUNK4SPP,	HUNK4,	4,
			&hunk_items[1],	&hunk_pages[1],	&hunk_name[1],
			(struct heads *) CNIL, (char *)CNIL
		},
		{
			(char *) CNIL,	0,	HUNK8SPP,	HUNK8,	8,
			&hunk_items[2],	&hunk_pages[2],	&hunk_name[2],
			(struct heads *) CNIL, (char *)CNIL
		},
		{
			(char *) CNIL,	0,	HUNK16SPP,	HUNK16,	16,
			&hunk_items[3],	&hunk_pages[3],	&hunk_name[3],
			(struct heads *) CNIL, (char *)CNIL
		},
		{
			(char *) CNIL,	0,	HUNK32SPP,	HUNK32,	32,
			&hunk_items[4],	&hunk_pages[4],	&hunk_name[4],
			(struct heads *) CNIL, (char *)CNIL
		},
		{
			(char *) CNIL,	0,	HUNK64SPP,	HUNK64,	64,
			&hunk_items[5],	&hunk_pages[5],	&hunk_name[5],
			(struct heads *) CNIL, (char *)CNIL
		},
		{
			(char *) CNIL,	0,	HUNK128SPP,	HUNK128, 128,
			&hunk_items[6],	&hunk_pages[6],	&hunk_name[6],
			(struct heads *) CNIL, (char *)CNIL
		}
	};
extern struct readtable { unsigned char	ctable[132]; } initread;
unsigned char *ctable = initread.ctable;
int gensymcounter = 0;

int hashtop = HASHTOP;
int xcycle = 0;		/* used by xsbrk   */
struct	atom *hasht[HASHTOP];
lispval datalim;	/* pointer to next location to allocate */

char typetable[TTSIZE+1] = {UNBO,ATOM,PORT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT};

/* this must be the last thing allocated in this file	*/
char lsbrkpnt,zfreespace;
Commit	Line	Data
0fa44b46 C	1	#ifndef lint
	2	static char *rcsid =
	3	"$Header: data.c,v 1.8 85/03/24 11:02:24 sklower Exp $";
	4	#endif
	5
	6	/* -[Sun Jun 19 14:41:00 1983 by jkf]-
	7	* data.c $Locker: $
	8	* static storage declarations
	9	*
	10	* (c) copyright 1982, Regents of the University of California
	11	*/
	12
	13
	14
	15	#include "global.h"
	16	#include "gtabs.h"
	17	#include "structs.h"
	18	#include "frame.h"
	19	#include <stdio.h>
	20
	21	/char firstalloc[NBPG] = { 'x' }; / first thing allocated in file */
	22	lispval lispsys[SIGNIF]; /* lisp data used by system */
	23
	24	lispval gftab[GFTABLEN]; /* global function table for interpreter */
	25
	26	lispval gctab[GCTABLEN] = /* global constant table for interpreter */
	27	{nil,0,SMALL(-1),SMALL(0),SMALL(1),SMALL(2),SMALL(3),SMALL(4)};
	28
	29
	30	/* Port definitions *****************************************************/
	31	FILE piport, / standard input port */
	32	poport, / standard output port */
	33	errport, / port for error messages */
	34	rdrport, / temporary port for readr */
	35	proport; / port for protocal */
	36	int lineleng = 80; /* line length desired */
	37	int rlevel; /* used to indicate depth of recursion
	38	in reader. No longer really necessary */
	39	char keybin = FALSE; /* logical flag: using keyboard */
	40	char protflag = FALSE; /* logical flag: want protocall */
	41	char rbktf; /* logical flag: ] mode */
	42
	43	#ifdef RTPORTS
	44	lispval ioname[128]; /* strings of names of files currently open */
	45	#else
	46	lispval ioname[_NFILE]; /* strings of names of files currently open */
	47	#endif
	48
	49	/* name stack ***********************************************************/
	50	struct argent orgnp; / used by top level to reset to start */
	51	struct argent namptr, / temporary pointer */
	52	#ifndef NPINREG
	53	lbot, / beginning of frame */
	54	np, / first free entry */
	55	#endif
	56	nplim; / don't have this = np */
	57	struct nament bnp, / top of bind stack */
	58	orgbnp, / absolute bottom of ""*/
	59	bnplim; / absolute top of "" */
	60
	61
	62
	63	/* hashing things *******************************************************/
	64	int hash; /* set by ratom */
65	int atmlen; /* length of atom including final null */
66
67
68	/* big string buffer for whomever needs it ******************************/
69	static char i_strbuf[600];
70	char *strbuf = i_strbuf;
71	char *endstrb = i_strbuf + 599;
72
73	/* in the case we can't use the C stack for extending automatics */
74	#ifdef SPISFP
75	long xstack[16384];
76	long *xsp;
77	long *exsp = xstack + ((sizeof xstack)/(sizeof (long)));
78	#endif
79
80	/* strings needed by the two hand crafted atoms, nil and eof */
81	char nilpname[] = "nil";
82	char eofpname[] = "eof";
83
84	/* set by sstatus commands */
85	int uctolc = 0; /* when set, uc chars in atoms go to lc */
86	/* default mode for dumplisp
87	(note this is decimal not octal) */
88	#if os_unisoft \|\| os_unix_ts
89	int dmpmode = 410;
90	#else
91	int dmpmode = 413;
92	#endif
93
94	/* break and error declarations *****************************************/
95	int depth = 0; /* depth of nested breaks */
96	lispval contval; /* the value being returned up */
97	int retval; /* used by each error/prog call */
98	lispval lispretval; /* used by non-local goto's */
99	int rsetsw; /* when set, trace frames built */
100	int bcdtrsw; /* when set with rsetsw, trace bcd too */
101	int evalhcallsw; /* when set will not evalhook next eval */
102	int funhcallsw; /* when set will not funcallhook next eval */
103
104
105	/* exception handling stuff *********************************************/
106	int exception; /* true if an exception is pending */
107	int sigintcnt; /* number of SIGINT's pending */
108
109	/* current state of the hole (for fasling into) *************************/
110	#ifndef HOLE
111	#define HOLE 0
112	#endif
113	extern char holbeg[];
114	char curhbeg = holbeg; / next location to fasl into */
115	int usehole = HOLE; /* if TRUE, fasl tries to use hole */
116	int holesize = HOLE; /* This avoids an ifdef in dumplisp */
117
118	/* other stuff **********************************************************/
119	lispval ftemp,vtemp,argptr,ttemp; /* temporaries: use briefly */
120	int itemp;
121	lispval sigacts[16]; /* for catching interrupts */
122	int sigstruck,sigdelay; /* for catching interrupts */
123	lispval stattab[16]; /* miscelleneous options */
124	lispval Vprintsym; /* value is the symbol 'print' */
125
126	/* interpreter globals */
127
128	int lctrace;
129	int fvirgin = 1; /* set to 1 initially */
130	int gctime;
131	struct frame errp; / stack of error frames */
132
133
134	/* global pointers to the transfer tables */
135
136
137	struct trtab trhead= / first in list of transfer tables */
138	(struct trtab *) 0;
139	struct trent trcur; / next entry to allocate */
140	int trleft = 0; /* number of entries left in current table */
141
142	/* globals from sysat.c */
143
144	int beginsweep; / place for sweeper to begin */
145	int initflag = TRUE; /* inhibit gcing initially */
146	int tgcthresh = 15;
147	int page_limit = (5 * TTSIZE) / 6;
148	int ttsize = TTSIZE;
149
150
151	/* global used in io.c */
152
153	lispval lastrtab;
154
155	/* globals from [VT]alloc.c */
156
157
158	char purepage[TTSIZE];
159	int fakettsize = TTSIZE - 8;
160	int gcstrings; /* Do we mark and sweep strings? */
161	int bind_lists = (int ) CNIL; /* lisp data for compiled code */
162
163
164	struct str_x str_current[2]; /* next free string spaces */
165
166	struct types
167	atom_str =
168	{
169	(char *)CNIL, 0, ATOMSPP, ATOM, 5,
170	&atom_items, &atom_pages, &atom_name,
171	(struct heads ) CNIL, (char )CNIL
172	},
173	strng_str =
174	{
175	(char *) CNIL, 0, STRSPP, STRNG, 128,
176	&str_items, &str_pages, &str_name,
177	(struct heads ) CNIL, (char )CNIL
178	},
179	int_str =
180	{
181	(char *) CNIL, 0, INTSPP, INT, 1,
182	&int_items, &int_pages, &int_name,
183	(struct heads ) CNIL, (char )CNIL
184	},
185	dtpr_str =
186	{
187	(char *) CNIL, 0, DTPRSPP, DTPR, 2,
188	&dtpr_items, &dtpr_pages, &dtpr_name,
189	(struct heads ) CNIL, (char )CNIL
190	},
191	doub_str =
192	{
193	(char *) CNIL, 0, DOUBSPP, DOUB, 2,
194	&doub_items, &doub_pages, &doub_name,
195	(struct heads ) CNIL, (char )CNIL
196	},
197	array_str =
198	{
199	(char *) CNIL, 0, ARRAYSPP, ARRAY, 5,
200	&array_items, &array_pages, &array_name,
201	(struct heads ) CNIL, (char )CNIL
202	},
203	other_str =
204	{
205	(char *) CNIL, 0, STRSPP, OTHER, 128,
206	&other_items, &other_pages, &other_name,
207	(struct heads ) CNIL, (char )CNIL
208	},
209
210	sdot_str =
211	{
212	(char *) CNIL, 0, SDOTSPP, SDOT, 2,
213	&sdot_items, &sdot_pages, &sdot_name,
214	(struct heads ) CNIL, (char )CNIL
215	},
216	val_str =
217	{
218	(char *) CNIL, 0, VALSPP, VALUE, 1,
219	&val_items, &val_pages, &val_name,
220	(struct heads ) CNIL, (char )CNIL
221	},
222	funct_str =
223	{
224	(char *) CNIL, 0, BCDSPP, BCD, 2,
225	&funct_items, &funct_pages, &funct_name,
226	(struct heads ) CNIL, (char )CNIL
227	},
228	vect_str =
229	{
230
231	(char *) CNIL, 0, VECTORSPP, VECTOR, 1,
232	&vect_items, &vect_pages, &vect_name,
233	(struct heads ) CNIL, (char )CNIL
234	},
235	vecti_str =
236	{
237
238	(char *) CNIL, 0, VECTORSPP, VECTORI, 1,
239	&vect_items, &vecti_pages, &vecti_name,
240	(struct heads ) CNIL, (char )CNIL
241	},
242
243	hunk_str[7] =
244	{
245	{
246	(char *) CNIL, 0, HUNK2SPP, HUNK2, 2,
247	&hunk_items[0], &hunk_pages[0], &hunk_name[0],
248	(struct heads ) CNIL, (char )CNIL
249	},
250	{
251	(char *) CNIL, 0, HUNK4SPP, HUNK4, 4,
252	&hunk_items[1], &hunk_pages[1], &hunk_name[1],
253	(struct heads ) CNIL, (char )CNIL
254	},
255	{
256	(char *) CNIL, 0, HUNK8SPP, HUNK8, 8,
257	&hunk_items[2], &hunk_pages[2], &hunk_name[2],
258	(struct heads ) CNIL, (char )CNIL
259	},
260	{
261	(char *) CNIL, 0, HUNK16SPP, HUNK16, 16,
262	&hunk_items[3], &hunk_pages[3], &hunk_name[3],
263	(struct heads ) CNIL, (char )CNIL
264	},
265	{
266	(char *) CNIL, 0, HUNK32SPP, HUNK32, 32,
267	&hunk_items[4], &hunk_pages[4], &hunk_name[4],
268	(struct heads ) CNIL, (char )CNIL
269	},
270	{
271	(char *) CNIL, 0, HUNK64SPP, HUNK64, 64,
272	&hunk_items[5], &hunk_pages[5], &hunk_name[5],
273	(struct heads ) CNIL, (char )CNIL
274	},
275	{
276	(char *) CNIL, 0, HUNK128SPP, HUNK128, 128,
277	&hunk_items[6], &hunk_pages[6], &hunk_name[6],
278	(struct heads ) CNIL, (char )CNIL
279	}
280	};
281	extern struct readtable { unsigned char ctable[132]; } initread;
282	unsigned char *ctable = initread.ctable;
283	int gensymcounter = 0;
284
285	int hashtop = HASHTOP;
286	int xcycle = 0; /* used by xsbrk */
287	struct atom *hasht[HASHTOP];
288	lispval datalim; /* pointer to next location to allocate */
289
290	char typetable[TTSIZE+1] = {UNBO,ATOM,PORT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT,INT};
291
292	/* this must be the last thing allocated in this file */
293	char lsbrkpnt,zfreespace;