eus.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* eus.c:
3 /* Toplevel, exception(error, signal) handler and initializers
4 /* Copyright(c)1988, Toshihiro MATSUI, Electrotechnical Laboratory
5 /* 1986 April: created
6 /* 1994 June: multi thread
7 /* 1996 January: handles SIGSEGV, SIGBUS
8 /****************************************************************/
9 static char *rcsid="@(#) $Id$";
10 
11 #include "eus.h"
12 
13 #include <signal.h>
14 #include <dlfcn.h>
15 #include <fcntl.h>
16 
17 #if Solaris2
18 #include <synch.h>
19 #include <thread.h>
20 #elif SunOS4_1
21 #include <lwp/stackdep.h>
22 #endif
23 
24 #if !THREADED
25 unsigned int thr_self() { return(1);}
26 #endif
27 
28 
29 #if Linux && !OLD_LINUX && !Darwin
30 #include <malloc.h> // define mallopt, M_MMAP_MAX
31 #endif
32 #if Darwin
33 int _end;
34 #endif
35 
36 /*variables*/
37 /* process id and program name*/
38 eusinteger_t mypid;
39 char *progname;
40 #if (WORD_SIZE == 64)
41 eusinteger_t setjmp_val;
42 #endif
43 
44 /* heap management */
45 /* every free cell is linked to this structure*/
46 struct buddyfree buddy[MAXBUDDY+1];
47 extern pointer *gcstack, *gcsp, *gcsplimit;
48 #define DEFAULT_MAX_GCSTACK 16384
49 
50 
51 /* System internal objects are connected to sysobj list
52 /* to protect from being garbage-collected */
53 
54 pointer sysobj;
55 
56 /* context */
57 context *mainctx;
58 pointer mainport;
59 #if Solaris2
60  thread_t maintid;
61 #endif
62 
63 
64 /****************************************************************/
65 /* system defined (built-in) class index
66 /* modified to accept dynamic type extension (1987-Jan)
67 /****************************************************************/
68 
69 cixpair objectcp;
70 cixpair conscp;
71 cixpair propobjcp;
72 cixpair symbolcp;
73 cixpair packagecp;
74 cixpair streamcp;
75 cixpair filestreamcp;
76 cixpair iostreamcp;
77 cixpair metaclasscp;
78 cixpair vecclasscp;
79 cixpair codecp;
80 cixpair fcodecp;
81 /*cixpair modulecp; */
82 cixpair ldmodulecp;
83 cixpair closurecp;
84 cixpair labrefcp;
85 cixpair threadcp;
86 cixpair arraycp;
87 cixpair readtablecp;
88 cixpair vectorcp;
89 cixpair fltvectorcp;
90 cixpair intvectorcp;
91 cixpair stringcp;
92 cixpair bitvectorcp;
93 /* extended numbers */
94 cixpair extnumcp;
95 cixpair ratiocp;
96 cixpair complexcp;
97 cixpair bignumcp;
98 
99 
100 struct built_in_cid builtinclass[64];
101 int nextbclass;
102 
103 long buddysize[MAXBUDDY+1];
104 struct buddyfree buddy[MAXBUDDY+1];
105 context *euscontexts[MAXTHREAD];
106 
107 
108 /*symbol management*/
109 pointer pkglist,lisppkg,keywordpkg,userpkg,syspkg,unixpkg,xpkg;
110 pointer NIL,PACKAGE,T,QUOTE;
111 pointer FUNCTION;
112 pointer QDECLARE,QSPECIAL;
113 #if SunOS4_1 /* SELF is already used on SunOS 4.1.x. */
114 pointer QSELF;
115 #else
116 pointer SELF;
117 #endif
118 pointer CLASS;
119 pointer STDIN,STDOUT,ERROUT,QSTDIN,QSTDOUT,QERROUT;
120 pointer QINTEGER,QFIXNUM,QFLOAT,QNUMBER;
121 pointer TOPLEVEL,QEVALHOOK,ERRHANDLER,FATALERROR;
122 pointer QGCHOOK, QEXITHOOK;
123 pointer QUNBOUND,QDEBUG;
124 pointer QTHREADS; /* system:*threads* */
125 pointer QPARAGC;
126 pointer QVERSION;
127 pointer QEQ,QEQUAL,QNOT, QAND, QOR;
128 
129 /* keywords */
130 pointer K_IN,K_OUT,K_IO; /*direction keyword*/
131 pointer K_FLUSH,K_FILL,K_FILE,K_STRING;
132 pointer K_NOMETHOD,K_BIT,K_BYTE,K_CHAR,K_SHORT,K_LONG,K_INTEGER,K_POINTER;
133 pointer K_FLOAT32,K_FLOAT,K_DOUBLE,K_FOREIGN, K_FOREIGN_STRING;
134 pointer K_DOWNCASE,K_UPCASE, K_PRESERVE, K_INVERT, K_CAPITALIZE;
135 pointer K_DISPOSE;
136 
137 /*class management*/
138 struct class_desc classtab[MAXCLASS];
139 int nextcix;
140 
141 /*class cells*/
142 pointer C_CONS, C_OBJECT, C_SYMBOL, C_PACKAGE;
143 pointer C_STREAM, C_FILESTREAM, C_IOSTREAM, C_CODE, C_FCODE, C_LDMOD;
144 pointer C_VECTOR, C_METACLASS, C_CLOSURE, C_LABREF;
145 pointer C_THREAD;
146 pointer C_VCLASS, C_FLTVECTOR, C_INTVECTOR, C_STRING, C_BITVECTOR;
147 pointer C_FOREIGNCODE,C_ARRAY,C_READTABLE;
148 pointer C_EXTNUM, C_RATIO, C_BIGNUM, C_COMPLEX;
149 
150 /*class names*/
151 pointer QCONS,STRING,STREAM,FILESTREAM,IOSTREAM,SYMBOL,
152  CODE,FCODE, LDMODULE, PKGCLASS,METACLASS,CLOSURE,LABREF;
153 pointer THREAD;
154 pointer VECTOR,VECCLASS,FLTVECTOR,INTVECTOR,OBJECT,READTABLE;
155 pointer FOREIGNCODE,ARRAY,BITVECTOR;
156 pointer EXTNUM, RATIO, COMPLEX, BIGNUM;
157 
158 /*toplevel & evaluation control*/
159 int intsig,intcode;
160 int ehbypass;
161 
162 /*reader variables*/
163 pointer charmacro[256];
164 pointer sharpmacro[256];
165 
166 extern pointer defvector();
167 static pointer reploop(context *, char *);
168 
169 pointer ALLOWOTHERKEYS,K_ALLOWOTHERKEYS;
170 pointer OPTIONAL,REST,KEY,AUX,MACRO,LAMBDA,LAMCLOSURE,COMCLOSURE;
171 pointer PRCIRCLE,PROBJECT,PRSTRUCTURE,PRCASE,PRLENGTH,PRLEVEL;
172 pointer RANDSTATE,FEATURES,READBASE,PRINTBASE,QREADTABLE,QTERMIO;
173 pointer GCMERGE,GCMARGIN, QLDENT;
174 pointer K_PRIN1;
175 pointer K_FUNCTION_DOCUMENTATION, K_VARIABLE_DOCUMENTATION,
176  K_CLASS_DOCUMENTATION, K_METHOD_DOCUMENTATION, K_CLASS;
177 pointer QLOADED_MODULES;
178 pointer MAXCALLSTACKDEPTH;
179 
180 static pointer PROPOBJ,C_PROPOBJ;
181 
182 pointer eussigvec[NSIG];
183 
184 pointer sysmod;
185 jmp_buf topjbuf;
186 
187 /****************************************************************/
188 /* error handler
189 */
190 
191 char *errmsg[100]={
192  "", /*0*/
193  "stack overflow", /*1 errcode=1..10 are fatal errors*/
194  "allocation", /*2*/
195  "", /*3*/
196  "", /*4*/
197  "", /*5*/
198  "", /*6*/
199  "", /*7*/
200  "", /*8*/
201  "", /*9*/
202  "", /*10 end of fatal error*/
203  "attempt to set to constant", /*11 E_SETCONST */
204  "unbound variable", /*12 E_UNBOUND */
205  "undefined function", /*13 E_UNDEF */
206  "mismatch argument", /*14 E_MISMATCHARG */
207  "illegal function", /*15 E_ILLFUNC */
208  "illegal character", /*16 E_ILLCH */
209  "illegal delimiter", /*17 E_READ */
210  "write?", /*18 E_WRITE*/
211  "too long string", /*19 E_LONGSTRING */
212  "symbol expected",
213  "list expected",
214  "illegal lambda form",
215  "illegal lambda parameter syntax",
216  "no catcher found",
217  "no such block",
218  "stream expected",
219  "illegal stream direction keyword",
220  "integer expected",
221  "string expected",
222  "error in open file",
223  "EOF hit",
224  "number expected",
225  "class table overflow",
226  "class expected",
227  "vector expected",
228  "array size must be positive",
229  "duplicated object variable name",
230  "cannot make instance",
231  "array index out of range", /* E_ARRAYINDEX */
232  "cannot find method",
233  "circular list",
234  "unknown sharp macro",
235  "list expected for an element of an alist",
236  "macro expected",
237  "no such package",
238  "package name",
239  "invalid lisp object form",
240  "no such object variable",
241  "sequence expected",
242  "illegal start/end index",
243  "no super class",
244  "invalid format string",
245  "float vector expected",
246  "char code out of range",
247  "vector dimension mismatch",
248  "object expected",
249  "type mismatch",
250  "declaration is not allowed here",
251  "illegal declaration form",
252  "cannot be used for a variable",
253  "illegal rotation axis",
254  "multiple variable declaration",
255  "illegal #n= or #n= label",
256  "illegal #f( expression",
257  "illegal #v or #j expression",
258  "invalid socket address",
259  "array expected",
260  "array dimension mismatch",
261  "keyword expected for arguments",
262  "no such keyword",
263  "integer vector expected",
264  "sequence index out of range",
265  "not a bit vector",
266  "no such external symbol",
267  "symbol conflict",
268  "",
269  "E_END",
270  };
271 
272 static pointer brkloop();
273 
274 void unwind(ctx,p)
275 register context *ctx;
276 register pointer *p;
277 { pointer cleanup;
278  while (ctx->protfp>=(struct protectframe *)p) { /*clean-up unwind-protect form*/
279  cleanup=ctx->protfp->cleaner;
280  ctx->protfp=ctx->protfp->protlink;
281  /*first, update protfp to avoid endless
282  evaluation of cleanup form because of an error*/
283  ufuncall(ctx,cleanup,cleanup,NULL,NULL,0);}
284  /*an error may occur if catch, throw or return-from or access to
285  special variables are taken in clean up forms*/
286  /*unwind specially bound variables*/
287  unbindspecial(ctx,(struct specialbindframe *)p);
288  /*unwind block frames*/
289  while (ctx->blkfp>(struct blockframe *)p) ctx->blkfp=ctx->blkfp->dynklink;
290  /*unwind catch frames*/
291  while (ctx->catchfp>(struct catchframe *)p) ctx->catchfp=ctx->catchfp->nextcatch;
292  /*unwind flet frames*/
293  while (ctx->fletfp>(struct fletframe *)p) ctx->fletfp=ctx->fletfp->dynlink;
294  }
295 
296 #ifdef USE_STDARG
297 pointer error(enum errorcode ec, ...)
298 #else
299 pointer error(va_alist)
300 va_dcl
301 #endif
302 {
303  va_list args;
304  pointer errhandler;
305  register char *errstr;
306  register int argc;
307  register context *ctx;
308  register struct callframe *vf;
309  pointer msg;
310  int i, n;
311 
312 #ifdef USE_STDARG
313  va_start(args,ec);
314 #else
315  enum errorcode ec;
316 
317  va_start(args);
318  ec = va_arg(args, enum errorcode);
319 #endif
320 
321  ctx=euscontexts[thr_self()];
322 
323  /* print call stack */
324  n=intval(Spevalof(MAXCALLSTACKDEPTH));
325  if (n > 0) {
326  fprintf( stderr, "Call Stack (max depth: %d):\n", n );
327  vf=(struct callframe *)(ctx->callfp);
328  for (i = 0; vf->vlink != NULL && i < n; ++i, vf = vf->vlink) {
329  fprintf( stderr, " %d: at ", i );
330  prinx(ctx, vf->form, ERROUT);
331  flushstream(ERROUT);
332  fprintf( stderr, "\n" ); }
333  if (vf->vlink != NULL) {
334  fprintf (stderr, " And more...\n"); }}
335 
336  /* error(errstr) must be error(E_USER,errstr) */
337  if ((int)ec < E_END) errstr=errmsg[(int)ec];
338  else {
339  fprintf( stderr, "Internal warning: error: ec will be string.(%lx)\n",
340  (long)ec );
341  errstr=(char *)ec;
342  }
343 
344  /*fatal error? allocation failed or stack overflow? */
345  if ((unsigned int)ec<=E_FATAL) {
346  fprintf(stderr,"%s fatal error: th=%d %s\n",progname,thr_self(),errstr);
347  if (speval(FATALERROR) != NIL) {
348  fprintf(stderr, "exiting\n"); exit(ec);}
349  else throw(ctx,makeint(0),NIL);}
350 
351  /* get extra message */
352  switch((unsigned int)ec) {
353  case E_UNBOUND: case E_UNDEF: case E_NOCLASS: case E_PKGNAME:
354  case E_NOOBJ: case E_NOOBJVAR: case E_NOPACKAGE: case E_NOMETHOD:
355  case E_NOKEYPARAM: case E_READLABEL: case E_ILLCH: case E_NOCATCHER:
356  case E_NOVARIABLE: case E_EXTSYMBOL: case E_SYMBOLCONFLICT:
357  case E_USER:
358  msg = va_arg(args,pointer); break;
359  }
360 
361  /* call user's error handler function */
362  errhandler=ctx->errhandler;
363  if (errhandler==NIL || errhandler==NULL) errhandler=Spevalof(ERRHANDLER);
364  Spevalof(QEVALHOOK)=NIL; /* reset eval hook */
365  if (errhandler!=NIL) {
366  vpush(makeint((unsigned int)ec));
367  vpush(makestring(errstr,strlen(errstr)));
368  if (ctx->callfp) vpush(ctx->callfp->form); else vpush(NIL);
369  switch((unsigned int)ec) {
370  case E_UNBOUND: case E_UNDEF: case E_NOCLASS: case E_PKGNAME:
371  case E_NOOBJ: case E_NOOBJVAR: case E_NOPACKAGE: case E_NOMETHOD:
372  case E_NOKEYPARAM: case E_READLABEL: case E_ILLCH: case E_NOCATCHER:
373  case E_NOVARIABLE: case E_EXTSYMBOL: case E_SYMBOLCONFLICT:
374  vpush(msg); argc=4; break;
375  case E_USER:
376  vpush(makestring((char*)msg,strlen((char*)msg))); argc=4; break;
377  default: argc=3; break;}
378  ufuncall(ctx,errhandler,errhandler,(pointer)(ctx->vsp-argc),ctx->bindfp,argc);
379  ctx->vsp-=argc;
380  }
381 
382  /*default error handler*/
383  flushstream(ERROUT);
384  fprintf(stderr,"%s: ERROR th=%d %s ",progname,thr_self(),errstr);
385  switch((int)ec) {
386  case E_UNBOUND: case E_UNDEF: case E_NOCLASS: case E_PKGNAME:
387  case E_NOOBJ: case E_NOOBJVAR: case E_NOPACKAGE: case E_NOMETHOD:
388  case E_NOKEYPARAM: case E_READLABEL: case E_ILLCH: case E_NOCATCHER:
389  case E_NOVARIABLE: case E_EXTSYMBOL: case E_SYMBOLCONFLICT:
390  prinx(ctx,msg,ERROUT); flushstream(ERROUT); break;
391  }
392  if( ec == E_USER ) {
393  fprintf( stderr,"%p",msg ); flushstream(ERROUT); }
394  else if (ispointer(msg)) {prinx(ctx,msg,ERROUT); flushstream(ERROUT); }
395  if (ctx->callfp) {
396  fprintf(stderr," in ");
397  prinx(ctx,ctx->callfp->form,ERROUT);
398  flushstream(ERROUT);}
399  /*enter break loop*/
400  brkloop(ctx,"E: ");
401  throw(ctx,makeint(0),T); /*throw to toplevel*/
402  }
403 
404 #ifdef USE_STDARG
405 pointer basicclass(char *name, ...)
406 #else
407 pointer basicclass(va_alist)
408 va_dcl
409 #endif
410 {
411  va_list ap;
412  byte *vname;
413  pointer super;
414  cixpair *cixp;
415  pointer classsym,class,varvector,superv,typevector,forwardvector;
416  int n,i,svcount;
417  context *ctx=mainctx;
418 
419 #ifdef USE_STDARG
420  va_start(ap, name);
421 #else
422  char *name;
423 
424  va_start(ap);
425  name=va_arg(ap,byte *);
426 #endif
427  super=va_arg(ap,pointer);
428  cixp=va_arg(ap,cixpair *); n=va_arg(ap,int);
429 
430  /*class name symbols are defined in lisp package*/
431  classsym=intern(ctx,(char *)name,strlen(name),lisppkg);
432  export(classsym,lisppkg);
433  /* printf("name=%s NIL=%x super=%x\n",name,NIL,super); */
434  if (super!=NIL) {
435  superv= super->c.cls.vars;
436  svcount=vecsize(superv);}
437  else svcount=0;
438  /* printf("name=%s super's_vcount=%d own_vcount=%d\n", name, svcount, n);*/
439  varvector=makevector(C_VECTOR,svcount+n); vpush(varvector);
440  typevector=makevector(C_VECTOR,svcount+n); vpush(typevector);
441  forwardvector=makevector(C_VECTOR,svcount+n); vpush(forwardvector);
442  for (i=0; i<svcount; i++) {
443  varvector->c.vec.v[i]=superv->c.vec.v[i];
444  typevector->c.vec.v[i]=super->c.cls.types->c.vec.v[i];
445  forwardvector->c.vec.v[i]=super->c.cls.forwards->c.vec.v[i];}
446  for (i=0; i<n; i++) {
447  vname=va_arg(ap,byte *);
448  varvector->c.vec.v[i+svcount]=intern(ctx,(char *)vname,strlen((char *)vname),lisppkg);
449  export(varvector->c.vec.v[i+svcount], lisppkg);
450  typevector->c.vec.v[i+svcount]=T;
451  forwardvector->c.vec.v[i+svcount]=NIL;}
452  class=makeclass(ctx,classsym,super,varvector,typevector,forwardvector,ELM_FIXED,0);
453  builtinclass[nextbclass].cls=class;
454  builtinclass[nextbclass].cp=cixp;
455  nextbclass++;
456  cixp->cix=intval(class->c.cls.cix);
457  cixp->sub=classtab[cixp->cix].subcix;
458  ctx->vsp-=3;
459  va_end(ap);
460  return(classsym);}
461 
462 
463 /****************************************************************/
464 /* initialization
465 /****************************************************************/
466 static void initmemory()
467 { register int i;
468  buddysize[0]=3; buddy[0].count=0; buddy[0].bp=0;
469  buddysize[1]=3; buddy[1].count=0; buddy[1].bp=0;
470  for (i=2; i<MAXBUDDY; i++) {
471  buddy[i].count=0;
472  buddysize[i]=buddysize[i-2]+buddysize[i-1]; /*fibonacci*/
473  buddy[i].bp=0;} /*no cells are connected*/
474  buddy[MAXBUDDY].bp=(bpointer)(-1); /*sentinel for alloc*/
475 #if (WORD_SIZE == 64)
476  buddysize[MAXBUDDY]= 0x7fffffffffffffff; /*cell size limit*/
477 #else
478  buddysize[MAXBUDDY]= 0x7fffffff; /*cell size limit*/
479 #endif
480 
481  /*allocate enough memory for initialization*/
482  newchunk(20);
483  newchunk(18);
484  gcstack=(pointer *)malloc(DEFAULT_MAX_GCSTACK * sizeof(pointer));
485  gcsp=gcstack;
486  gcsplimit= &gcstack[DEFAULT_MAX_GCSTACK -10];
487  }
488 
489 #ifdef RGC
490 void initmemory_rgc()
491 { register int i;
492  buddysize[0]=3; buddy[0].count=0; buddy[0].bp=0;
493  buddysize[1]=3; buddy[1].count=0; buddy[1].bp=0;
494  for (i=2; i<MAXBUDDY; i++) {
495  buddy[i].count=0;
496  buddysize[i]=buddysize[i-2]+buddysize[i-1]; /*fibonacci*/
497  buddy[i].bp=0;} /*no cells are connected*/
498  buddy[MAXBUDDY].bp=(bpointer)(-1); /*sentinel for alloc*/
499 #if (WORD_SIZE == 64)
500  buddysize[MAXBUDDY]= 0x7fffffffffffffff; /*cell size limit*/
501 #else
502  buddysize[MAXBUDDY]= 0x7fffffff; /*cell size limit*/
503 #endif
504 
505  {
506  unsigned int tmp;
507  tmp = allocate_heap();
508  fprintf(stderr, "allocate_heap: %d bytes\n", tmp*4);
509  }
510 
511  gcstack=(pointer *)malloc(DEFAULT_MAX_GCSTACK * sizeof(pointer));
512  gcsp=gcstack;
513  gcsplimit= &gcstack[DEFAULT_MAX_GCSTACK -10];
514 
515 }
516 #endif
517 
518 static void initclassid()
519 {
520  /* built-in class id's*/
521  nextcix=0;
522  objectcp.cix=0; objectcp.sub=0;
523  conscp.cix=1; conscp.sub=1;
524  propobjcp.cix=2; propobjcp.sub=12;
525  symbolcp.cix=3; symbolcp.sub=3;
526  packagecp.cix=4; packagecp.sub=4;
527  streamcp.cix=5; streamcp.sub=6;
528  filestreamcp.cix=6; filestreamcp.sub=6;
529  iostreamcp.cix=7; iostreamcp.sub=7;
530  metaclasscp.cix=8; metaclasscp.sub=9;
531  vecclasscp.cix=9; vecclasscp.sub=9;
532  readtablecp.cix=10; readtablecp.sub=10;
533  arraycp.cix=11; arraycp.sub=11;
534  threadcp.cix=12; threadcp.sub=12;
535 
536  codecp.cix=13; codecp.sub=16;
537  fcodecp.cix=14; fcodecp.sub=14;
538  closurecp.cix=15; closurecp.sub=15;
539  ldmodulecp.cix=16; ldmodulecp.sub=16;
540 
541  labrefcp.cix=17; labrefcp.sub=17;
542 
543  vectorcp.cix=18; vectorcp.sub=21;
544  fltvectorcp.cix=19; fltvectorcp.sub=19;
545  intvectorcp.cix=20; intvectorcp.sub=20;
546  stringcp.cix=21; stringcp.sub=21;
547 }
548 
549 static void initpackage()
550 { register int i;
551  register context *ctx=mainctx;
552 
553  /* GENESIS: First, VECTOR must exist!*/
554  C_VECTOR=alloc(wordsizeof(struct vecclass),ELM_FIXED,vecclasscp.cix,
555  wordsizeof(struct vecclass));
556  for (i=0; i<(wordsizeof(struct vecclass)); i++) C_VECTOR->c.obj.iv[i]=NULL;
557  C_VECTOR->c.vcls.cix=makeint(vectorcp.cix);
558  C_VECTOR->c.vcls.elmtype=makeint(ELM_POINTER);
559 
560  /*Then, NIL can be created*/
561  lisppkg=makepkg(ctx,makestring("LISP",4),makeint(0),makeint(0));
562  lisppkg->c.pkg.use=makeint(0); /*prevent islist checking*/
563  NIL=defconst(ctx,"NIL",NIL,lisppkg);
564  NIL->c.sym.speval=NIL;
565  NIL->c.sym.plist=NIL;
566  sysobj=NIL;
567  pkglist->c.cons.cdr=NIL;
568  lisppkg->c.pkg.use=NIL;
569  lisppkg->c.pkg.names->c.cons.cdr=NIL;
570  lisppkg->c.pkg.plist=NIL;
571  lisppkg->c.pkg.shadows=NIL;
572  lisppkg->c.pkg.used_by=NIL;
573  NIL->c.sym.homepkg=lisppkg;
574 
575  /*default packages*/
576  keywordpkg=makepkg(ctx,makestring("KEYWORD",7),NIL,NIL);
577  userpkg= makepkg(ctx,makestring("USER",4),NIL,rawcons(ctx,lisppkg,NIL));
578  syspkg= makepkg(ctx,makestring("SYSTEM",6),NIL,rawcons(ctx,lisppkg,NIL));
579  unixpkg= makepkg(ctx,makestring("UNIX",4),NIL,rawcons(ctx,lisppkg,NIL));
580  xpkg= makepkg(ctx,makestring("X",1),NIL,rawcons(ctx,lisppkg,NIL));
581  }
582 
583 static void initsymbols()
584 { register int i;
585  numunion nu;
586  register context *ctx=mainctx;
587 
588  export_all=0;
589 
590  /* symbols */
591  /* Be careful to define symbol pnames in upcase */
592  T=defconst(ctx,"T",T,lisppkg);
593  T->c.sym.speval=T;
594  PACKAGE=deflocal(ctx,"*PACKAGE*",lisppkg,lisppkg);
595  OPTIONAL=intern(ctx,"&OPTIONAL",9,lisppkg);
596  REST=intern(ctx,"&REST",5,lisppkg);
597  KEY=intern(ctx,"&KEY",4,lisppkg);
598  AUX=intern(ctx,"&AUX",4,lisppkg);
599  ALLOWOTHERKEYS=intern(ctx,"&ALLOW-OTHER-KEYS",17,lisppkg);
600  LAMBDA=intern(ctx,"LAMBDA",6,lisppkg);
601  MACRO=intern(ctx,"MACRO",5,lisppkg);
602  FUNCTION=intern(ctx,"FUNCTION",8,lisppkg);
603  LAMCLOSURE=intern(ctx,"LAMBDA-CLOSURE",14,lisppkg);
604  COMCLOSURE=intern(ctx,"COMPILED-CLOSURE",16,lisppkg);
605  QDECLARE=intern(ctx,"DECLARE",7,lisppkg);
606  QSPECIAL=intern(ctx,"SPECIAL",7,lisppkg);
607 #if SunOS4_1 /* SELF is already used on SunOS 4.1.x. */
608  QSELF=intern(ctx,"SELF",4,lisppkg);
609 #else
610  SELF=intern(ctx,"SELF",4,lisppkg);
611 #endif
612  CLASS=intern(ctx,"CLASS",5,lisppkg);
613  K_NOMETHOD=defkeyword(ctx,"NOMETHOD");
614  K_IN=defkeyword(ctx,"INPUT");
615  K_OUT=defkeyword(ctx,"OUTPUT");
616  K_IO=defkeyword(ctx,"IO");
617  K_FLUSH=defkeyword(ctx,"FLUSH");
618  K_FILL=defkeyword(ctx,"FILL");
619  K_FILE=defkeyword(ctx,"FILE");
620  K_STRING=defkeyword(ctx,"STRING");
621 /* K_MSGQ=defkeyword(ctx,"MSGQ"); */
622  K_DOWNCASE=defkeyword(ctx,"DOWNCASE");
623  K_UPCASE=defkeyword(ctx,"UPCASE");
624  K_PRESERVE=defkeyword(ctx,"PRESERVE");
625  K_INVERT=defkeyword(ctx,"INVERT");
626  K_CAPITALIZE=defkeyword(ctx,"CAPITALIZE");
627  K_BIT=defkeyword(ctx,"BIT");
628  K_CHAR=defkeyword(ctx,"CHAR");
629  K_BYTE=defkeyword(ctx,"BYTE");
630  K_SHORT=defkeyword(ctx,"SHORT");
631  K_LONG=defkeyword(ctx,"LONG");
632  K_INTEGER=defkeyword(ctx,"INTEGER");
633  K_POINTER=defkeyword(ctx,"POINTER");
634  K_FLOAT32=defkeyword(ctx,"FLOAT32");
635  K_FLOAT=defkeyword(ctx,"FLOAT");
636  K_DOUBLE=defkeyword(ctx,"DOUBLE");
637  K_FOREIGN=defkeyword(ctx,"FOREIGN");
638  K_FOREIGN_STRING=defkeyword(ctx,"FOREIGN-STRING");
639  K_ALLOWOTHERKEYS=defkeyword(ctx,"ALLOW-OTHER-KEYS");
640  K_PRIN1=defkeyword(ctx,"PRIN1");
641  K_CLASS=defkeyword(ctx,"CLASS");
642  K_FUNCTION_DOCUMENTATION=defkeyword(ctx,"FUNCTION-DOCUMENTATION");
643  K_CLASS_DOCUMENTATION=defkeyword(ctx,"CLASS-DOCUMENTATION");
644  K_VARIABLE_DOCUMENTATION=defkeyword(ctx,"VARIABLE-DOCUMENTATION");
645  K_METHOD_DOCUMENTATION=defkeyword(ctx,"METHOD-DOCUMENTATION");
646  K_DISPOSE=defkeyword(ctx,"DISPOSE");
647  QINTEGER=intern(ctx,"INTEGER",7,lisppkg);
648  QFLOAT=intern(ctx,"FLOAT",5,lisppkg);
649  QFIXNUM=intern(ctx,"FIXNUM",6,lisppkg);
650  QNUMBER=intern(ctx,"NUMBER",6,lisppkg);
651  QDEBUG=defvar(ctx,"*DEBUG*",NIL,lisppkg);
652 /* speval(QDEBUG)=NIL; */
653  PRCASE=deflocal(ctx,"*PRINT-CASE*",K_DOWNCASE,lisppkg);
654  PRCIRCLE=deflocal(ctx,"*PRINT-CIRCLE*",NIL,lisppkg);
655  PROBJECT=deflocal(ctx,"*PRINT-OBJECT*",NIL,lisppkg);
656  PRSTRUCTURE=deflocal(ctx,"*PRINT-STRUCTURE*",NIL,lisppkg);
657  PRLENGTH=deflocal(ctx,"*PRINT-LENGTH*",NIL,lisppkg);
658  PRLEVEL=deflocal(ctx,"*PRINT-LEVEL*",NIL,lisppkg);
659  QREADTABLE=deflocal(ctx,"*READTABLE*",NIL,lisppkg);
660  TOPLEVEL=defvar(ctx,"*TOPLEVEL*",NIL,lisppkg);
661  ERRHANDLER=deflocal(ctx,"*ERROR-HANDLER*",NIL,lisppkg);
662  QEVALHOOK=deflocal(ctx,"*EVALHOOK*",NIL,lisppkg);
663  QUNBOUND=intern(ctx,"*UNBOUND*",9,lisppkg);
664  RANDSTATE=deflocal(ctx,"*RANDOM-STATE*",UNBOUND,lisppkg);
665  FEATURES=defvar(ctx,"*FEATURES*",NIL,lisppkg);
666  READBASE=deflocal(ctx,"*READ-BASE*",makeint(10),lisppkg);
667  PRINTBASE=deflocal(ctx,"*PRINT-BASE*",makeint(10),lisppkg);
668  MAXCALLSTACKDEPTH=deflocal(ctx, "*MAX-CALLSTACK-DEPTH*",makeint(20),lisppkg);
669  /*initialize i/o stream*/
670  STDIN=mkfilestream(ctx,K_IN,makebuffer(128),0,NIL);
671  QSTDIN=deflocal(ctx,"*STANDARD-INPUT*",STDIN,lisppkg);
672  STDOUT=mkfilestream(ctx,K_OUT,makebuffer(256),1,NIL);
673  QSTDOUT=deflocal(ctx,"*STANDARD-OUTPUT*",STDOUT,lisppkg);
674  ERROUT=mkfilestream(ctx,K_OUT,makebuffer(128),2,NIL);
675  QERROUT=deflocal(ctx,"*ERROR-OUTPUT*",ERROUT,lisppkg);
676  QTERMIO=deflocal(ctx,"*TERMINAL-IO*",NIL,lisppkg);
677  GCMERGE=defvar(ctx,"*GC-MERGE*",makeflt(0.2),syspkg);
678  GCMARGIN=defvar(ctx,"*GC-MARGIN*",makeflt(0.4),syspkg);
679  QLDENT=defvar(ctx,"*LOAD-ENTRIES*", NIL, syspkg);
680  QTHREADS=defvar(ctx, "*THREADS*", NIL, syspkg);
681  QPARAGC=defvar(ctx, "*PARALLEL-GC*", NIL, syspkg);
682  QGCHOOK=defvar(ctx,"*GC-HOOK*",NIL,syspkg);
683  QEXITHOOK=defvar(ctx,"*EXIT-HOOK*",NIL,syspkg);
684  FATALERROR=defvar(ctx,"*EXIT-ON-FATAL-ERROR*",NIL,lisppkg);
685 
686  /*init character macro table*/
687  for (i=0; i<256; i++) charmacro[i]=sharpmacro[i]=NIL;
688 
689  /*init signal vector*/
690  for (i=0; i<NSIG; i++) eussigvec[i]=NIL;
691 }
692 
693 static void initclasses()
694 { extern pointer oblabels[MAXTHREAD]; /*eusio.c*/
695  register context *ctx=mainctx;
696  int i;
697 
698  /* basic classes */
699 /*0*/
700  OBJECT=basicclass("OBJECT",NIL,&objectcp,0);
701  C_OBJECT=speval(OBJECT);
702 /*1*/
703  QCONS=basicclass("CONS",C_OBJECT,&conscp,2,"CAR","CDR");
704  C_CONS=speval(QCONS);
705 /*2*/
706  PROPOBJ=basicclass("PROPERTIED-OBJECT",C_OBJECT, &propobjcp,1,"PLIST");
707  C_PROPOBJ=speval(PROPOBJ);
708 /*3*/
709  SYMBOL=basicclass("SYMBOL",C_PROPOBJ,&symbolcp,5,
710  "VALUE","VTYPE","FUNCTION","PNAME","HOMEPKG");
711  C_SYMBOL=speval(SYMBOL);
712 /*4*/
713  PKGCLASS=basicclass("PACKAGE",C_PROPOBJ,&packagecp,
714  8,"NAMES","USE","SYMVECTOR","SYMCOUNT",
715  "INTSYMVECTOR", "INTSYMCOUNT", "SHADOWS", "USED-BY");
716  C_PACKAGE=speval(PKGCLASS);
717 /*5*/
718  STREAM=basicclass("STREAM",C_PROPOBJ,&streamcp,
719  4,"DIRECTION","BUFFER","COUNT","TAIL");
720  C_STREAM=speval(STREAM);
721 /*6*/
722  FILESTREAM=basicclass("FILE-STREAM",C_STREAM,&filestreamcp,2,"FD","FNAME");
723  C_FILESTREAM=speval(FILESTREAM);
724 /*7*/
725  IOSTREAM=basicclass("IO-STREAM",C_PROPOBJ,&iostreamcp,2,"INSTREAM","OUTSTREAM");
726  C_IOSTREAM=speval(IOSTREAM);
727 /*8*/
728  METACLASS=basicclass("METACLASS",C_PROPOBJ,&metaclasscp,
729  7,"NAME","SUPER","CIX","VARS","TYPES","FORWARDS","METHODS");
730  C_METACLASS=speval(METACLASS);
731 /*9*/
732  VECCLASS=basicclass("VECTORCLASS",C_METACLASS,&vecclasscp,
733  2,"ELEMENT-TYPE","SIZE");
734  C_VCLASS=speval(VECCLASS);
735 /*10*/
736  READTABLE=basicclass("READTABLE",C_PROPOBJ,&readtablecp,
737  4,"SYNTAX","MACRO","DISPATCH-MACRO","CASE");
738  C_READTABLE=speval(READTABLE);
739 /*11*/
740  ARRAY=basicclass("ARRAY",C_PROPOBJ,&arraycp,
741  11,"ENTITY","RANK","FILL-POINTER","DISPLACED-INDEX-OFFSET",
742  "DIM0","DIM1","DIM2","DIM3","DIM4","DIM5","DIM6");
743  C_ARRAY=speval(ARRAY);
744 /*12 */
745  THREAD=basicclass("THREAD", C_PROPOBJ, &threadcp,
746  10, "ID", "REQUESTER", "REQUEST-SEM", "DONE-SEM",
747  "FUNC", "ARGS", "RESULT", "CONTEXT",
748  "IDLE", "WAIT");
749  C_THREAD=speval(THREAD);
750 /*13*/
751  CODE=basicclass("COMPILED-CODE",C_OBJECT,&codecp,4,"CODEVECTOR","QUOTEVECTOR",
752  "TYPE","ENTRY");
753  C_CODE=speval(CODE);
754 /*14*/
755  FCODE=basicclass("FOREIGN-CODE",C_CODE,&fcodecp,3,"ENTRY2","PARAMTYPES","RESULTTYPE"); /* kanehiro's patch 2000.12.13 */
756  C_FCODE=speval(FCODE);
757 /*15*/
758 #if (WORD_SIZE == 64)
759  CLOSURE=basicclass("CLOSURE",C_CODE,&closurecp,3,"ENV0","ENV1","ENV2");
760 #else
761  CLOSURE=basicclass("CLOSURE",C_CODE,&closurecp,2,"ENV1","ENV2");
762 #endif
763  C_CLOSURE=speval(CLOSURE);
764 /* 16 ---new for Solaris */
765  LDMODULE=basicclass("LOAD-MODULE",C_CODE, &ldmodulecp, 3,
766  "SYMBOL-TABLE","OBJECT-FILE", "HANDLE");
767  C_LDMOD=speval(LDMODULE);
768 /*17*/
769  LABREF=basicclass("LABEL-REFERENCE",C_OBJECT,&labrefcp,4,
770  "LABEL","VALUE","UNSOLVED","NEXT");
771  C_LABREF=speval(LABREF);
772 /*18*/
773  VECTOR=defvector(ctx,"VECTOR",C_OBJECT,ELM_POINTER, 0); /* alpha */
774  C_VECTOR=speval(VECTOR);
775  builtinclass[nextbclass].cls=C_VECTOR;
776  builtinclass[nextbclass++].cp= &vectorcp;
777 
778  FLTVECTOR=defvector(ctx,"FLOAT-VECTOR",C_VECTOR,ELM_FLOAT, 0); /* alpha */
779  C_FLTVECTOR=speval(FLTVECTOR);
780  builtinclass[nextbclass].cls=C_FLTVECTOR;
781  builtinclass[nextbclass++].cp= &fltvectorcp;
782 
783  INTVECTOR=defvector(ctx,"INTEGER-VECTOR",C_VECTOR,ELM_INT, 0); /* alpha */
784  C_INTVECTOR=speval(INTVECTOR);
785  builtinclass[nextbclass].cls=C_INTVECTOR;
786  builtinclass[nextbclass++].cp= &intvectorcp;
787 
788  STRING=defvector(ctx,"STRING",C_VECTOR,ELM_CHAR, 0); /* alpha */
789  C_STRING=speval(STRING);
790  builtinclass[nextbclass].cls=C_STRING;
791  builtinclass[nextbclass++].cp= &stringcp;
792 
793  BITVECTOR=defvector(ctx,"BIT-VECTOR",C_VECTOR,ELM_BIT, 0); /* alpha */
794  C_BITVECTOR=speval(BITVECTOR);
795  builtinclass[nextbclass].cls=C_BITVECTOR;
796  builtinclass[nextbclass++].cp= &bitvectorcp;
797 
798 /* extended numbers */
799  EXTNUM=basicclass("EXTENDED-NUMBER",C_OBJECT,&extnumcp,0);
800  C_EXTNUM=speval(EXTNUM);
801  RATIO=basicclass("RATIO",C_EXTNUM, &ratiocp,2,"NUMERATOR","DENOMINATOR");
802  C_RATIO=speval(RATIO);
803  COMPLEX=basicclass("COMPLEX", C_EXTNUM, &complexcp, 2, "REAL", "IMAGINARY");
804  C_COMPLEX=speval(COMPLEX);
805  BIGNUM=basicclass("BIGNUM", C_EXTNUM, &bignumcp, 2, "SIZE", "BV");
806  C_BIGNUM=speval(BIGNUM);
807 
808  for (i=0;i<MAXTHREAD;i++) {
809  oblabels[i]=(pointer)makelabref(makeint(-1),UNBOUND,NIL);
810  sysobj=cons(ctx,oblabels[i],sysobj);
811  }
812 }
813 
814 static void initfeatures()
815 { register pointer p;
816  register context *ctx=mainctx;
817  extern char *makedate;
818  extern char *gitrevision;
819  extern char *compilehost;
820 
821  p=makestring(VERSION,strlen(VERSION));
822  vpush(p);
823  p=makestring(compilehost,strlen(compilehost));
824  vpush(p);
825  p=makestring(makedate,strlen(makedate));
826  vpush(p);
827  p=makestring(gitrevision,strlen(gitrevision));
828  vpush(p);
829  p=stacknlist(ctx,4);
830  QVERSION=defvar(ctx, "LISP-IMPLEMENTATION-VERSION", p,lisppkg);
831 
832  /*make features*/
833 
834  p=NIL;
835 #if vax
836  p=cons(ctx,intern(ctx,"VAX",3,keywordpkg),p);
837 #endif
838 #if sun
839  p=cons(ctx,intern(ctx,"SUN",3,keywordpkg),p);
840 #endif
841 #if apollo
842  p=cons(ctx,intern(ctx,"APOLLO",6,keywordpkg),p);
843 #endif
844 #if mips
845  p=cons(ctx,intern(ctx,"MIPS",4,keywordpkg),p);
846 #endif
847 #if sun3
848  p=cons(ctx,intern(ctx,"SUN3",4,keywordpkg),p);
849 #endif
850 #if sun4
851  p=cons(ctx,intern(ctx,"SUN4",4,keywordpkg),p);
852 #endif
853 #if news
854  p=cons(ctx,intern(ctx,"NEWS",4,keywordpkg),p);
855 #endif
856 #if sanyo
857  p=cons(ctx,intern(ctx,"SANYO",5,keywordpkg),p);
858 #endif
859 #if bsd4_2
860  p=cons(ctx,intern(ctx,"BSD4_2",6,keywordpkg),p);
861 #endif
862 #if SunOS4
863  p=cons(ctx,intern(ctx,"SUNOS4",6,keywordpkg),p);
864 #endif
865 #if SunOS4_1
866  p=cons(ctx,intern(ctx,"SUNOS4.1",8,keywordpkg),p);
867 #endif
868 #if system5
869  p=cons(ctx,intern(ctx,"SYSTEM5",7,keywordpkg),p);
870 #endif
871 #if coff
872  p=cons(ctx,intern(ctx,"COFF",4,keywordpkg),p);
873 #endif
874 #if Solaris2
875  p=cons(ctx,intern(ctx,"SOLARIS2",8,keywordpkg),p);
876 #endif
877 #if GCC
878  p=cons(ctx,intern(ctx,"GCC",3,keywordpkg),p);
879 #endif
880 #if GCC3
881  p=cons(ctx,intern(ctx,"GCC3",4,keywordpkg),p);
882 #endif
883 #if i386
884  p=cons(ctx,intern(ctx,"I386",4,keywordpkg),p);
885 #endif
886 #if Linux
887  p=cons(ctx,intern(ctx,"LINUX",5,keywordpkg),p);
888 #endif
889 #if Linux_ppc
890  p=cons(ctx,intern(ctx,"PPC",3,keywordpkg),p);
891 #endif
892 #if USE_MULTI_LIB
893  p=cons(ctx,intern(ctx,"IA32",4,keywordpkg),p);
894 #endif
895 #if ELF
896  p=cons(ctx,intern(ctx,"ELF",3,keywordpkg),p);
897 #endif
898 #if IRIX
899  p=cons(ctx,intern(ctx,"IRIX",4,keywordpkg),p);
900 #endif
901 #if IRIX6
902  p=cons(ctx,intern(ctx,"IRIX6",5,keywordpkg),p);
903 #endif
904 #if alpha
905  p=cons(ctx,intern(ctx,"ALPHA",5,keywordpkg),p);
906 #endif
907 #if Cygwin
908  p=cons(ctx,intern(ctx,"CYGWIN",6,keywordpkg),p);
909 #endif
910 #if Darwin
911  p=cons(ctx,intern(ctx,"DARWIN",6,keywordpkg),p);
912 #endif
913 #if THREADED
914  p=cons(ctx,intern(ctx,"THREAD",6,keywordpkg),p);
915 #endif
916 #if PTHREAD
917  p=cons(ctx,intern(ctx,"PTHREAD",7,keywordpkg),p);
918 #endif
919 #if X_V11R6_1
920  p=cons(ctx,intern(ctx,"X11R6.1",7,keywordpkg),p);
921 #endif
922 #if RGC
923  p=cons(ctx,intern(ctx,"RGC",3,keywordpkg),p);
924 #endif
925 #if SH4
926  p=cons(ctx,intern(ctx,"SH4",3,keywordpkg),p);
927 #endif
928 #if x86_64
929  p=cons(ctx,intern(ctx,"X86_64",6,keywordpkg),p);
930 #endif
931 #if ARM
932  p=cons(ctx,intern(ctx,"ARM",3,keywordpkg),p);
933 #endif
934 #if aarch64
935  p=cons(ctx,intern(ctx,"AARCH64",7,keywordpkg),p);
936 #endif
937 
938  defvar(ctx,"*FEATURES*",p,lisppkg);
939 
940  /*system function module*/
941  sysmod=makemodule(ctx,0);
942  sysmod->c.ldmod.codevec=makeint(0);
943  sysmod->c.ldmod.handle=makeint((eusinteger_t)dlopen(0, RTLD_LAZY)>>2);
944  sysobj=cons(ctx,sysmod, sysobj);
945  }
946 
947 /****************************************************************/
948 /* signal handlers
949 /****************************************************************/
950 
951 extern long gcing;
952 #include <sys/wait.h>
953 
954 void eusint(s,code,x,addr)
955 register int s;
956 int code,x;
957 eusinteger_t addr;
958 { int stat;
959  context *ctx;
960 
961  ctx = euscontexts[thr_self()];
962  if (debug) {
963  fprintf(stderr, ";; eusint: sig=%d, %d; thr=%d ctx=%p\n",
964  s,code,thr_self(), ctx);}
965  if (ctx==NULL) ctx=mainctx;
966  ctx->intsig=s;
967  intcode=code;
968  switch(s) {
969  case SIGCHLD:
970  wait(&stat);
971  if (debug)
972  fprintf(stderr,";; child proc terminated; wait=0x%x\n",stat);
973  ctx->intsig=0;
974  break;
975  case SIGFPE:
976  fprintf(stderr,";; floating exception\n");
977  goto sigfatal;
978  break;
979  case SIGPIPE:
980  fprintf(stderr,";; pipe broken %d %x %lx\n",code,x,(unsigned long)addr);
981  throw(mainctx,makeint(0),NIL); /*nonsense*/
982  break;
983  case SIGSEGV:
984  fprintf(stderr,";; Segmentation Fault.\n");
985  goto sigfatal;
986  case SIGBUS:
987  fprintf(stderr,";; Bus Error.\n");
988 
989  sigfatal:
990 
991  if (speval(FATALERROR) != NIL) exit(s);
992  if (ctx->callfp) {
993  fprintf(stderr,";; in ");
994  prinx(ctx,ctx->callfp->form,ERROUT);
995  flushstream(ERROUT);
996  fprintf(stderr,"\n");}
997  fprintf(stderr,";; You are still in a signal handler.\n;;Try reset or throw to upper level as soon as possible.\n");
998  fprintf(stderr,";; code=%d x=%x addr=%lx\n",code,x,(unsigned long)addr);
999  reploop(mainctx, "Fatal: ");
1000  fprintf(stderr,";; No, you cannot continue the previous evaluation.\n");
1001  /* goto sigfatal; */
1002  exit(s);
1003  break;
1004  }
1005 
1006 #if Solaris2 || system5
1007  signal(s,(void (*)())eusint); /*reinstall signal*/
1008 #endif
1009 
1010 #if THREADED
1011  if (isintvector(eussigvec[s])) {
1012 /* if (s==SIGALRM && gcing) {intsig=0; return;} */
1013  /*ignore Alarm clock during gc*/
1014  sema_post((sema_t *)eussigvec[s]->c.ivec.iv);
1015  ctx->intsig=0;}
1016 #endif
1017  if (debug) { fprintf(stderr, ";; eusint exit: intsig=%d\n",ctx->intsig);}
1018 }
1019 
1020 static pointer brkloop(ctx, prompt)
1021 context *ctx;
1022 char *prompt;
1023 { jmp_buf brkjmp;
1024  pointer val;
1025  int i;
1026  mkcatchframe(ctx,T,&brkjmp);
1027  Spevalof(QSTDOUT)=STDOUT;
1028  Spevalof(QSTDIN)=STDIN;
1029  Spevalof(QERROUT)=ERROUT;
1030  if ((val=(pointer)eussetjmp(brkjmp))==0) val=reploop(ctx,prompt);
1031  else if ((eusinteger_t)val==1) val=makeint(0); /*longjmp cannot return 0*/
1032  ctx->callfp=ctx->catchfp->cf;
1033  ctx->bindfp=ctx->catchfp->bf;
1034  ctx->vsp=(pointer *)ctx->catchfp;
1035  ctx->catchfp=(struct catchframe *)*(ctx->vsp);
1036  return(val);}
1037 
1038 void sigbreak()
1039 { pointer sighandler,*vspsave;
1040  context *ctx=euscontexts[thr_self()];
1041  int is;
1042 
1043  is=ctx->intsig;
1044  if (debug) printf("sigbreak: intsig=%d thr_self=%d\n", is, thr_self());
1045  sighandler=eussigvec[is];
1046  if (isintvector(sighandler)) return;
1047  vspsave=ctx->vsp;
1048  ctx->intsig=0;
1049  QEVALHOOK->c.sym.speval=NIL;
1050  if (sighandler!=NIL) {
1051  vpush(makeint(is)); vpush(makeint(intcode));
1052  ufuncall(ctx,sighandler,sighandler,(pointer)(ctx->vsp-2),ctx->bindfp,2);
1053  ctx->vsp=vspsave; }
1054  else {
1055  fprintf(stderr,"signal=%d to thread %d, \n",is, thr_self());
1056  /* brkloop(ctx,"B: "); */
1057  return; }}
1058 
1059 
1060 /****************************************************************/
1061 /* main and toplevel
1062 /****************************************************************/
1063 static pointer reploop(ctx,prompt)
1064 register context *ctx;
1065 char *prompt;
1066 { pointer p,q;
1067  int ttyp;
1068  ehbypass=0;
1069  ttyp=isatty(intval(STDIN->c.fstream.fd));
1070  do {
1071  if (ttyp) {
1072  p=Spevalof(PACKAGE);
1073  if (p!=userpkg) { /*print pkg name*/
1074  printf("%s:",ccar(p->c.pkg.names)->c.str.chars);}
1075  printf("%s",prompt);
1076  fflush(stdout);}
1077  p=reader(ctx,STDIN,NIL);
1078  if (p==(pointer)EOF) return(NIL);
1079  breakck;
1080  q=eval(ctx,p);
1081  if (q!=UNBOUND) { prinx(ctx,q,STDOUT); terpri(STDOUT);}}
1082  while (1);}
1083 
1084 static void toplevel(ctx,argc,argv)
1085 register context *ctx;
1086 int argc;
1087 char *argv[];
1088 { pointer argvp,topform;
1089  int i,j;
1090 
1091  /* reset stack pointer and frame pointers*/
1092  j=(int)eussetjmp(topjbuf);
1093  ctx->vsp=ctx->stack;
1094  ctx->bindfp=NULL;
1095  ctx->sbindfp=NULL;
1096  ctx->callfp=NULL;
1097  ctx->blkfp=NULL;
1098  ctx->protfp=NULL;
1099  ctx->catchfp=NULL;
1100  ctx->fletfp=NULL;
1101  topform=speval(TOPLEVEL);
1102  if (topform!=NIL) {
1103  if (j==0) {
1104  for (i=0; i<argc; i++) vpush(makestring(argv[i],strlen(argv[i])));
1105  ufuncall(ctx,topform,topform,(pointer)(ctx->vsp-argc),0,argc);}
1106  else ufuncall(ctx,topform,topform,(pointer)(ctx->vsp),0,0);}
1107  else { /*TOPLEVEL not yet defined-- try built-in toplevel*/
1108  mkcatchframe(ctx,makeint(0),&topjbuf);
1109  fprintf(stderr, "entering reploop\n");
1110  reploop(ctx,": ");}
1111  }
1112 
1113 /* load initial configuration file from EUSDIR/eusrt0.l */
1114 static void configure_eus(ctx)
1115 register context *ctx;
1116 { pointer argv, p, in;
1117  int i,j;
1118  char *eusdir, *eusrt;
1119  char fname[1024];
1120  extern pointer SRCLOAD();
1121 
1122  /* reset stack pointer and frame pointers*/
1123  j=(int)eussetjmp(topjbuf);
1124  eusdir=(char *)getenv("EUSDIR");
1125  if (eusdir==NULL) {
1126  fprintf(stderr, "EUSDIR is not setenved, assuming /usr/local/eus\n");
1127  eusdir= "/usr/local/eus/"; }
1128  sprintf(fname,"%s/lib/eus.init.l", eusdir);
1129 
1130 #if !Solaris2 || GCC
1131  /* read the init-module list from "EUSDIR/lib/eus.init.l" */
1132  in=(pointer)openfile(ctx,fname,O_RDONLY,0,256);
1133  if (in==NULL) {
1134  fprintf(stderr,
1135  "$EUSDIR/lib/eus.init.l was not found\nfailed to initialize.\n"
1136  "Entering raweus.\n"
1137  "To exit, type (unix::exit)\n");
1138  return;}
1139  vpush(in);
1140  p=reader(ctx,in,NIL);
1141  vpop();
1142  closestream(in);
1143  /* prinx(ctx,p,STDOUT); */
1144 #endif
1145 
1146  vpush(p);
1147  /* prinx(ctx,p,STDOUT); terpri(STDOUT); */
1148  p=(pointer)list_module_initializers(ctx,p);
1149  vpop();
1150  speval(QLDENT)=p;
1151 
1152  eusrt=(char *)getenv("EUSRT");
1153  if (eusrt==NULL) sprintf(fname,"%s/lib/eusrt.l", eusdir);
1154  else strcpy(fname, eusrt);
1155  if (isatty(0)!=0) {
1156  fprintf(stderr, "configuring by \"%s\"\n", fname); }
1157  mkcatchframe(ctx,makeint(0),&topjbuf);
1158  argv=makestring(fname, strlen(fname));
1159  vpush(argv);
1160  eusstart(ctx);
1161  SRCLOAD(ctx, 1, ctx->vsp-1);
1162  }
1163 
1164 
1165 int mainargc;
1166 char *mainargv[32];
1167 
1168 
1169 void mainthread(ctx)
1170 register context *ctx;
1171 {
1172  euscontexts[thr_self()]=ctx;
1173 
1174  /*initialize system*/
1175 #ifndef RGC
1176  initmemory();
1177 #endif
1178  initclassid();
1179 
1180  {
1181  int i;
1182  pointer specialtab;
1183  specialtab=alloc(MAX_SPECIALS+1,ELM_POINTER,vectorcp.cix,MAX_SPECIALS+1);
1184  specialtab->c.vec.size=makeint(MAX_SPECIALS);
1185  for (i=0; i<MAX_SPECIALS; i++) specialtab->c.vec.v[i]=NIL;
1186  ctx->specials=specialtab; }
1187 
1188  initpackage();
1189  initsymbols();
1190  initclasses();
1191  initfeatures();
1192 
1193  ctx->threadobj=NIL;
1194 
1195 
1196  /* define built-in functions */
1197  lists(ctx,sysmod); /*list functions and predicates*/
1198  predicates(ctx,sysmod); /*predicates*/
1199  sequence(ctx,sysmod); /*sequence functions*/
1200  specials(ctx,sysmod); /*control forms, special forms*/
1201  lispio(ctx,sysmod); /*lisp i/o*/
1202  loadsave(ctx,sysmod); /*loader and saver*/
1203  leo(ctx,sysmod); /*object oriented programming*/
1204  arith(ctx,sysmod); /*arithmetic functions*/
1205  matrix(ctx,sysmod); /*floatvector, matrix operation*/
1206  unixcall(ctx,sysmod); /*unix system binding*/
1207  foreign(ctx,sysmod); /*foreign function interface*/
1208  vectorarray(ctx,sysmod); /*vector and array functions*/
1209  charstring(ctx,sysmod);
1210 #if THREADED
1211  mthread(ctx,sysmod);
1212 #if Solaris2
1213  mainport=makethreadport(mainctx);
1214  speval(QTHREADS)=cons(ctx, mainport, speval(QTHREADS));
1215  mainport->c.thrp.id=makeint((int)maintid);
1216 #endif
1217 #endif
1218 
1219  initreader(ctx);
1220  sysfunc(ctx,sysmod);
1221 #ifdef RGC
1222  rgcfunc(ctx,sysmod);
1223 #endif
1224  eusioctl(ctx,sysmod);
1225  Spevalof(PACKAGE)=userpkg;
1226 
1227  defvar(ctx,"*PROGRAM-NAME*",makestring(progname,strlen(progname)),lisppkg);
1228 
1229  /* exec_module_initializers(); */
1230  ctx->vsp=ctx->stack;
1231  configure_eus(ctx);
1232 
1233  signal(SIGCHLD, (void (*)())eusint);
1234  signal(SIGFPE, (void (*)())eusint);
1235  signal(SIGPIPE, (void (*)())eusint);
1236 #ifdef RGC
1237 // signal(SIGSEGV, (void (*)())eusint); /* for debugging. R.Hanai */
1238 #else
1239  signal(SIGSEGV, (void (*)())eusint);
1240 #endif
1241  signal(SIGBUS, (void (*)())eusint);
1242 
1243  toplevel(ctx,mainargc,mainargv);
1244 
1245  { pointer exithook=speval(QEXITHOOK);
1246  if (exithook != NIL) {
1247  ufuncall(ctx,exithook,exithook,(pointer)(ctx->vsp),0,0);}
1248  }
1249 
1250 #if THREADED
1251 #if SunOS4_1
1252  thr_exit(0);
1253 #else
1254  exit(0);
1255 #endif
1256 #endif
1257  }
1258 
1259 int main(argc,argv)
1260 int argc;
1261 char *argv[];
1262 { int i, stat=0;
1263  unsigned char *m;
1264 
1265 #ifdef Darwin
1266  _end = sbrk(0);
1267 #endif
1268 
1269  mypid=getpid();
1270  mainargc=argc;
1271  for (i=0; i<argc; i++) mainargv[i]=argv[i];
1272 
1273  tzset();
1274 
1275 #if Linux && !OLD_LINUX && !Darwin
1276  mallopt(M_MMAP_MAX,0);
1277 #endif
1278 
1279  /* following two lines are just to speed up frequent sbreak at the beginning
1280  of the execution. These lines may be deleted without any harm.*/
1281  m=(unsigned char *)malloc(4*1024*1024);
1282  cfree(m);
1283 
1284 #if vxworks
1285  progname=taskName(mypid);
1286 #else
1287  progname=argv[0];
1288 #endif
1289  /* get stack area and initialize stack/frame pointers */
1290  for (i=0; i<MAXTHREAD; i++) euscontexts[i]=0;
1291  mainctx=(context *)makelispcontext(MAXSTACK);
1292 #if THREADED
1293 #if Solaris2
1294  mutex_init(&mark_lock, USYNC_THREAD, 0);
1295  mutex_init(&p_mark_lock, USYNC_THREAD, 0);
1296  thr_create(0, 2*1024*1024,mainthread, mainctx, 0, &maintid);
1297  { sigset_t mainsig, omainsig;
1298  sigemptyset(&mainsig);
1299  sigaddset(&mainsig, SIGINT);
1300  /* printf("mainthread=%d\n", thr_self()); */
1301  thr_sigsetmask(SIG_BLOCK, &mainsig, &omainsig);
1302  }
1303  thr_join(maintid, 0, (void *)&stat);
1304 #else
1305 #if SunOS4_1 || alpha || PTHREAD
1306  mthread_init( mainctx );
1307 #ifdef RGC
1308  init_rgc();
1309 #endif
1310 #endif
1311  mainthread(mainctx);
1312 #endif /* Solaris2 */
1313 #else
1314  mainthread(mainctx);
1315 #endif
1316 
1317  { pointer exithook=speval(QEXITHOOK);
1318  if (exithook != NIL) {
1319  ufuncall(mainctx,exithook,exithook,(pointer)(mainctx->vsp),0,0);}
1320  }
1321 
1322  exit(stat);
1323  }
1324 
1325 #if (WORD_SIZE == 64)
1326 pointer makeint(eusinteger_t v) {
1327  if (v>(eusinteger_t)MAXPOSFIXNUM || v<(eusinteger_t)MINNEGFIXNUM) {
1328  if (v&0x7L) {
1329  return(mkbigint(v));
1330  }
1331  return ((pointer)(v|0x3L)); }
1332  else return((pointer)((v<<2)+2));
1333 }
1334 eusinteger_t intval(pointer p) {
1335  eusinteger_t i=(eusinteger_t)p;
1336  if (p==NULL) {
1337  fprintf(stderr,"p=null\n");
1338  raise(SIGSEGV);
1339  return 0;}
1340  else if ((i&0x3L)==0x3L) {
1341  return (i&~0x3L); }
1342  else if (isbignum(p)) {
1343  return (bigintval(p)); }
1344  else if ((i&0x7)==0x0L) {
1345  fprintf(stderr,";p=pointer?(%p)\n", p);
1346  return (i); }
1347  else return (((eusinteger_t)i)>>2);
1348 }
1349 #else
1350 pointer makeint(eusinteger_t v) {
1351  if (v>(int)MAXPOSFIXNUM || v<(int)MINNEGFIXNUM) {
1352  // fprintf(stderr, "makeint(%x)\n", v);
1353  if (v&0x3) {
1354  // fprintf(stderr, "v=%x(bignum)\n", v);
1355  return(mkbigint(v));
1356  }
1357  return ((pointer)(v|0x3)); }
1358  else return((pointer)((v<<2)+2));
1359 }
1360 eusinteger_t intval(pointer p) {
1361  eusinteger_t i=(eusinteger_t)p;
1362  if (p==NULL) {
1363  fprintf(stderr,"p=null\n");
1364  return 0;}
1365  else if ((i&0x3)==0x3) {
1366  return (i&~0x3); }
1367  else if (isbignum(p)) {
1368  return (bigintval(p)); }
1369  else if ((i&0x3)==0x0) {
1370  fprintf(stderr,";p=pointer?(%p)\n", p);
1371  return (i); }
1372  else return (((eusinteger_t)i)>>2);
1373 }
1374 #endif
1375 
1376 eusinteger_t hide_ptr (pointer p) { return (eusinteger_t)p; }
package::used_by
pointer used_by
Definition: eus.h:225
IOSTREAM
pointer IOSTREAM
Definition: eus.c:151
K_IN
pointer K_IN
Definition: eus.c:130
euscontexts
context * euscontexts[MAXTHREAD]
Definition: eus.c:105
buddyfree
Definition: eus.h:561
GCMARGIN
pointer GCMARGIN
Definition: eus.c:173
prinx
pointer prinx(context *, pointer, pointer)
Definition: printer.c:611
symbol::speval
pointer speval
Definition: eus.h:201
AUX
pointer AUX
Definition: eus.c:170
intcode
int intcode
Definition: eus.c:159
defconst
pointer defconst(context *, char *, pointer, pointer)
Definition: makes.c:693
C_STREAM
pointer C_STREAM
Definition: eus.c:143
rawcons
pointer rawcons(context *, pointer, pointer)
Definition: makes.c:86
nextcix
int nextcix
Definition: eus.c:139
LAMCLOSURE
pointer LAMCLOSURE
Definition: eus.c:170
progname
char * progname
Definition: eus.c:39
TOPLEVEL
pointer TOPLEVEL
Definition: eus.c:121
QNUMBER
pointer QNUMBER
Definition: eus.c:120
C_CLOSURE
pointer C_CLOSURE
Definition: eus.c:144
class_desc
Definition: eus.h:565
E_NOOBJ
Definition: eus.h:971
intern
pointer intern(context *, char *, int, pointer)
Definition: intern.c:105
list_module_initializers
pointer list_module_initializers(context *, pointer)
Definition: loadelf.c:153
vectorcp
cixpair vectorcp
Definition: eus.c:88
FEATURES
pointer FEATURES
Definition: eus.c:172
makeint
pointer makeint(eusinteger_t v)
Definition: eus.c:1326
cell::cellunion::vec
struct vector vec
Definition: eus.h:412
cell::cellunion::cls
struct _class cls
Definition: eus.h:416
QFLOAT
pointer QFLOAT
Definition: eus.c:120
iostreamcp
cixpair iostreamcp
Definition: eus.c:76
intsig
int intsig
Definition: eus.c:159
FUNCTION
pointer FUNCTION
Definition: eus.c:111
K_CLASS_DOCUMENTATION
pointer K_CLASS_DOCUMENTATION
Definition: eus.c:175
pointer
struct cell * pointer
Definition: eus.h:163
C_VECTOR
pointer C_VECTOR
Definition: eus.c:144
K_OUT
pointer K_OUT
Definition: eus.c:130
context
Definition: eus.h:522
STDOUT
pointer STDOUT
Definition: eus.c:119
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
QLDENT
pointer QLDENT
Definition: eus.c:173
mthread
int mthread(context *ctx, pointer mod)
Definition: mthread.c:536
cell::cellunion::fstream
struct filestream fstream
Definition: eus.h:404
GCMERGE
pointer GCMERGE
Definition: eus.c:173
KEY
pointer KEY
Definition: eus.c:170
packagecp
cixpair packagecp
Definition: eus.c:73
specials
void specials(context *, pointer)
Definition: specials.c:1284
mkfilestream
pointer mkfilestream(context *, pointer, pointer, int, pointer)
Definition: makes.c:253
QAND
pointer QAND
Definition: eus.c:127
_class::vars
pointer vars
Definition: eus.h:326
QPARAGC
pointer QPARAGC
Definition: eus.c:125
unixpkg
pointer unixpkg
Definition: eus.c:109
SRCLOAD
pointer SRCLOAD(context *, int, pointer *)
cell::cellunion::thrp
struct threadport thrp
Definition: eus.h:419
C_THREAD
pointer C_THREAD
Definition: eus.c:145
C_VCLASS
pointer C_VCLASS
Definition: eus.c:146
openfile
pointer openfile(context *, char *, int, int, int)
Definition: eusstream.c:30
sysfunc
void sysfunc(context *, pointer)
Definition: sysfunc.c:774
context::vsp
pointer * vsp
Definition: eus.h:523
sysmod
pointer sysmod
Definition: eus.c:184
closestream
int closestream(pointer)
Definition: eusstream.c:53
mainctx
context * mainctx
Definition: eus.c:57
T
pointer T
Definition: eus.c:110
thr_join
int thr_join(int tid, int *depature, void **status)
Definition: pthreads.c:75
bpointer
struct bcell * bpointer
Definition: eus.h:443
K_SHORT
pointer K_SHORT
Definition: eus.c:132
package::names
pointer names
Definition: eus.h:218
n
GLfloat n[6][3]
Definition: cube.c:15
K_CHAR
pointer K_CHAR
Definition: eus.c:132
initmemory_rgc
void initmemory_rgc()
Definition: eus.c:490
C_BITVECTOR
pointer C_BITVECTOR
Definition: eus.c:146
makethreadport
pointer makethreadport(context *)
Definition: makes.c:916
K_ALLOWOTHERKEYS
pointer K_ALLOWOTHERKEYS
Definition: eus.c:169
eusstart
void eusstart(context *)
buddyfree::bp
bpointer bp
Definition: eus.h:563
makepkg
pointer makepkg(context *, pointer, pointer, pointer)
Definition: makes.c:201
argc
static int argc
Definition: transargv.c:56
C_CONS
pointer C_CONS
Definition: eus.c:142
BIGNUM
pointer BIGNUM
Definition: eus.c:156
SYMBOL
pointer SYMBOL
Definition: eus.c:151
defkeyword
pointer defkeyword(context *, char *)
Definition: makes.c:733
VECCLASS
pointer VECCLASS
Definition: eus.c:154
codecp
cixpair codecp
Definition: eus.c:79
eusioctl
void eusioctl(context *, pointer)
Definition: eusioctl.c:249
QDEBUG
pointer QDEBUG
Definition: eus.c:123
C_IOSTREAM
pointer C_IOSTREAM
Definition: eus.c:143
maintid
thread_t maintid
Definition: eus.c:60
hide_ptr
eusinteger_t hide_ptr(pointer p)
Definition: eus.c:1376
oblabels
pointer oblabels
Definition: reader.c:42
conscp
cixpair conscp
Definition: eus.c:70
p_mark_lock
mutex_t p_mark_lock
FCODE
pointer FCODE
Definition: eus.c:151
symbolcp
cixpair symbolcp
Definition: eus.c:72
leo
void leo(context *, pointer)
Definition: leo.c:714
CODE
pointer CODE
Definition: eus.c:151
extnumcp
cixpair extnumcp
Definition: eus.c:94
QTHREADS
pointer QTHREADS
Definition: eus.c:124
userpkg
pointer userpkg
Definition: eus.c:109
K_BYTE
pointer K_BYTE
Definition: eus.c:132
STRING
pointer STRING
Definition: eus.c:151
C_FOREIGNCODE
pointer C_FOREIGNCODE
Definition: eus.c:147
PRINTBASE
pointer PRINTBASE
Definition: eus.c:172
FLTVECTOR
pointer FLTVECTOR
Definition: eus.c:154
filestreamcp
cixpair filestreamcp
Definition: eus.c:75
_end
int _end
Definition: eus.c:33
LABREF
pointer LABREF
Definition: eus.c:151
makelispcontext
context * makelispcontext(int)
Definition: makes.c:840
ufuncall
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1208
K_METHOD_DOCUMENTATION
pointer K_METHOD_DOCUMENTATION
Definition: eus.c:175
context::errhandler
pointer errhandler
Definition: eus.h:535
READBASE
pointer READBASE
Definition: eus.c:172
mainthread
void mainthread(context *ctx)
Definition: eus.c:1169
reploop
static pointer reploop(context *, char *)
Definition: eus.c:1063
package::use
pointer use
Definition: eus.h:219
METACLASS
pointer METACLASS
Definition: eus.c:151
K_PRIN1
pointer K_PRIN1
Definition: eus.c:174
READTABLE
pointer READTABLE
Definition: eus.c:154
E_USER
Definition: eus.h:1002
PRLEVEL
pointer PRLEVEL
Definition: eus.c:171
K_STRING
pointer K_STRING
Definition: eus.c:131
rgcfunc
void rgcfunc(register context *ctx, pointer mod)
Definition: collector.c:1235
setjmp_val
eusinteger_t setjmp_val
Definition: eus.c:41
FOREIGNCODE
pointer FOREIGNCODE
Definition: eus.c:155
C_STRING
pointer C_STRING
Definition: eus.c:146
COMCLOSURE
pointer COMCLOSURE
Definition: eus.c:170
makevector
pointer makevector(pointer, int)
Definition: makes.c:417
eussigvec
pointer eussigvec[NSIG]
Definition: eus.c:182
C_EXTNUM
pointer C_EXTNUM
Definition: eus.c:148
K_NOMETHOD
pointer K_NOMETHOD
Definition: eus.c:132
cell::cellunion::sym
struct symbol sym
Definition: eus.h:399
ldmodule::handle
pointer handle
Definition: eus.h:257
K_FOREIGN
pointer K_FOREIGN
Definition: eus.c:133
PRCIRCLE
pointer PRCIRCLE
Definition: eus.c:171
E_PKGNAME
Definition: eus.h:970
built_in_cid
Definition: eus.h:570
K_FLUSH
pointer K_FLUSH
Definition: eus.c:131
C_SYMBOL
pointer C_SYMBOL
Definition: eus.c:142
C_METACLASS
pointer C_METACLASS
Definition: eus.c:144
context::intsig
int intsig
Definition: eus.h:544
makemodule
pointer makemodule(context *, int)
Definition: makes.c:486
QVERSION
pointer QVERSION
Definition: eus.c:126
cons::cdr
pointer cdr
Definition: eus.h:194
built_in_cid::cp
cixpair * cp
Definition: eus.h:572
K_FUNCTION_DOCUMENTATION
pointer K_FUNCTION_DOCUMENTATION
Definition: eus.c:175
K_FLOAT32
pointer K_FLOAT32
Definition: eus.c:133
QUOTE
pointer QUOTE
Definition: eus.c:110
initfeatures
static void initfeatures()
Definition: eus.c:814
_sema
Definition: eus_thr.h:96
package::plist
pointer plist
Definition: eus.h:217
MACRO
pointer MACRO
Definition: eus.c:170
vecclass
Definition: eus.h:332
cell::cellunion::vcls
struct vecclass vcls
Definition: eus.h:417
bitvectorcp
cixpair bitvectorcp
Definition: eus.c:92
cell::cellunion::ldmod
struct ldmodule ldmod
Definition: eus.h:408
RATIO
pointer RATIO
Definition: eus.c:156
C_READTABLE
pointer C_READTABLE
Definition: eus.c:147
C_PROPOBJ
static pointer C_PROPOBJ
Definition: eus.c:180
QDECLARE
pointer QDECLARE
Definition: eus.c:112
cell::cellunion::cons
struct cons cons
Definition: eus.h:398
E_NOCLASS
Definition: eus.h:958
QERROUT
pointer QERROUT
Definition: eus.c:119
CLASS
pointer CLASS
Definition: eus.c:118
initreader
void initreader(context *)
Definition: reader.c:1034
mark_lock
mutex_t mark_lock
Definition: mthread.c:25
foreign
void foreign(context *ctx, pointer mod)
Definition: calleus.c:225
THREAD
pointer THREAD
Definition: eus.c:153
_class::forwards
pointer forwards
Definition: eus.h:328
cell::c
union cell::cellunion c
_class::types
pointer types
Definition: eus.h:327
C_FCODE
pointer C_FCODE
Definition: eus.c:143
initclassid
static void initclassid()
Definition: eus.c:518
lispio
void lispio(context *, pointer)
Definition: lispio.c:588
unbindspecial
void unbindspecial(context *, struct specialbindframe *)
Definition: eval.c:165
vecclasscp
cixpair vecclasscp
Definition: eus.c:78
object::iv
pointer iv[2]
Definition: eus.h:319
deflocal
pointer deflocal(context *, char *, pointer, pointer)
Definition: makes.c:716
QLOADED_MODULES
pointer QLOADED_MODULES
Definition: eus.c:177
callframe
Definition: eus.h:472
PKGCLASS
pointer PKGCLASS
Definition: eus.c:151
C_ARRAY
pointer C_ARRAY
Definition: eus.c:147
SELF
pointer SELF
Definition: eus.c:116
QGCHOOK
pointer QGCHOOK
Definition: eus.c:122
class_desc::subcix
short subcix
Definition: eus.h:567
REST
pointer REST
Definition: eus.c:170
OPTIONAL
pointer OPTIONAL
Definition: eus.c:170
sigbreak
void sigbreak()
Definition: eus.c:1038
numunion
Definition: eus.h:426
initmemory
static void initmemory()
Definition: eus.c:466
mainargc
int mainargc
Definition: eus.c:1165
export
pointer export(pointer, pointer)
Definition: intern.c:74
threadport::id
pointer id
Definition: eus.h:353
class::cix
pointer cix
Definition: eus.old.h:211
symbol::homepkg
pointer homepkg
Definition: eus.h:201
initclasses
static void initclasses()
Definition: eus.c:693
STDIN
pointer STDIN
Definition: eus.c:119
fcodecp
cixpair fcodecp
Definition: eus.c:80
VECTOR
pointer VECTOR
Definition: eus.c:154
ARRAY
pointer ARRAY
Definition: eus.c:155
MAXCALLSTACKDEPTH
pointer MAXCALLSTACKDEPTH
Definition: eus.c:178
closurecp
cixpair closurecp
Definition: eus.c:83
callframe::vlink
struct callframe * vlink
Definition: eus.h:473
defvar
pointer defvar(context *, char *, pointer, pointer)
Definition: makes.c:704
cell
Definition: eus.h:379
gcing
long gcing
PRCASE
pointer PRCASE
Definition: eus.c:171
predicates
void predicates(context *, pointer)
Definition: predicates.c:214
INTVECTOR
pointer INTVECTOR
Definition: eus.c:154
K_FOREIGN_STRING
pointer K_FOREIGN_STRING
Definition: eus.c:133
C_LDMOD
pointer C_LDMOD
Definition: eus.c:143
unixcall
void unixcall(context *, pointer)
LDMODULE
pointer LDMODULE
Definition: eus.c:151
alloc
pointer alloc(int, int, int, int)
Definition: memory.mutex.c:241
CLOSURE
pointer CLOSURE
Definition: eus.c:151
context::callfp
struct callframe * callfp
Definition: eus.h:527
C_OBJECT
pointer C_OBJECT
Definition: eus.c:142
callframe::form
pointer form
Definition: eus.h:474
buddysize
long buddysize[MAXBUDDY+1]
Definition: eus.c:103
QEVALHOOK
pointer QEVALHOOK
Definition: eus.c:121
makelabref
pointer makelabref(pointer, pointer, pointer)
Definition: makes.c:538
QINTEGER
pointer QINTEGER
Definition: eus.c:120
QSPECIAL
pointer QSPECIAL
Definition: eus.c:112
s
short s
Definition: structsize.c:2
metaclasscp
cixpair metaclasscp
Definition: eus.c:77
streamcp
cixpair streamcp
Definition: eus.c:74
vector::size
pointer size
Definition: eus.h:298
vecclass::elmtype
pointer elmtype
Definition: eus.h:341
makebuffer
pointer makebuffer(int)
Definition: makes.c:140
errorcode
errorcode
Definition: eus.h:915
lists
void lists(context *, pointer)
Definition: lists.c:411
K_PRESERVE
pointer K_PRESERVE
Definition: eus.c:134
LAMBDA
pointer LAMBDA
Definition: eus.c:170
PROPOBJ
static pointer PROPOBJ
Definition: eus.c:180
labrefcp
cixpair labrefcp
Definition: eus.c:84
vectorarray
void vectorarray(context *, pointer)
Definition: vectorarray.c:459
K_BIT
pointer K_BIT
Definition: eus.c:132
lisppkg
pointer lisppkg
Definition: eus.c:109
objectcp
cixpair objectcp
Definition: eus.c:69
C_RATIO
pointer C_RATIO
Definition: eus.c:148
K_DISPOSE
pointer K_DISPOSE
Definition: eus.c:135
vecclass::cix
pointer cix
Definition: eus.h:336
K_DOUBLE
pointer K_DOUBLE
Definition: eus.c:133
cixpair::sub
short sub
Definition: eus.h:452
C_FILESTREAM
pointer C_FILESTREAM
Definition: eus.c:143
errmsg
char * errmsg[100]
Definition: eus.c:191
thr_create
int thr_create(void *, size_t, void(*)(), void *, long, int *)
Definition: pthreads.c:43
ratiocp
cixpair ratiocp
Definition: eus.c:95
BITVECTOR
pointer BITVECTOR
Definition: eus.c:155
C_CODE
pointer C_CODE
Definition: eus.c:143
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
propobjcp
cixpair propobjcp
Definition: eus.c:71
eusinteger_t
long eusinteger_t
Definition: eus.h:19
symbol::plist
pointer plist
Definition: eus.h:201
K_IO
pointer K_IO
Definition: eus.c:130
export_all
int export_all
Definition: intern.c:11
QEXITHOOK
pointer QEXITHOOK
Definition: eus.c:122
K_INVERT
pointer K_INVERT
Definition: eus.c:134
topjbuf
jmp_buf topjbuf
Definition: eus.c:185
K_FILL
pointer K_FILL
Definition: eus.c:131
stringcp
cixpair stringcp
Definition: eus.c:91
EXTNUM
pointer EXTNUM
Definition: eus.c:156
PROBJECT
pointer PROBJECT
Definition: eus.c:171
C_PACKAGE
pointer C_PACKAGE
Definition: eus.c:142
PACKAGE
pointer PACKAGE
Definition: eus.c:110
flushstream
int flushstream(pointer)
Definition: eusstream.c:159
code
Definition: eus.h:228
COMPLEX
pointer COMPLEX
Definition: eus.c:156
C_LABREF
pointer C_LABREF
Definition: eus.c:144
readtablecp
cixpair readtablecp
Definition: eus.c:87
stacknlist
pointer stacknlist(context *, int)
Definition: makes.c:129
PRSTRUCTURE
pointer PRSTRUCTURE
Definition: eus.c:171
ERRHANDLER
pointer ERRHANDLER
Definition: eus.c:121
unwind
void unwind(context *ctx, pointer *p)
Definition: eus.c:274
defvector
pointer defvector()
sequence
void sequence(context *, pointer)
Definition: sequence.c:1070
buddy
struct buddyfree buddy[MAXBUDDY+1]
Definition: eus.c:46
xpkg
pointer xpkg
Definition: eus.c:109
main
int main(int argc, argv)
Definition: eus.c:1259
QNOT
pointer QNOT
Definition: eus.c:127
RANDSTATE
pointer RANDSTATE
Definition: eus.c:172
QFIXNUM
pointer QFIXNUM
Definition: eus.c:120
QEQUAL
pointer QEQUAL
Definition: eus.c:127
arith
void arith(context *ctx, pointer mod)
Definition: arith.c:1466
K_CLASS
pointer K_CLASS
Definition: eus.c:175
K_FILE
pointer K_FILE
Definition: eus.c:131
bignumcp
cixpair bignumcp
Definition: eus.c:97
eusint
void eusint(int s, int code, int x, eusinteger_t addr)
Definition: eus.c:954
terpri
void terpri(pointer)
Definition: printer.c:637
threadcp
cixpair threadcp
Definition: eus.c:85
makestring
pointer makestring(char *, int)
Definition: makes.c:147
FATALERROR
pointer FATALERROR
Definition: eus.c:121
loadsave
void loadsave(context *, pointer)
Definition: loadelf.c:428
init_rgc
void init_rgc()
Definition: collector.c:484
package::shadows
pointer shadows
Definition: eus.h:224
C_BIGNUM
pointer C_BIGNUM
Definition: eus.c:148
makeclass
pointer makeclass(context *, pointer, pointer, pointer, pointer, pointer, int, pointer)
Definition: makes.c:375
E_UNDEF
Definition: eus.h:937
QREADTABLE
pointer QREADTABLE
Definition: eus.c:172
NULL
#define NULL
Definition: transargv.c:8
toplevel
static void toplevel(context *ctx, int argc, argv)
Definition: eus.c:1084
E_END
Definition: eus.h:1005
ehbypass
int ehbypass
Definition: eus.c:160
C_INTVECTOR
pointer C_INTVECTOR
Definition: eus.c:146
cell::cellunion::obj
struct object obj
Definition: eus.h:415
K_FLOAT
pointer K_FLOAT
Definition: eus.c:133
QSELF
pointer QSELF
Definition: eus.c:114
charmacro
pointer charmacro[256]
Definition: eus.c:163
matrix
void matrix(context *, pointer)
Definition: matrix.c:1348
filestream::fd
pointer fd
Definition: eus.h:284
QEQ
pointer QEQ
Definition: eus.c:127
gcsplimit
pointer * gcsplimit
Definition: memory.c:411
v
GLfloat v[8][3]
Definition: cube.c:21
C_FLTVECTOR
pointer C_FLTVECTOR
Definition: eus.c:146
QSTDOUT
pointer QSTDOUT
Definition: eus.c:119
QCONS
pointer QCONS
Definition: eus.c:151
sharpmacro
pointer sharpmacro[256]
Definition: eus.c:164
ALLOWOTHERKEYS
pointer ALLOWOTHERKEYS
Definition: eus.c:169
sysobj
pointer sysobj
Definition: eus.c:54
newchunk
int newchunk(int)
Definition: memory.c:67
K_UPCASE
pointer K_UPCASE
Definition: eus.c:134
brkloop
static pointer brkloop()
K_POINTER
pointer K_POINTER
Definition: eus.c:132
FILESTREAM
pointer FILESTREAM
Definition: eus.c:151
gcsp
pointer * gcsp
Definition: memory.c:411
K_CAPITALIZE
pointer K_CAPITALIZE
Definition: eus.c:134
charstring
void charstring(context *ctx, pointer mod)
Definition: charstring.c:180
K_INTEGER
pointer K_INTEGER
Definition: eus.c:132
sema_post
int sema_post(sema_t *sem)
Definition: pthreads.c:148
byte
unsigned char byte
Definition: eus.h:161
QTERMIO
pointer QTERMIO
Definition: eus.c:172
thr_self
unsigned int thr_self()
Definition: eus.c:25
cixpair
Definition: eus.h:450
STREAM
pointer STREAM
Definition: eus.c:151
ldmodule::codevec
pointer codevec
Definition: eus.h:248
QOR
pointer QOR
Definition: eus.c:127
basicclass
pointer basicclass(char *name,...) pointer basicclass(va_alist) va_dcl
Definition: eus.c:405
intval
eusinteger_t intval(pointer p)
Definition: eus.c:1334
K_LONG
pointer K_LONG
Definition: eus.c:132
E_UNBOUND
Definition: eus.h:936
cixpair::cix
short cix
Definition: eus.h:451
gcstack
pointer * gcstack
Definition: memory.c:411
classtab
struct class_desc classtab[MAXCLASS]
Definition: eus.c:138
allocate_heap
unsigned int allocate_heap()
Definition: collector.c:1195
mypid
eusinteger_t mypid
Definition: eus.c:38
pkglist
pointer pkglist
Definition: eus.c:109
complexcp
cixpair complexcp
Definition: eus.c:96
nextbclass
int nextbclass
Definition: eus.c:101
class
Definition: eus.old.h:207
mkcatchframe
void mkcatchframe(context *, pointer, jmp_buf *)
Definition: makes.c:801
context::bindfp
struct bindframe * bindfp
Definition: eus.h:529
NIL
pointer NIL
Definition: eus.c:110
syspkg
pointer syspkg
Definition: eus.c:109
mainport
pointer mainport
Definition: eus.c:58
ldmodulecp
cixpair ldmodulecp
Definition: eus.c:82
eval
pointer eval(context *, pointer)
Definition: eval.c:1361
fletframe
Definition: eus.h:507
mainargv
char * mainargv[32]
Definition: eus.c:1166
buddyfree::count
int count
Definition: eus.h:562
vector::v
pointer v[1]
Definition: eus.h:299
C_COMPLEX
pointer C_COMPLEX
Definition: eus.c:148
QUNBOUND
pointer QUNBOUND
Definition: eus.c:123
ERROUT
pointer ERROUT
Definition: eus.c:119
arraycp
cixpair arraycp
Definition: eus.c:86
E_ILLCH
Definition: eus.h:940
built_in_cid::cls
pointer cls
Definition: eus.h:571
QSTDIN
pointer QSTDIN
Definition: eus.c:119
builtinclass
struct built_in_cid builtinclass[64]
Definition: eus.c:100
rcsid
static char * rcsid
Definition: eus.c:9
keywordpkg
pointer keywordpkg
Definition: eus.c:109
OBJECT
pointer OBJECT
Definition: eus.c:154
reader
pointer reader(context *, pointer, pointer)
Definition: reader.c:1016
PRLENGTH
pointer PRLENGTH
Definition: eus.c:171
intvectorcp
cixpair intvectorcp
Definition: eus.c:90
K_DOWNCASE
pointer K_DOWNCASE
Definition: eus.c:134
K_VARIABLE_DOCUMENTATION
pointer K_VARIABLE_DOCUMENTATION
Definition: eus.c:175
cell::cellunion::pkg
struct package pkg
Definition: eus.h:402
initsymbols
static void initsymbols()
Definition: eus.c:583
initpackage
static void initpackage()
Definition: eus.c:549
makeflt
pointer makeflt()
configure_eus
static void configure_eus(context *ctx)
Definition: eus.c:1114
fltvectorcp
cixpair fltvectorcp
Definition: eus.c:89

euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 20:00:43