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*/
39 char *progname;
40 #if (WORD_SIZE == 64)
42 #endif
43 
44 /* heap management */
45 /* every free cell is linked to this structure*/
46 struct buddyfree buddy[MAXBUDDY+1];
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 
55 
56 /* context */
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 
81 /*cixpair modulecp; */
93 /* extended numbers */
98 
99 
102 
103 long buddysize[MAXBUDDY+1];
104 struct buddyfree buddy[MAXBUDDY+1];
105 context *euscontexts[MAXTHREAD];
106 
107 
108 /*symbol management*/
113 #if SunOS4_1 /* SELF is already used on SunOS 4.1.x. */
115 #else
117 #endif
124 pointer QTHREADS; /* system:*threads* */
128 
129 /* keywords */
130 pointer K_IN,K_OUT,K_IO; /*direction keyword*/
136 
137 /*class management*/
138 struct class_desc classtab[MAXCLASS];
140 
141 /*class cells*/
149 
150 /*class names*/
157 
158 /*toplevel & evaluation control*/
161 
162 /*reader variables*/
165 
166 extern pointer defvector();
167 static pointer reploop(context *, char *);
168 
179 
181 
183 
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);
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*/
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,"%s",(char*)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);
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
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;
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;
546  stringcp.cix=21; stringcp.sub=21;
547 }
548 
549 static void initpackage()
550 { register size_t 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;
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;
570  lisppkg->c.pkg.plist=NIL;
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*/
714  8,"NAMES","USE","SYMVECTOR","SYMCOUNT",
715  "INTSYMVECTOR", "INTSYMCOUNT", "SHADOWS", "USED-BY");
716  C_PACKAGE=speval(PKGCLASS);
717 /*5*/
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*/
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*/
737  4,"SYNTAX","MACRO","DISPATCH-MACRO","CASE");
738  C_READTABLE=speval(READTABLE);
739 /*11*/
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,
760 #if ARM // ARM uses entry2 in struct closure in eus.h
761  4,"ENTRY2",
762 #else
763  3,
764 #endif
765  "ENV0","ENV1","ENV2");
766 #else
767  CLOSURE=basicclass("CLOSURE",C_CODE,&closurecp,
768 #if ARM // ARM uses entry2 in struct closure in eus.h
769  3,"ENTRY2",
770 #else
771  2,
772 #endif
773  "ENV1","ENV2");
774 #endif
775  C_CLOSURE=speval(CLOSURE);
776 /* 16 ---new for Solaris */
777  LDMODULE=basicclass("LOAD-MODULE",C_CODE, &ldmodulecp,
778 #if ARM // ARM uses entry2 in struct ldmodule in eus.h
779  4,"ENTRY2",
780 #else
781  3,
782 #endif
783  "SYMBOL-TABLE","OBJECT-FILE", "HANDLE");
784  C_LDMOD=speval(LDMODULE);
785 /*17*/
786  LABREF=basicclass("LABEL-REFERENCE",C_OBJECT,&labrefcp,4,
787  "LABEL","VALUE","UNSOLVED","NEXT");
788  C_LABREF=speval(LABREF);
789 /*18*/
790  VECTOR=defvector(ctx,"VECTOR",C_OBJECT,ELM_POINTER, 0); /* alpha */
791  C_VECTOR=speval(VECTOR);
794 
795  FLTVECTOR=defvector(ctx,"FLOAT-VECTOR",C_VECTOR,ELM_FLOAT, 0); /* alpha */
796  C_FLTVECTOR=speval(FLTVECTOR);
799 
800  INTVECTOR=defvector(ctx,"INTEGER-VECTOR",C_VECTOR,ELM_INT, 0); /* alpha */
801  C_INTVECTOR=speval(INTVECTOR);
804 
805  STRING=defvector(ctx,"STRING",C_VECTOR,ELM_CHAR, 0); /* alpha */
806  C_STRING=speval(STRING);
809 
810  BITVECTOR=defvector(ctx,"BIT-VECTOR",C_VECTOR,ELM_BIT, 0); /* alpha */
811  C_BITVECTOR=speval(BITVECTOR);
814 
815 /* extended numbers */
816  EXTNUM=basicclass("EXTENDED-NUMBER",C_OBJECT,&extnumcp,0);
817  C_EXTNUM=speval(EXTNUM);
818  RATIO=basicclass("RATIO",C_EXTNUM, &ratiocp,2,"NUMERATOR","DENOMINATOR");
819  C_RATIO=speval(RATIO);
820  COMPLEX=basicclass("COMPLEX", C_EXTNUM, &complexcp, 2, "REAL", "IMAGINARY");
821  C_COMPLEX=speval(COMPLEX);
822  BIGNUM=basicclass("BIGNUM", C_EXTNUM, &bignumcp, 2, "SIZE", "BV");
823  C_BIGNUM=speval(BIGNUM);
824 
825  for (i=0;i<MAXTHREAD;i++) {
826  oblabels[i]=(pointer)makelabref(makeint(-1),UNBOUND,NIL);
827  sysobj=cons(ctx,oblabels[i],sysobj);
828  }
829 }
830 
831 static void initfeatures()
832 { register pointer p;
833  register context *ctx=mainctx;
834  extern char *makedate;
835  extern char *gitrevision;
836  extern char *compilehost;
837 
838  p=makestring(VERSION,strlen(VERSION));
839  vpush(p);
840  p=makestring(compilehost,strlen(compilehost));
841  vpush(p);
842  p=makestring(makedate,strlen(makedate));
843  vpush(p);
844  p=makestring(gitrevision,strlen(gitrevision));
845  vpush(p);
846  p=stacknlist(ctx,4);
847  QVERSION=defvar(ctx, "LISP-IMPLEMENTATION-VERSION", p,lisppkg);
848 
849  /*make features*/
850 
851  p=NIL;
852 #if vax
853  p=cons(ctx,intern(ctx,"VAX",3,keywordpkg),p);
854 #endif
855 #if sun
856  p=cons(ctx,intern(ctx,"SUN",3,keywordpkg),p);
857 #endif
858 #if apollo
859  p=cons(ctx,intern(ctx,"APOLLO",6,keywordpkg),p);
860 #endif
861 #if mips
862  p=cons(ctx,intern(ctx,"MIPS",4,keywordpkg),p);
863 #endif
864 #if sun3
865  p=cons(ctx,intern(ctx,"SUN3",4,keywordpkg),p);
866 #endif
867 #if sun4
868  p=cons(ctx,intern(ctx,"SUN4",4,keywordpkg),p);
869 #endif
870 #if news
871  p=cons(ctx,intern(ctx,"NEWS",4,keywordpkg),p);
872 #endif
873 #if sanyo
874  p=cons(ctx,intern(ctx,"SANYO",5,keywordpkg),p);
875 #endif
876 #if bsd4_2
877  p=cons(ctx,intern(ctx,"BSD4_2",6,keywordpkg),p);
878 #endif
879 #if SunOS4
880  p=cons(ctx,intern(ctx,"SUNOS4",6,keywordpkg),p);
881 #endif
882 #if SunOS4_1
883  p=cons(ctx,intern(ctx,"SUNOS4.1",8,keywordpkg),p);
884 #endif
885 #if system5
886  p=cons(ctx,intern(ctx,"SYSTEM5",7,keywordpkg),p);
887 #endif
888 #if coff
889  p=cons(ctx,intern(ctx,"COFF",4,keywordpkg),p);
890 #endif
891 #if Solaris2
892  p=cons(ctx,intern(ctx,"SOLARIS2",8,keywordpkg),p);
893 #endif
894 #if GCC
895  p=cons(ctx,intern(ctx,"GCC",3,keywordpkg),p);
896 #endif
897 #if GCC3
898  p=cons(ctx,intern(ctx,"GCC3",4,keywordpkg),p);
899 #endif
900 #if i386
901  p=cons(ctx,intern(ctx,"I386",4,keywordpkg),p);
902 #endif
903 #if Linux
904  p=cons(ctx,intern(ctx,"LINUX",5,keywordpkg),p);
905 #endif
906 #if Linux_ppc
907  p=cons(ctx,intern(ctx,"PPC",3,keywordpkg),p);
908 #endif
909 #if USE_MULTI_LIB
910  p=cons(ctx,intern(ctx,"IA32",4,keywordpkg),p);
911 #endif
912 #if ELF
913  p=cons(ctx,intern(ctx,"ELF",3,keywordpkg),p);
914 #endif
915 #if IRIX
916  p=cons(ctx,intern(ctx,"IRIX",4,keywordpkg),p);
917 #endif
918 #if IRIX6
919  p=cons(ctx,intern(ctx,"IRIX6",5,keywordpkg),p);
920 #endif
921 #if alpha
922  p=cons(ctx,intern(ctx,"ALPHA",5,keywordpkg),p);
923 #endif
924 #if Cygwin
925  p=cons(ctx,intern(ctx,"CYGWIN",6,keywordpkg),p);
926 #endif
927 #if Darwin
928  p=cons(ctx,intern(ctx,"DARWIN",6,keywordpkg),p);
929 #endif
930 #if THREADED
931  p=cons(ctx,intern(ctx,"THREAD",6,keywordpkg),p);
932 #endif
933 #if PTHREAD
934  p=cons(ctx,intern(ctx,"PTHREAD",7,keywordpkg),p);
935 #endif
936 #if X_V11R6_1
937  p=cons(ctx,intern(ctx,"X11R6.1",7,keywordpkg),p);
938 #endif
939 #if RGC
940  p=cons(ctx,intern(ctx,"RGC",3,keywordpkg),p);
941 #endif
942 #if SH4
943  p=cons(ctx,intern(ctx,"SH4",3,keywordpkg),p);
944 #endif
945 #if x86_64
946  p=cons(ctx,intern(ctx,"X86_64",6,keywordpkg),p);
947 #endif
948 #if ARM
949  p=cons(ctx,intern(ctx,"ARM",3,keywordpkg),p);
950 #endif
951 #if aarch64
952  p=cons(ctx,intern(ctx,"AARCH64",7,keywordpkg),p);
953 #endif
954  {
955  char tmp[32];
956  sprintf(tmp, "WORD-SIZE=%zd", sizeof(void*)*8);
957  p=cons(ctx,intern(ctx,tmp,strlen(tmp),keywordpkg),p);
958  }
959 
960  defvar(ctx,"*FEATURES*",p,lisppkg);
961 
962  /*system function module*/
963  sysmod=makemodule(ctx,0);
965  sysmod->c.ldmod.handle=makeint((eusinteger_t)dlopen(0, RTLD_LAZY)>>2);
966  sysobj=cons(ctx,sysmod, sysobj);
967  }
968 
969 /****************************************************************/
970 /* signal handlers
971 /****************************************************************/
972 
973 extern long gcing;
974 #include <sys/wait.h>
975 
976 void eusint(s,code,x,addr)
977 register int s;
978 int code,x;
979 eusinteger_t addr;
980 { int stat;
981  context *ctx;
982 
983  ctx = euscontexts[thr_self()];
984  if (debug) {
985  fprintf(stderr, ";; eusint: sig=%d, %d; thr=%d ctx=%p\n",
986  s,code,thr_self(), ctx);}
987  if (ctx==NULL) ctx=mainctx;
988  ctx->intsig=s;
989  intcode=code;
990  switch(s) {
991  case SIGCHLD:
992  wait(&stat);
993  if (debug)
994  fprintf(stderr,";; child proc terminated; wait=0x%x\n",stat);
995  ctx->intsig=0;
996  break;
997  case SIGFPE:
998  fprintf(stderr,";; floating exception\n");
999  goto sigfatal;
1000  break;
1001  case SIGPIPE:
1002  fprintf(stderr,";; pipe broken %d %x %lx\n",code,x,(unsigned long)addr);
1003  throw(mainctx,makeint(0),NIL); /*nonsense*/
1004  break;
1005  case SIGSEGV:
1006  fprintf(stderr,";; Segmentation Fault.\n");
1007  goto sigfatal;
1008  case SIGBUS:
1009  fprintf(stderr,";; Bus Error.\n");
1010 
1011  sigfatal:
1012 
1013  if (speval(FATALERROR) != NIL) exit(s);
1014  if (ctx->callfp) {
1015  fprintf(stderr,";; in ");
1016  prinx(ctx,ctx->callfp->form,ERROUT);
1018  fprintf(stderr,"\n");}
1019  fprintf(stderr,";; You are still in a signal handler.\n;;Try reset or throw to upper level as soon as possible.\n");
1020  fprintf(stderr,";; code=%d x=%x addr=%lx\n",code,x,(unsigned long)addr);
1021  reploop(mainctx, "Fatal: ");
1022  fprintf(stderr,";; No, you cannot continue the previous evaluation.\n");
1023  /* goto sigfatal; */
1024  exit(s);
1025  break;
1026  }
1027 
1028 #if Solaris2 || system5
1029  signal(s,(void (*)())eusint); /*reinstall signal*/
1030 #endif
1031 
1032 #if THREADED
1033  if (isintvector(eussigvec[s])) {
1034 /* if (s==SIGALRM && gcing) {intsig=0; return;} */
1035  /*ignore Alarm clock during gc*/
1036  sema_post((sema_t *)eussigvec[s]->c.ivec.iv);
1037  ctx->intsig=0;}
1038 #endif
1039  if (debug) { fprintf(stderr, ";; eusint exit: intsig=%d\n",ctx->intsig);}
1040 }
1041 
1042 static pointer brkloop(ctx, prompt)
1043 context *ctx;
1044 char *prompt;
1045 { jmp_buf brkjmp;
1046  pointer val;
1047  int i;
1048  mkcatchframe(ctx,T,&brkjmp);
1049  Spevalof(QSTDOUT)=STDOUT;
1050  Spevalof(QSTDIN)=STDIN;
1051  Spevalof(QERROUT)=ERROUT;
1052  if ((val=(pointer)eussetjmp(brkjmp))==0) val=reploop(ctx,prompt);
1053  else if ((eusinteger_t)val==1) val=makeint(0); /*longjmp cannot return 0*/
1054  ctx->callfp=ctx->catchfp->cf;
1055  ctx->bindfp=ctx->catchfp->bf;
1056  ctx->vsp=(pointer *)ctx->catchfp;
1057  ctx->catchfp=(struct catchframe *)*(ctx->vsp);
1058  return(val);}
1059 
1060 void sigbreak()
1061 { pointer sighandler,*vspsave;
1062  context *ctx=euscontexts[thr_self()];
1063  int is;
1064 
1065  is=ctx->intsig;
1066  if (debug) printf("sigbreak: intsig=%d thr_self=%d\n", is, thr_self());
1067  sighandler=eussigvec[is];
1068  if (isintvector(sighandler)) return;
1069  vspsave=ctx->vsp;
1070  ctx->intsig=0;
1072  if (sighandler!=NIL) {
1073  vpush(makeint(is)); vpush(makeint(intcode));
1074  ufuncall(ctx,sighandler,sighandler,(pointer)(ctx->vsp-2),ctx->bindfp,2);
1075  ctx->vsp=vspsave; }
1076  else {
1077  fprintf(stderr,"signal=%d to thread %d, \n",is, thr_self());
1078  /* brkloop(ctx,"B: "); */
1079  return; }}
1080 
1081 
1082 /****************************************************************/
1083 /* main and toplevel
1084 /****************************************************************/
1085 static pointer reploop(ctx,prompt)
1086 register context *ctx;
1087 char *prompt;
1088 { pointer p,q;
1089  int ttyp;
1090  ehbypass=0;
1091  ttyp=isatty(intval(STDIN->c.fstream.fd));
1092  do {
1093  if (ttyp) {
1094  p=Spevalof(PACKAGE);
1095  if (p!=userpkg) { /*print pkg name*/
1096  printf("%s:",ccar(p->c.pkg.names)->c.str.chars);}
1097  printf("%s",prompt);
1098  fflush(stdout);}
1099  p=reader(ctx,STDIN,NIL);
1100  if (p==(pointer)EOF) return(NIL);
1101  breakck;
1102  q=eval(ctx,p);
1103  if (q!=UNBOUND) { prinx(ctx,q,STDOUT); terpri(STDOUT);}}
1104  while (1);}
1105 
1106 static void toplevel(ctx,argc,argv)
1107 register context *ctx;
1108 int argc;
1109 char *argv[];
1110 { pointer argvp,topform;
1111  int i,j;
1112 
1113  /* reset stack pointer and frame pointers*/
1114  j=(int)eussetjmp(topjbuf);
1115  ctx->vsp=ctx->stack;
1116  ctx->bindfp=NULL;
1117  ctx->sbindfp=NULL;
1118  ctx->callfp=NULL;
1119  ctx->blkfp=NULL;
1120  ctx->protfp=NULL;
1121  ctx->catchfp=NULL;
1122  ctx->fletfp=NULL;
1123  topform=speval(TOPLEVEL);
1124  if (topform!=NIL) {
1125  if (j==0) {
1126  for (i=0; i<argc; i++) vpush(makestring(argv[i],strlen(argv[i])));
1127  ufuncall(ctx,topform,topform,(pointer)(ctx->vsp-argc),0,argc);}
1128  else ufuncall(ctx,topform,topform,(pointer)(ctx->vsp),0,0);}
1129  else { /*TOPLEVEL not yet defined-- try built-in toplevel*/
1130  mkcatchframe(ctx,makeint(0),&topjbuf);
1131  fprintf(stderr, "entering reploop\n");
1132  reploop(ctx,": ");}
1133  }
1134 
1135 /* load initial configuration file from EUSDIR/eusrt0.l */
1136 static void configure_eus(ctx)
1137 register context *ctx;
1138 { pointer argv, p, in;
1139  int i,j;
1140  char *eusdir, *eusrt;
1141  char fname[1024];
1142  extern pointer SRCLOAD();
1143 
1144  /* reset stack pointer and frame pointers*/
1145  j=(int)eussetjmp(topjbuf);
1146  eusdir=(char *)getenv("EUSDIR");
1147  if (eusdir==NULL) {
1148  fprintf(stderr, "EUSDIR is not setenved, assuming /usr/local/eus\n");
1149  eusdir= "/usr/local/eus/"; }
1150  sprintf(fname,"%s/lib/eus.init.l", eusdir);
1151 
1152 #if !Solaris2 || GCC
1153  /* read the init-module list from "EUSDIR/lib/eus.init.l" */
1154  in=(pointer)openfile(ctx,fname,O_RDONLY,0,256);
1155  if (in==NULL) {
1156  fprintf(stderr,
1157  "$EUSDIR/lib/eus.init.l was not found\nfailed to initialize.\n"
1158  "Entering raweus.\n"
1159  "To exit, type (unix::exit)\n");
1160  return;}
1161  vpush(in);
1162  p=reader(ctx,in,NIL);
1163  vpop();
1164  closestream(in);
1165  /* prinx(ctx,p,STDOUT); */
1166 #endif
1167 
1168  vpush(p);
1169  /* prinx(ctx,p,STDOUT); terpri(STDOUT); */
1171  vpop();
1172  speval(QLDENT)=p;
1173 
1174  eusrt=(char *)getenv("EUSRT");
1175  if (eusrt==NULL) sprintf(fname,"%s/lib/eusrt.l", eusdir);
1176  else strcpy(fname, eusrt);
1177  if (isatty(0)!=0) {
1178  fprintf(stderr, "configuring by \"%s\"\n", fname); }
1179  mkcatchframe(ctx,makeint(0),&topjbuf);
1180  argv=makestring(fname, strlen(fname));
1181  vpush(argv);
1182  eusstart(ctx);
1183  SRCLOAD(ctx, 1, ctx->vsp-1);
1184  }
1185 
1186 
1188 char *mainargv[32];
1189 
1190 
1191 #pragma GCC push_options
1192 #pragma GCC optimize ("no-tree-dce") /* DCE(Dummy Code Elimination) remove this malloc/cfree code, so this line tells compile not to remove them */
1193 void mainthread(ctx)
1194 register context *ctx;
1195 {
1196  /* following two lines are just to speed up frequent sbreak at the beginning
1197  of the execution and prevent returning 0 when calling malloc in the first time. */
1198  unsigned char *m;
1199  m=(unsigned char *)malloc(4*1024*1024);
1200  cfree(m);
1201 
1202  euscontexts[thr_self()]=ctx;
1203 
1204  /*initialize system*/
1205 #ifndef RGC
1206  initmemory();
1207 #endif
1208  initclassid();
1209 
1210  {
1211  int i;
1212  pointer specialtab;
1213  specialtab=alloc(MAX_SPECIALS+1,ELM_POINTER,vectorcp.cix,MAX_SPECIALS+1);
1214  specialtab->c.vec.size=makeint(MAX_SPECIALS);
1215  for (i=0; i<MAX_SPECIALS; i++) specialtab->c.vec.v[i]=NIL;
1216  ctx->specials=specialtab; }
1217 
1218  initpackage();
1219  initsymbols();
1220  initclasses();
1221  initfeatures();
1222 
1223  ctx->threadobj=NIL;
1224 
1225 
1226  /* define built-in functions */
1227  lists(ctx,sysmod); /*list functions and predicates*/
1228  predicates(ctx,sysmod); /*predicates*/
1229  sequence(ctx,sysmod); /*sequence functions*/
1230  specials(ctx,sysmod); /*control forms, special forms*/
1231  lispio(ctx,sysmod); /*lisp i/o*/
1232  loadsave(ctx,sysmod); /*loader and saver*/
1233  leo(ctx,sysmod); /*object oriented programming*/
1234  arith(ctx,sysmod); /*arithmetic functions*/
1235  matrix(ctx,sysmod); /*floatvector, matrix operation*/
1236  unixcall(ctx,sysmod); /*unix system binding*/
1237  foreign(ctx,sysmod); /*foreign function interface*/
1238  vectorarray(ctx,sysmod); /*vector and array functions*/
1239  charstring(ctx,sysmod);
1240 #if THREADED
1241  mthread(ctx,sysmod);
1242 #if Solaris2
1244  speval(QTHREADS)=cons(ctx, mainport, speval(QTHREADS));
1245  mainport->c.thrp.id=makeint((int)maintid);
1246 #endif
1247 #endif
1248 
1249  initreader(ctx);
1250  sysfunc(ctx,sysmod);
1251 #ifdef RGC
1252  rgcfunc(ctx,sysmod);
1253 #endif
1254  eusioctl(ctx,sysmod);
1255  Spevalof(PACKAGE)=userpkg;
1256 
1257  defvar(ctx,"*PROGRAM-NAME*",makestring(progname,strlen(progname)),lisppkg);
1258 
1259  /* exec_module_initializers(); */
1260  ctx->vsp=ctx->stack;
1261  configure_eus(ctx);
1262 
1263  signal(SIGCHLD, (void (*)())eusint);
1264  signal(SIGFPE, (void (*)())eusint);
1265  signal(SIGPIPE, (void (*)())eusint);
1266 #ifdef RGC
1267 // signal(SIGSEGV, (void (*)())eusint); /* for debugging. R.Hanai */
1268 #else
1269  signal(SIGSEGV, (void (*)())eusint);
1270 #endif
1271  signal(SIGBUS, (void (*)())eusint);
1272 
1273  toplevel(ctx,mainargc,mainargv);
1274 
1275  { pointer exithook=speval(QEXITHOOK);
1276  if (exithook != NIL) {
1277  ufuncall(ctx,exithook,exithook,(pointer)(ctx->vsp),0,0);}
1278  }
1279 
1280 #if THREADED
1281 #if SunOS4_1
1282  thr_exit(0);
1283 #else
1284  exit(0);
1285 #endif
1286 #endif
1287  }
1288 
1289 int main(argc,argv)
1290 int argc;
1291 char *argv[];
1292 { int i, stat=0;
1293  unsigned char *m;
1294 
1295 #ifdef Darwin
1296  _end = sbrk(0);
1297 #endif
1298 
1299  mypid=getpid();
1300  mainargc=argc;
1301  for (i=0; i<argc; i++) mainargv[i]=argv[i];
1302 
1303  tzset();
1304 
1305 #if Linux && !OLD_LINUX && !Darwin
1306  mallopt(M_MMAP_MAX,0);
1307 #endif
1308 
1309  /* following two lines are just to speed up frequent sbreak at the beginning
1310  of the execution. These lines may be deleted without any harm.*/
1311  m=(unsigned char *)malloc(4*1024*1024);
1312  cfree(m);
1313 
1314 #if vxworks
1315  progname=taskName(mypid);
1316 #else
1317  progname=argv[0];
1318 #endif
1319  /* get stack area and initialize stack/frame pointers */
1320  for (i=0; i<MAXTHREAD; i++) euscontexts[i]=0;
1321  mainctx=(context *)makelispcontext(MAXSTACK);
1322 #if THREADED
1323 #if Solaris2
1324  mutex_init(&mark_lock, USYNC_THREAD, 0);
1325  mutex_init(&p_mark_lock, USYNC_THREAD, 0);
1326  thr_create(0, 2*1024*1024,mainthread, mainctx, 0, &maintid);
1327  { sigset_t mainsig, omainsig;
1328  sigemptyset(&mainsig);
1329  sigaddset(&mainsig, SIGINT);
1330  /* printf("mainthread=%d\n", thr_self()); */
1331  thr_sigsetmask(SIG_BLOCK, &mainsig, &omainsig);
1332  }
1333  thr_join(maintid, 0, (void *)&stat);
1334 #else
1335 #if SunOS4_1 || alpha || PTHREAD
1336  mthread_init( mainctx );
1337 #ifdef RGC
1338  init_rgc();
1339 #endif
1340 #endif
1342 #endif /* Solaris2 */
1343 #else
1345 #endif
1346 
1347  { pointer exithook=speval(QEXITHOOK);
1348  if (exithook != NIL) {
1349  ufuncall(mainctx,exithook,exithook,(pointer)(mainctx->vsp),0,0);}
1350  }
1351 
1352  exit(stat);
1353  }
1354 #pragma GCC pop_options
1355 
1356 #if (WORD_SIZE == 64)
1358  if (v>(eusinteger_t)MAXPOSFIXNUM || v<(eusinteger_t)MINNEGFIXNUM) {
1359  if (v&0x7L) {
1360  return(mkbigint(v));
1361  }
1362  return ((pointer)(v|0x3L)); }
1363  else return((pointer)((v<<2)+2));
1364 }
1367  if (p==NULL) {
1368  fprintf(stderr,"p=null\n");
1369  raise(SIGSEGV);
1370  return 0;}
1371  else if ((i&0x3L)==0x3L) {
1372  return (i&~0x3L); }
1373  else if (isbignum(p)) {
1374  return (bigintval(p)); }
1375  else if ((i&0x7)==0x0L) {
1376  fprintf(stderr,";p=pointer?(%p)\n", p);
1377  return (i); }
1378  else return (((eusinteger_t)i)>>2);
1379 }
1380 #else
1382  if (v>(int)MAXPOSFIXNUM || v<(int)MINNEGFIXNUM) {
1383  // fprintf(stderr, "makeint(%x)\n", v);
1384  if (v&0x3) {
1385  // fprintf(stderr, "v=%x(bignum)\n", v);
1386  return(mkbigint(v));
1387  }
1388  return ((pointer)(v|0x3)); }
1389  else return((pointer)((v<<2)+2));
1390 }
1393  if (p==NULL) {
1394  fprintf(stderr,"p=null\n");
1395  return 0;}
1396  else if ((i&0x3)==0x3) {
1397  return (i&~0x3); }
1398  else if (isbignum(p)) {
1399  return (bigintval(p)); }
1400  else if ((i&0x3)==0x0) {
1401  fprintf(stderr,";p=pointer?(%p)\n", p);
1402  return (i); }
1403  else return (((eusinteger_t)i)>>2);
1404 }
1405 #endif
1406 
makemodule
pointer makemodule(context *, int)
Definition: makes.c:486
alloc
pointer alloc(int, int, int, int)
Definition: memory.mutex.c:241
OBJECT
pointer OBJECT
Definition: eus.c:154
QPARAGC
pointer QPARAGC
Definition: eus.c:125
_end
int _end
Definition: eus.c:33
PKGCLASS
pointer PKGCLASS
Definition: eus.c:152
makeclass
pointer makeclass(context *, pointer, pointer, pointer, pointer, pointer, int, pointer)
Definition: makes.c:375
numunion
Definition: eus.h:428
cell::cellunion::cls
struct _class cls
Definition: eus.h:418
hide_ptr
eusinteger_t hide_ptr(pointer p)
Definition: eus.c:1407
mkfilestream
pointer mkfilestream(context *, pointer, pointer, int, pointer)
Definition: makes.c:253
buddy
struct buddyfree buddy[MAXBUDDY+1]
Definition: eus.c:46
iostreamcp
cixpair iostreamcp
Definition: eus.c:76
AUX
pointer AUX
Definition: eus.c:170
PRCIRCLE
pointer PRCIRCLE
Definition: eus.c:171
FLTVECTOR
pointer FLTVECTOR
Definition: eus.c:154
NIL
pointer NIL
Definition: eus.c:110
matrix
void matrix(context *, pointer)
Definition: matrix.c:1348
QCONS
pointer QCONS
Definition: eus.c:151
bignumcp
cixpair bignumcp
Definition: eus.c:97
topjbuf
jmp_buf topjbuf
Definition: eus.c:185
QUNBOUND
pointer QUNBOUND
Definition: eus.c:123
K_FUNCTION_DOCUMENTATION
pointer K_FUNCTION_DOCUMENTATION
Definition: eus.c:175
_class::types
pointer types
Definition: eus.h:329
C_CODE
pointer C_CODE
Definition: eus.c:143
C_FLTVECTOR
pointer C_FLTVECTOR
Definition: eus.c:146
QUOTE
pointer QUOTE
Definition: eus.c:110
callframe::vlink
struct callframe * vlink
Definition: eus.h:475
unwind
void unwind(context *ctx, pointer *p)
Definition: eus.c:274
BIGNUM
pointer BIGNUM
Definition: eus.c:156
C_PROPOBJ
static pointer C_PROPOBJ
Definition: eus.c:180
cell::cellunion::thrp
struct threadport thrp
Definition: eus.h:421
objectcp
cixpair objectcp
Definition: eus.c:69
VECTOR
pointer VECTOR
Definition: eus.c:154
eussigvec
pointer eussigvec[NSIG]
Definition: eus.c:182
QTHREADS
pointer QTHREADS
Definition: eus.c:124
errorcode
errorcode
Definition: eus.h:919
makeint
pointer makeint(eusinteger_t v)
Definition: eus.c:1357
QGCHOOK
pointer QGCHOOK
Definition: eus.c:122
toplevel
static void toplevel(context *ctx, int argc, argv)
Definition: eus.c:1106
xpkg
pointer xpkg
Definition: eus.c:109
QINTEGER
pointer QINTEGER
Definition: eus.c:120
extnumcp
cixpair extnumcp
Definition: eus.c:94
K_DOUBLE
pointer K_DOUBLE
Definition: eus.c:133
context
Definition: eus.h:524
configure_eus
static void configure_eus(context *ctx)
Definition: eus.c:1136
symbol::plist
pointer plist
Definition: eus.h:203
K_CHAR
pointer K_CHAR
Definition: eus.c:132
C_FILESTREAM
pointer C_FILESTREAM
Definition: eus.c:143
deflocal
pointer deflocal(context *, char *, pointer, pointer)
Definition: makes.c:716
loadsave
void loadsave(context *, pointer)
Definition: loadelf.c:428
defkeyword
pointer defkeyword(context *, char *)
Definition: makes.c:733
C_COMPLEX
pointer C_COMPLEX
Definition: eus.c:148
s
short s
Definition: structsize.c:2
complexcp
cixpair complexcp
Definition: eus.c:96
export_all
int export_all
Definition: intern.c:11
E_NOCLASS
@ E_NOCLASS
Definition: eus.h:962
codecp
cixpair codecp
Definition: eus.c:79
PRSTRUCTURE
pointer PRSTRUCTURE
Definition: eus.c:171
closurecp
cixpair closurecp
Definition: eus.c:83
E_END
@ E_END
Definition: eus.h:1009
PACKAGE
pointer PACKAGE
Definition: eus.c:110
C_RATIO
pointer C_RATIO
Definition: eus.c:148
ehbypass
int ehbypass
Definition: eus.c:160
sequence
void sequence(context *, pointer)
Definition: sequence.c:1070
reploop
static pointer reploop(context *, char *)
Definition: eus.c:1085
C_LDMOD
pointer C_LDMOD
Definition: eus.c:143
makevector
pointer makevector(pointer, int)
Definition: makes.c:417
packagecp
cixpair packagecp
Definition: eus.c:73
nextbclass
int nextbclass
Definition: eus.c:101
gcing
long gcing
gcstack
pointer * gcstack
Definition: memory.c:414
userpkg
pointer userpkg
Definition: eus.c:109
QEQUAL
pointer QEQUAL
Definition: eus.c:127
lispio
void lispio(context *, pointer)
Definition: lispio.c:589
PRLENGTH
pointer PRLENGTH
Definition: eus.c:171
K_POINTER
pointer K_POINTER
Definition: eus.c:132
QEVALHOOK
pointer QEVALHOOK
Definition: eus.c:121
sigbreak
void sigbreak()
Definition: eus.c:1060
QEXITHOOK
pointer QEXITHOOK
Definition: eus.c:122
makelabref
pointer makelabref(pointer, pointer, pointer)
Definition: makes.c:538
T
pointer T
Definition: eus.c:110
FOREIGNCODE
pointer FOREIGNCODE
Definition: eus.c:155
protectframe
Definition: eus.h:504
pointer
struct cell * pointer
Definition: eus.h:165
builtinclass
struct built_in_cid builtinclass[64]
Definition: eus.c:100
K_BIT
pointer K_BIT
Definition: eus.c:132
KEY
pointer KEY
Definition: eus.c:170
mainargv
char * mainargv[32]
Definition: eus.c:1188
K_CLASS
pointer K_CLASS
Definition: eus.c:176
foreign
void foreign(context *ctx, pointer mod)
Definition: calleus.c:225
PRLEVEL
pointer PRLEVEL
Definition: eus.c:171
QNUMBER
pointer QNUMBER
Definition: eus.c:120
conscp
cixpair conscp
Definition: eus.c:70
list_module_initializers
pointer list_module_initializers(context *, pointer)
Definition: loadelf.c:153
cell::cellunion::fstream
struct filestream fstream
Definition: eus.h:406
QLDENT
pointer QLDENT
Definition: eus.c:173
package::plist
pointer plist
Definition: eus.h:219
intsig
int intsig
Definition: eus.c:159
K_SHORT
pointer K_SHORT
Definition: eus.c:132
init_rgc
void init_rgc()
Definition: collector.c:484
eus.h
E_NOVARIABLE
@ E_NOVARIABLE
Definition: eus.h:988
cell::cellunion::sym
struct symbol sym
Definition: eus.h:401
progname
char * progname
Definition: eus.c:39
makestring
pointer makestring(char *, int)
Definition: makes.c:147
mark_lock
mutex_t mark_lock
Definition: mthread.c:25
C_VECTOR
pointer C_VECTOR
Definition: eus.c:144
mkcatchframe
void mkcatchframe(context *, pointer, jmp_buf *)
Definition: makes.c:801
package::shadows
pointer shadows
Definition: eus.h:226
SYMBOL
pointer SYMBOL
Definition: eus.c:151
ARRAY
pointer ARRAY
Definition: eus.c:155
sysmod
pointer sysmod
Definition: eus.c:184
class::cix
pointer cix
Definition: eus.old.h:211
C_ARRAY
pointer C_ARRAY
Definition: eus.c:147
STRING
pointer STRING
Definition: eus.c:151
eusstart
void eusstart(context *)
K_BYTE
pointer K_BYTE
Definition: eus.c:132
QDEBUG
pointer QDEBUG
Definition: eus.c:123
built_in_cid
Definition: eus.h:572
COMPLEX
pointer COMPLEX
Definition: eus.c:156
E_NOPACKAGE
@ E_NOPACKAGE
Definition: eus.h:973
mainctx
context * mainctx
Definition: eus.c:57
unbindspecial
void unbindspecial(context *, struct specialbindframe *)
Definition: eval.c:165
RANDSTATE
pointer RANDSTATE
Definition: eus.c:172
K_INVERT
pointer K_INVERT
Definition: eus.c:134
fcodecp
cixpair fcodecp
Definition: eus.c:80
C_LABREF
pointer C_LABREF
Definition: eus.c:144
FEATURES
pointer FEATURES
Definition: eus.c:172
SELF
pointer SELF
Definition: eus.c:116
E_SYMBOLCONFLICT
@ E_SYMBOLCONFLICT
Definition: eus.h:1003
rawcons
pointer rawcons(context *, pointer, pointer)
Definition: makes.c:86
p_mark_lock
mutex_t p_mark_lock
C_PACKAGE
pointer C_PACKAGE
Definition: eus.c:142
E_READLABEL
@ E_READLABEL
Definition: eus.h:991
class_desc::subcix
short subcix
Definition: eus.h:569
makebuffer
pointer makebuffer(int)
Definition: makes.c:140
QSTDIN
pointer QSTDIN
Definition: eus.c:119
QLOADED_MODULES
pointer QLOADED_MODULES
Definition: eus.c:177
STDIN
pointer STDIN
Definition: eus.c:119
defconst
pointer defconst(context *, char *, pointer, pointer)
Definition: makes.c:693
intern
pointer intern(context *, char *, int, pointer)
Definition: intern.c:105
threadcp
cixpair threadcp
Definition: eus.c:85
THREAD
pointer THREAD
Definition: eus.c:153
K_DISPOSE
pointer K_DISPOSE
Definition: eus.c:135
readtablecp
cixpair readtablecp
Definition: eus.c:87
C_OBJECT
pointer C_OBJECT
Definition: eus.c:142
mypid
eusinteger_t mypid
Definition: eus.c:38
K_NOMETHOD
pointer K_NOMETHOD
Definition: eus.c:132
CLASS
pointer CLASS
Definition: eus.c:118
cell::c
union cell::cellunion c
labrefcp
cixpair labrefcp
Definition: eus.c:84
K_STRING
pointer K_STRING
Definition: eus.c:131
vectorarray
void vectorarray(context *, pointer)
Definition: vectorarray.c:459
K_FILE
pointer K_FILE
Definition: eus.c:131
defvar
pointer defvar(context *, char *, pointer, pointer)
Definition: makes.c:704
fltvectorcp
cixpair fltvectorcp
Definition: eus.c:89
C_FOREIGNCODE
pointer C_FOREIGNCODE
Definition: eus.c:147
lists
void lists(context *, pointer)
Definition: lists.c:411
gcsplimit
pointer * gcsplimit
Definition: eus.c:47
IOSTREAM
pointer IOSTREAM
Definition: eus.c:151
context::bindfp
struct bindframe * bindfp
Definition: eus.h:531
K_METHOD_DOCUMENTATION
pointer K_METHOD_DOCUMENTATION
Definition: eus.c:176
cons::cdr
pointer cdr
Definition: eus.h:197
arith
void arith(context *ctx, pointer mod)
Definition: arith.c:1466
newchunk
int newchunk(int)
Definition: memory.c:67
C_CLOSURE
pointer C_CLOSURE
Definition: eus.c:144
initmemory_rgc
void initmemory_rgc()
Definition: eus.c:490
FILESTREAM
pointer FILESTREAM
Definition: eus.c:151
initreader
void initreader(context *)
Definition: reader.c:1034
E_UNDEF
@ E_UNDEF
Definition: eus.h:941
EXTNUM
pointer EXTNUM
Definition: eus.c:156
E_NOCATCHER
@ E_NOCATCHER
Definition: eus.h:952
vecclass
Definition: eus.h:334
reader
pointer reader(context *, pointer, pointer)
Definition: reader.c:1016
C_READTABLE
pointer C_READTABLE
Definition: eus.c:147
cell::cellunion::ldmod
struct ldmodule ldmod
Definition: eus.h:410
cell::cellunion::vcls
struct vecclass vcls
Definition: eus.h:419
mainargc
int mainargc
Definition: eus.c:1187
flushstream
int flushstream(pointer)
Definition: eusstream.c:159
PROBJECT
pointer PROBJECT
Definition: eus.c:171
streamcp
cixpair streamcp
Definition: eus.c:74
LABREF
pointer LABREF
Definition: eus.c:152
E_ILLCH
@ E_ILLCH
Definition: eus.h:944
leo
void leo(context *, pointer)
Definition: leo.c:714
rgcfunc
void rgcfunc(register context *ctx, pointer mod)
Definition: collector.c:1235
COMCLOSURE
pointer COMCLOSURE
Definition: eus.c:170
ERRHANDLER
pointer ERRHANDLER
Definition: eus.c:121
STDOUT
pointer STDOUT
Definition: eus.c:119
intval
eusinteger_t intval(pointer p)
Definition: eus.c:1365
K_CLASS_DOCUMENTATION
pointer K_CLASS_DOCUMENTATION
Definition: eus.c:176
propobjcp
cixpair propobjcp
Definition: eus.c:71
RATIO
pointer RATIO
Definition: eus.c:156
NULL
#define NULL
Definition: transargv.c:8
class_desc
Definition: eus.h:567
cixpair::cix
short cix
Definition: eus.h:453
K_IO
pointer K_IO
Definition: eus.c:130
E_PKGNAME
@ E_PKGNAME
Definition: eus.h:974
bpointer
struct bcell * bpointer
Definition: eus.h:445
QOR
pointer QOR
Definition: eus.c:127
OPTIONAL
pointer OPTIONAL
Definition: eus.c:170
intcode
int intcode
Definition: eus.c:159
C_EXTNUM
pointer C_EXTNUM
Definition: eus.c:148
E_NOMETHOD
@ E_NOMETHOD
Definition: eus.h:968
symbolcp
cixpair symbolcp
Definition: eus.c:72
BITVECTOR
pointer BITVECTOR
Definition: eus.c:155
initfeatures
static void initfeatures()
Definition: eus.c:831
READBASE
pointer READBASE
Definition: eus.c:172
cixpair::sub
short sub
Definition: eus.h:454
vector::v
pointer v[1]
Definition: eus.h:301
metaclasscp
cixpair metaclasscp
Definition: eus.c:77
euscontexts
context * euscontexts[MAXTHREAD]
Definition: eus.c:105
callframe
Definition: eus.h:474
classtab
struct class_desc classtab[MAXCLASS]
Definition: eus.c:138
initmemory
static void initmemory()
Definition: eus.c:466
blockframe
Definition: eus.h:489
package::used_by
pointer used_by
Definition: eus.h:227
sharpmacro
pointer sharpmacro[256]
Definition: eus.c:164
K_ALLOWOTHERKEYS
pointer K_ALLOWOTHERKEYS
Definition: eus.c:169
basicclass
pointer basicclass(char *name,...) pointer basicclass(va_alist) va_dcl
Definition: eus.c:405
cell::cellunion::cons
struct cons cons
Definition: eus.h:400
K_INTEGER
pointer K_INTEGER
Definition: eus.c:132
pkglist
pointer pkglist
Definition: eus.c:109
STREAM
pointer STREAM
Definition: eus.c:151
QVERSION
pointer QVERSION
Definition: eus.c:126
K_DOWNCASE
pointer K_DOWNCASE
Definition: eus.c:134
object::iv
pointer iv[2]
Definition: eus.h:321
syspkg
pointer syspkg
Definition: eus.c:109
QERROUT
pointer QERROUT
Definition: eus.c:119
QSELF
pointer QSELF
Definition: eus.c:114
ALLOWOTHERKEYS
pointer ALLOWOTHERKEYS
Definition: eus.c:169
C_SYMBOL
pointer C_SYMBOL
Definition: eus.c:142
prinx
pointer prinx(context *, pointer, pointer)
Definition: printer.c:611
unixpkg
pointer unixpkg
Definition: eus.c:109
PRCASE
pointer PRCASE
Definition: eus.c:171
ldmodule::codevec
pointer codevec
Definition: eus.h:250
REST
pointer REST
Definition: eus.c:170
K_IN
pointer K_IN
Definition: eus.c:130
setjmp_val
euspointer_t setjmp_val
Definition: eus.c:41
euspointer_t
unsigned long euspointer_t
Definition: eus.h:20
QFIXNUM
pointer QFIXNUM
Definition: eus.c:120
makelispcontext
context * makelispcontext(int)
Definition: makes.c:840
cons
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
ldmodule::handle
pointer handle
Definition: eus.h:259
C_CONS
pointer C_CONS
Definition: eus.c:142
eval
pointer eval(context *, pointer)
Definition: eval.c:1622
ratiocp
cixpair ratiocp
Definition: eus.c:95
vector::size
pointer size
Definition: eus.h:300
sysobj
pointer sysobj
Definition: eus.c:54
MACRO
pointer MACRO
Definition: eus.c:170
nextcix
int nextcix
Definition: eus.c:139
filestreamcp
cixpair filestreamcp
Definition: eus.c:75
QTERMIO
pointer QTERMIO
Definition: eus.c:172
vecclasscp
cixpair vecclasscp
Definition: eus.c:78
QSPECIAL
pointer QSPECIAL
Definition: eus.c:112
VECCLASS
pointer VECCLASS
Definition: eus.c:154
cell::cellunion::obj
struct object obj
Definition: eus.h:417
E_UNBOUND
@ E_UNBOUND
Definition: eus.h:940
charmacro
pointer charmacro[256]
Definition: eus.c:163
GCMERGE
pointer GCMERGE
Definition: eus.c:173
threadport::id
pointer id
Definition: eus.h:355
lisppkg
pointer lisppkg
Definition: eus.c:109
CLOSURE
pointer CLOSURE
Definition: eus.c:152
filestream::fd
pointer fd
Definition: eus.h:286
QNOT
pointer QNOT
Definition: eus.c:127
makeflt
pointer makeflt()
C_STRING
pointer C_STRING
Definition: eus.c:146
error
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
symbol::speval
pointer speval
Definition: eus.h:204
mainport
pointer mainport
Definition: eus.c:58
PRINTBASE
pointer PRINTBASE
Definition: eus.c:172
K_LONG
pointer K_LONG
Definition: eus.c:132
QAND
pointer QAND
Definition: eus.c:127
ERROUT
pointer ERROUT
Definition: eus.c:119
initpackage
static void initpackage()
Definition: eus.c:549
C_BITVECTOR
pointer C_BITVECTOR
Definition: eus.c:146
main
int main(int argc, argv)
Definition: eus.c:1289
buddyfree
Definition: eus.h:563
C_METACLASS
pointer C_METACLASS
Definition: eus.c:144
QFLOAT
pointer QFLOAT
Definition: eus.c:120
K_UPCASE
pointer K_UPCASE
Definition: eus.c:134
vecclass::elmtype
pointer elmtype
Definition: eus.h:343
MAXCALLSTACKDEPTH
pointer MAXCALLSTACKDEPTH
Definition: eus.c:178
K_OUT
pointer K_OUT
Definition: eus.c:130
predicates
void predicates(context *, pointer)
Definition: predicates.c:214
eusioctl
void eusioctl(context *, pointer)
Definition: eusioctl.c:250
package::names
pointer names
Definition: eus.h:220
K_PRIN1
pointer K_PRIN1
Definition: eus.c:174
openfile
pointer openfile(context *, char *, int, int, int)
Definition: eusstream.c:30
argc
static int argc
Definition: transargv.c:56
TOPLEVEL
pointer TOPLEVEL
Definition: eus.c:121
CODE
pointer CODE
Definition: eus.c:152
FCODE
pointer FCODE
Definition: eus.c:152
vecclass::cix
pointer cix
Definition: eus.h:338
cell
Definition: eus.h:381
export
#define export
Definition: test_foreign.c:12
_sema
Definition: eus_thr.h:96
eusinteger_t
long eusinteger_t
Definition: eus.h:19
C_VCLASS
pointer C_VCLASS
Definition: eus.c:146
makepkg
pointer makepkg(context *, pointer, pointer, pointer)
Definition: makes.c:201
context::vsp
pointer * vsp
Definition: eus.h:525
K_FLOAT32
pointer K_FLOAT32
Definition: eus.c:133
unixcall
void unixcall(context *, pointer)
keywordpkg
pointer keywordpkg
Definition: eus.c:109
closestream
int closestream(pointer)
Definition: eusstream.c:53
rcsid
static char * rcsid
Definition: eus.c:9
allocate_heap
unsigned int allocate_heap()
Definition: collector.c:1195
bitvectorcp
cixpair bitvectorcp
Definition: eus.c:92
built_in_cid::cls
pointer cls
Definition: eus.h:573
E_EXTSYMBOL
@ E_EXTSYMBOL
Definition: eus.h:1002
stacknlist
pointer stacknlist(context *, int)
Definition: makes.c:129
LAMCLOSURE
pointer LAMCLOSURE
Definition: eus.c:170
defvector
pointer defvector()
thr_create
int thr_create(void *, size_t, void(*)(), void *, long, int *)
Definition: pthreads.c:43
METACLASS
pointer METACLASS
Definition: eus.c:152
buddysize
long buddysize[MAXBUDDY+1]
Definition: eus.c:103
READTABLE
pointer READTABLE
Definition: eus.c:154
C_BIGNUM
pointer C_BIGNUM
Definition: eus.c:148
specials
void specials(context *, pointer)
Definition: specials.c:1284
E_NOOBJ
@ E_NOOBJ
Definition: eus.h:975
sema_post
int sema_post(sema_t *sem)
Definition: pthreads.c:148
C_IOSTREAM
pointer C_IOSTREAM
Definition: eus.c:143
K_VARIABLE_DOCUMENTATION
pointer K_VARIABLE_DOCUMENTATION
Definition: eus.c:175
specialbindframe
Definition: eus.h:484
maintid
thread_t maintid
Definition: eus.c:60
FATALERROR
pointer FATALERROR
Definition: eus.c:121
oblabels
pointer oblabels
Definition: lispio.c:18
initclassid
static void initclassid()
Definition: eus.c:518
sysfunc
void sysfunc(context *, pointer)
Definition: sysfunc.c:774
K_FOREIGN_STRING
pointer K_FOREIGN_STRING
Definition: eus.c:133
context::callfp
struct callframe * callfp
Definition: eus.h:529
stringcp
cixpair stringcp
Definition: eus.c:91
C_INTVECTOR
pointer C_INTVECTOR
Definition: eus.c:146
intvectorcp
cixpair intvectorcp
Definition: eus.c:90
package::use
pointer use
Definition: eus.h:221
K_CAPITALIZE
pointer K_CAPITALIZE
Definition: eus.c:134
cixpair
Definition: eus.h:452
initclasses
static void initclasses()
Definition: eus.c:693
QEQ
pointer QEQ
Definition: eus.c:127
ldmodulecp
cixpair ldmodulecp
Definition: eus.c:82
initsymbols
static void initsymbols()
Definition: eus.c:583
QREADTABLE
pointer QREADTABLE
Definition: eus.c:172
terpri
void terpri(pointer)
Definition: printer.c:637
buddyfree::bp
bpointer bp
Definition: eus.h:565
K_FOREIGN
pointer K_FOREIGN
Definition: eus.c:133
E_USER
@ E_USER
Definition: eus.h:1006
K_FILL
pointer K_FILL
Definition: eus.c:131
LAMBDA
pointer LAMBDA
Definition: eus.c:170
PROPOBJ
static pointer PROPOBJ
Definition: eus.c:180
ufuncall
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1469
charstring
void charstring(context *ctx, pointer mod)
Definition: charstring.c:180
_class::forwards
pointer forwards
Definition: eus.h:330
makethreadport
pointer makethreadport(context *)
Definition: makes.c:916
code
Definition: eus.h:230
SRCLOAD
pointer SRCLOAD(context *, int, pointer *)
FUNCTION
pointer FUNCTION
Definition: eus.c:111
cell::cellunion::vec
struct vector vec
Definition: eus.h:414
eusint
void eusint(int s, int code, int x, eusinteger_t addr)
Definition: eus.c:976
vectorcp
cixpair vectorcp
Definition: eus.c:88
mthread
int mthread(context *ctx, pointer mod)
Definition: mthread.c:536
thr_join
int thr_join(int tid, int *depature, void **status)
Definition: pthreads.c:75
mainthread
void mainthread(context *ctx)
Definition: eus.c:1193
INTVECTOR
pointer INTVECTOR
Definition: eus.c:154
context::errhandler
pointer errhandler
Definition: eus.h:537
K_FLUSH
pointer K_FLUSH
Definition: eus.c:131
C_FCODE
pointer C_FCODE
Definition: eus.c:143
E_NOKEYPARAM
@ E_NOKEYPARAM
Definition: eus.h:998
class
Definition: eus.old.h:207
cell::cellunion::pkg
struct package pkg
Definition: eus.h:404
GCMARGIN
pointer GCMARGIN
Definition: eus.c:173
n
GLfloat n[6][3]
Definition: cube.c:15
E_NOOBJVAR
@ E_NOOBJVAR
Definition: eus.h:976
buddyfree::count
int count
Definition: eus.h:564
built_in_cid::cp
cixpair * cp
Definition: eus.h:574
symbol::homepkg
pointer homepkg
Definition: eus.h:208
gcsp
pointer * gcsp
Definition: eus.c:47
K_FLOAT
pointer K_FLOAT
Definition: eus.c:133
errmsg
char * errmsg[100]
Definition: eus.c:191
catchframe
Definition: eus.h:495
v
GLfloat v[8][3]
Definition: cube.c:21
brkloop
static pointer brkloop()
K_PRESERVE
pointer K_PRESERVE
Definition: eus.c:134
_class::vars
pointer vars
Definition: eus.h:328
C_THREAD
pointer C_THREAD
Definition: eus.c:145
thr_self
unsigned int thr_self()
Definition: eus.c:25
C_STREAM
pointer C_STREAM
Definition: eus.c:143
QDECLARE
pointer QDECLARE
Definition: eus.c:112
LDMODULE
pointer LDMODULE
Definition: eus.c:152
QSTDOUT
pointer QSTDOUT
Definition: eus.c:119
fletframe
Definition: eus.h:509
context::intsig
int intsig
Definition: eus.h:546
arraycp
cixpair arraycp
Definition: eus.c:86
callframe::form
pointer form
Definition: eus.h:476


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43