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];
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 
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);
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,"%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);
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
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,
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=%d", 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);
964  sysmod->c.ldmod.codevec=makeint(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);
1017  flushstream(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;
1071  QEVALHOOK->c.sym.speval=NIL;
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 void mainthread(ctx)
1192 register context *ctx;
1193 {
1194  euscontexts[thr_self()]=ctx;
1195 
1196  /*initialize system*/
1197 #ifndef RGC
1198  initmemory();
1199 #endif
1200  initclassid();
1201 
1202  {
1203  int i;
1204  pointer specialtab;
1205  specialtab=alloc(MAX_SPECIALS+1,ELM_POINTER,vectorcp.cix,MAX_SPECIALS+1);
1206  specialtab->c.vec.size=makeint(MAX_SPECIALS);
1207  for (i=0; i<MAX_SPECIALS; i++) specialtab->c.vec.v[i]=NIL;
1208  ctx->specials=specialtab; }
1209 
1210  initpackage();
1211  initsymbols();
1212  initclasses();
1213  initfeatures();
1214 
1215  ctx->threadobj=NIL;
1216 
1217 
1218  /* define built-in functions */
1219  lists(ctx,sysmod); /*list functions and predicates*/
1220  predicates(ctx,sysmod); /*predicates*/
1221  sequence(ctx,sysmod); /*sequence functions*/
1222  specials(ctx,sysmod); /*control forms, special forms*/
1223  lispio(ctx,sysmod); /*lisp i/o*/
1224  loadsave(ctx,sysmod); /*loader and saver*/
1225  leo(ctx,sysmod); /*object oriented programming*/
1226  arith(ctx,sysmod); /*arithmetic functions*/
1227  matrix(ctx,sysmod); /*floatvector, matrix operation*/
1228  unixcall(ctx,sysmod); /*unix system binding*/
1229  foreign(ctx,sysmod); /*foreign function interface*/
1230  vectorarray(ctx,sysmod); /*vector and array functions*/
1231  charstring(ctx,sysmod);
1232 #if THREADED
1233  mthread(ctx,sysmod);
1234 #if Solaris2
1235  mainport=makethreadport(mainctx);
1236  speval(QTHREADS)=cons(ctx, mainport, speval(QTHREADS));
1237  mainport->c.thrp.id=makeint((int)maintid);
1238 #endif
1239 #endif
1240 
1241  initreader(ctx);
1242  sysfunc(ctx,sysmod);
1243 #ifdef RGC
1244  rgcfunc(ctx,sysmod);
1245 #endif
1246  eusioctl(ctx,sysmod);
1247  Spevalof(PACKAGE)=userpkg;
1248 
1249  defvar(ctx,"*PROGRAM-NAME*",makestring(progname,strlen(progname)),lisppkg);
1250 
1251  /* exec_module_initializers(); */
1252  ctx->vsp=ctx->stack;
1253  configure_eus(ctx);
1254 
1255  signal(SIGCHLD, (void (*)())eusint);
1256  signal(SIGFPE, (void (*)())eusint);
1257  signal(SIGPIPE, (void (*)())eusint);
1258 #ifdef RGC
1259 // signal(SIGSEGV, (void (*)())eusint); /* for debugging. R.Hanai */
1260 #else
1261  signal(SIGSEGV, (void (*)())eusint);
1262 #endif
1263  signal(SIGBUS, (void (*)())eusint);
1264 
1265  toplevel(ctx,mainargc,mainargv);
1266 
1267  { pointer exithook=speval(QEXITHOOK);
1268  if (exithook != NIL) {
1269  ufuncall(ctx,exithook,exithook,(pointer)(ctx->vsp),0,0);}
1270  }
1271 
1272 #if THREADED
1273 #if SunOS4_1
1274  thr_exit(0);
1275 #else
1276  exit(0);
1277 #endif
1278 #endif
1279  }
1280 
1281 int main(argc,argv)
1282 int argc;
1283 char *argv[];
1284 { int i, stat=0;
1285  unsigned char *m;
1286 
1287 #ifdef Darwin
1288  _end = sbrk(0);
1289 #endif
1290 
1291  mypid=getpid();
1292  mainargc=argc;
1293  for (i=0; i<argc; i++) mainargv[i]=argv[i];
1294 
1295  tzset();
1296 
1297 #if Linux && !OLD_LINUX && !Darwin
1298  mallopt(M_MMAP_MAX,0);
1299 #endif
1300 
1301  /* following two lines are just to speed up frequent sbreak at the beginning
1302  of the execution. These lines may be deleted without any harm.*/
1303  m=(unsigned char *)malloc(4*1024*1024);
1304  cfree(m);
1305 
1306 #if vxworks
1307  progname=taskName(mypid);
1308 #else
1309  progname=argv[0];
1310 #endif
1311  /* get stack area and initialize stack/frame pointers */
1312  for (i=0; i<MAXTHREAD; i++) euscontexts[i]=0;
1313  mainctx=(context *)makelispcontext(MAXSTACK);
1314 #if THREADED
1315 #if Solaris2
1316  mutex_init(&mark_lock, USYNC_THREAD, 0);
1317  mutex_init(&p_mark_lock, USYNC_THREAD, 0);
1318  thr_create(0, 2*1024*1024,mainthread, mainctx, 0, &maintid);
1319  { sigset_t mainsig, omainsig;
1320  sigemptyset(&mainsig);
1321  sigaddset(&mainsig, SIGINT);
1322  /* printf("mainthread=%d\n", thr_self()); */
1323  thr_sigsetmask(SIG_BLOCK, &mainsig, &omainsig);
1324  }
1325  thr_join(maintid, 0, (void *)&stat);
1326 #else
1327 #if SunOS4_1 || alpha || PTHREAD
1328  mthread_init( mainctx );
1329 #ifdef RGC
1330  init_rgc();
1331 #endif
1332 #endif
1333  mainthread(mainctx);
1334 #endif /* Solaris2 */
1335 #else
1336  mainthread(mainctx);
1337 #endif
1338 
1339  { pointer exithook=speval(QEXITHOOK);
1340  if (exithook != NIL) {
1341  ufuncall(mainctx,exithook,exithook,(pointer)(mainctx->vsp),0,0);}
1342  }
1343 
1344  exit(stat);
1345  }
1346 
1347 #if (WORD_SIZE == 64)
1349  if (v>(eusinteger_t)MAXPOSFIXNUM || v<(eusinteger_t)MINNEGFIXNUM) {
1350  if (v&0x7L) {
1351  return(mkbigint(v));
1352  }
1353  return ((pointer)(v|0x3L)); }
1354  else return((pointer)((v<<2)+2));
1355 }
1358  if (p==NULL) {
1359  fprintf(stderr,"p=null\n");
1360  raise(SIGSEGV);
1361  return 0;}
1362  else if ((i&0x3L)==0x3L) {
1363  return (i&~0x3L); }
1364  else if (isbignum(p)) {
1365  return (bigintval(p)); }
1366  else if ((i&0x7)==0x0L) {
1367  fprintf(stderr,";p=pointer?(%p)\n", p);
1368  return (i); }
1369  else return (((eusinteger_t)i)>>2);
1370 }
1371 #else
1373  if (v>(int)MAXPOSFIXNUM || v<(int)MINNEGFIXNUM) {
1374  // fprintf(stderr, "makeint(%x)\n", v);
1375  if (v&0x3) {
1376  // fprintf(stderr, "v=%x(bignum)\n", v);
1377  return(mkbigint(v));
1378  }
1379  return ((pointer)(v|0x3)); }
1380  else return((pointer)((v<<2)+2));
1381 }
1384  if (p==NULL) {
1385  fprintf(stderr,"p=null\n");
1386  return 0;}
1387  else if ((i&0x3)==0x3) {
1388  return (i&~0x3); }
1389  else if (isbignum(p)) {
1390  return (bigintval(p)); }
1391  else if ((i&0x3)==0x0) {
1392  fprintf(stderr,";p=pointer?(%p)\n", p);
1393  return (i); }
1394  else return (((eusinteger_t)i)>>2);
1395 }
1396 #endif
1397 
pointer used_by
Definition: eus.h:225
pointer IOSTREAM
Definition: eus.c:151
pointer K_IN
Definition: eus.c:130
context * euscontexts[MAXTHREAD]
Definition: eus.c:105
Definition: eus.h:561
pointer GCMARGIN
Definition: eus.c:173
pointer prinx(context *, pointer, pointer)
Definition: printer.c:611
pointer speval
Definition: eus.h:201
pointer AUX
Definition: eus.c:170
int intcode
Definition: eus.c:159
pointer defconst(context *, char *, pointer, pointer)
Definition: makes.c:693
pointer C_STREAM
Definition: eus.c:143
pointer rawcons(context *, pointer, pointer)
Definition: makes.c:86
int nextcix
Definition: eus.c:139
pointer LAMCLOSURE
Definition: eus.c:170
char * progname
Definition: eus.c:39
pointer TOPLEVEL
Definition: eus.c:121
pointer QNUMBER
Definition: eus.c:120
pointer C_CLOSURE
Definition: eus.c:144
Definition: eus.h:971
pointer intern(context *, char *, int, pointer)
Definition: intern.c:105
pointer list_module_initializers(context *, pointer)
Definition: loadelf.c:153
cixpair vectorcp
Definition: eus.c:88
pointer FEATURES
Definition: eus.c:172
pointer makeint(eusinteger_t v)
Definition: eus.c:1348
struct vector vec
Definition: eus.h:412
struct _class cls
Definition: eus.h:416
pointer QFLOAT
Definition: eus.c:120
cixpair iostreamcp
Definition: eus.c:76
int intsig
Definition: eus.c:159
pointer FUNCTION
Definition: eus.c:111
pointer K_CLASS_DOCUMENTATION
Definition: eus.c:175
struct cell * pointer
Definition: eus.h:163
pointer C_VECTOR
Definition: eus.c:144
pointer K_OUT
Definition: eus.c:130
Definition: eus.h:522
pointer STDOUT
Definition: eus.c:119
pointer cons(context *, pointer, pointer)
Definition: makes.c:97
pointer QLDENT
Definition: eus.c:173
int mthread(context *ctx, pointer mod)
Definition: mthread.c:536
struct filestream fstream
Definition: eus.h:404
pointer GCMERGE
Definition: eus.c:173
pointer KEY
Definition: eus.c:170
cixpair packagecp
Definition: eus.c:73
void specials(context *, pointer)
Definition: specials.c:1284
pointer mkfilestream(context *, pointer, pointer, int, pointer)
Definition: makes.c:253
pointer QAND
Definition: eus.c:127
pointer vars
Definition: eus.h:326
pointer QPARAGC
Definition: eus.c:125
pointer unixpkg
Definition: eus.c:109
pointer SRCLOAD(context *, int, pointer *)
struct threadport thrp
Definition: eus.h:419
pointer C_THREAD
Definition: eus.c:145
pointer C_VCLASS
Definition: eus.c:146
pointer openfile(context *, char *, int, int, int)
Definition: eusstream.c:30
void sysfunc(context *, pointer)
Definition: sysfunc.c:774
pointer * vsp
Definition: eus.h:523
pointer sysmod
Definition: eus.c:184
int closestream(pointer)
Definition: eusstream.c:53
context * mainctx
Definition: eus.c:57
pointer T
Definition: eus.c:110
int thr_join(int tid, int *depature, void **status)
Definition: pthreads.c:75
struct bcell * bpointer
Definition: eus.h:443
pointer K_SHORT
Definition: eus.c:132
pointer names
Definition: eus.h:218
GLfloat n[6][3]
Definition: cube.c:15
pointer K_CHAR
Definition: eus.c:132
void initmemory_rgc()
Definition: eus.c:490
pointer C_BITVECTOR
Definition: eus.c:146
pointer makethreadport(context *)
Definition: makes.c:916
pointer K_ALLOWOTHERKEYS
Definition: eus.c:169
void eusstart(context *)
bpointer bp
Definition: eus.h:563
pointer makepkg(context *, pointer, pointer, pointer)
Definition: makes.c:201
static int argc
Definition: transargv.c:56
pointer C_CONS
Definition: eus.c:142
pointer BIGNUM
Definition: eus.c:156
pointer SYMBOL
Definition: eus.c:151
pointer defkeyword(context *, char *)
Definition: makes.c:733
pointer VECCLASS
Definition: eus.c:154
cixpair codecp
Definition: eus.c:79
void eusioctl(context *, pointer)
Definition: eusioctl.c:249
pointer QDEBUG
Definition: eus.c:123
pointer C_IOSTREAM
Definition: eus.c:143
thread_t maintid
Definition: eus.c:60
eusinteger_t hide_ptr(pointer p)
Definition: eus.c:1398
pointer oblabels
Definition: reader.c:42
cixpair conscp
Definition: eus.c:70
mutex_t p_mark_lock
pointer FCODE
Definition: eus.c:151
cixpair symbolcp
Definition: eus.c:72
void leo(context *, pointer)
Definition: leo.c:714
pointer CODE
Definition: eus.c:151
cixpair extnumcp
Definition: eus.c:94
pointer QTHREADS
Definition: eus.c:124
pointer userpkg
Definition: eus.c:109
pointer K_BYTE
Definition: eus.c:132
pointer STRING
Definition: eus.c:151
pointer C_FOREIGNCODE
Definition: eus.c:147
pointer PRINTBASE
Definition: eus.c:172
pointer FLTVECTOR
Definition: eus.c:154
cixpair filestreamcp
Definition: eus.c:75
int _end
Definition: eus.c:33
pointer LABREF
Definition: eus.c:151
context * makelispcontext(int)
Definition: makes.c:840
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1208
pointer K_METHOD_DOCUMENTATION
Definition: eus.c:175
pointer errhandler
Definition: eus.h:535
pointer READBASE
Definition: eus.c:172
void mainthread(context *ctx)
Definition: eus.c:1191
static pointer reploop(context *, char *)
Definition: eus.c:1085
pointer use
Definition: eus.h:219
pointer METACLASS
Definition: eus.c:151
pointer K_PRIN1
Definition: eus.c:174
pointer READTABLE
Definition: eus.c:154
Definition: eus.h:1002
pointer PRLEVEL
Definition: eus.c:171
pointer K_STRING
Definition: eus.c:131
void rgcfunc(register context *ctx, pointer mod)
Definition: collector.c:1235
eusinteger_t setjmp_val
Definition: eus.c:41
pointer FOREIGNCODE
Definition: eus.c:155
pointer C_STRING
Definition: eus.c:146
pointer COMCLOSURE
Definition: eus.c:170
pointer makevector(pointer, int)
Definition: makes.c:417
pointer eussigvec[NSIG]
Definition: eus.c:182
pointer C_EXTNUM
Definition: eus.c:148
pointer K_NOMETHOD
Definition: eus.c:132
struct symbol sym
Definition: eus.h:399
pointer handle
Definition: eus.h:257
pointer K_FOREIGN
Definition: eus.c:133
pointer PRCIRCLE
Definition: eus.c:171
Definition: eus.h:970
pointer K_FLUSH
Definition: eus.c:131
pointer C_SYMBOL
Definition: eus.c:142
pointer C_METACLASS
Definition: eus.c:144
int intsig
Definition: eus.h:544
pointer makemodule(context *, int)
Definition: makes.c:486
pointer QVERSION
Definition: eus.c:126
pointer cdr
Definition: eus.h:194
cixpair * cp
Definition: eus.h:572
pointer K_FUNCTION_DOCUMENTATION
Definition: eus.c:175
pointer K_FLOAT32
Definition: eus.c:133
pointer QUOTE
Definition: eus.c:110
static void initfeatures()
Definition: eus.c:831
Definition: eus_thr.h:96
pointer plist
Definition: eus.h:217
pointer MACRO
Definition: eus.c:170
Definition: eus.h:332
struct vecclass vcls
Definition: eus.h:417
cixpair bitvectorcp
Definition: eus.c:92
struct ldmodule ldmod
Definition: eus.h:408
pointer RATIO
Definition: eus.c:156
pointer C_READTABLE
Definition: eus.c:147
static pointer C_PROPOBJ
Definition: eus.c:180
pointer QDECLARE
Definition: eus.c:112
struct cons cons
Definition: eus.h:398
Definition: eus.h:958
pointer QERROUT
Definition: eus.c:119
pointer CLASS
Definition: eus.c:118
void initreader(context *)
Definition: reader.c:1034
mutex_t mark_lock
Definition: mthread.c:25
void foreign(context *ctx, pointer mod)
Definition: calleus.c:225
pointer THREAD
Definition: eus.c:153
pointer forwards
Definition: eus.h:328
union cell::cellunion c
pointer types
Definition: eus.h:327
pointer C_FCODE
Definition: eus.c:143
static void initclassid()
Definition: eus.c:518
void lispio(context *, pointer)
Definition: lispio.c:589
void unbindspecial(context *, struct specialbindframe *)
Definition: eval.c:165
cixpair vecclasscp
Definition: eus.c:78
pointer iv[2]
Definition: eus.h:319
pointer deflocal(context *, char *, pointer, pointer)
Definition: makes.c:716
pointer QLOADED_MODULES
Definition: eus.c:177
Definition: eus.h:472
pointer PKGCLASS
Definition: eus.c:151
pointer C_ARRAY
Definition: eus.c:147
pointer SELF
Definition: eus.c:116
pointer QGCHOOK
Definition: eus.c:122
short subcix
Definition: eus.h:567
pointer REST
Definition: eus.c:170
pointer OPTIONAL
Definition: eus.c:170
void sigbreak()
Definition: eus.c:1060
Definition: eus.h:426
static void initmemory()
Definition: eus.c:466
int mainargc
Definition: eus.c:1187
pointer export(pointer, pointer)
Definition: intern.c:74
pointer id
Definition: eus.h:353
pointer cix
Definition: eus.old.h:211
pointer homepkg
Definition: eus.h:201
static void initclasses()
Definition: eus.c:693
pointer STDIN
Definition: eus.c:119
cixpair fcodecp
Definition: eus.c:80
pointer VECTOR
Definition: eus.c:154
pointer ARRAY
Definition: eus.c:155
pointer MAXCALLSTACKDEPTH
Definition: eus.c:178
cixpair closurecp
Definition: eus.c:83
struct callframe * vlink
Definition: eus.h:473
pointer defvar(context *, char *, pointer, pointer)
Definition: makes.c:704
Definition: eus.h:379
long gcing
pointer PRCASE
Definition: eus.c:171
void predicates(context *, pointer)
Definition: predicates.c:214
pointer INTVECTOR
Definition: eus.c:154
pointer K_FOREIGN_STRING
Definition: eus.c:133
pointer C_LDMOD
Definition: eus.c:143
void unixcall(context *, pointer)
pointer LDMODULE
Definition: eus.c:151
pointer alloc(int, int, int, int)
Definition: memory.mutex.c:241
pointer CLOSURE
Definition: eus.c:151
struct callframe * callfp
Definition: eus.h:527
pointer C_OBJECT
Definition: eus.c:142
pointer form
Definition: eus.h:474
long buddysize[MAXBUDDY+1]
Definition: eus.c:103
pointer QEVALHOOK
Definition: eus.c:121
pointer makelabref(pointer, pointer, pointer)
Definition: makes.c:538
pointer QINTEGER
Definition: eus.c:120
pointer QSPECIAL
Definition: eus.c:112
short s
Definition: structsize.c:2
cixpair metaclasscp
Definition: eus.c:77
cixpair streamcp
Definition: eus.c:74
pointer size
Definition: eus.h:298
pointer elmtype
Definition: eus.h:341
pointer makebuffer(int)
Definition: makes.c:140
errorcode
Definition: eus.h:915
void lists(context *, pointer)
Definition: lists.c:411
pointer K_PRESERVE
Definition: eus.c:134
pointer LAMBDA
Definition: eus.c:170
static pointer PROPOBJ
Definition: eus.c:180
cixpair labrefcp
Definition: eus.c:84
void vectorarray(context *, pointer)
Definition: vectorarray.c:459
pointer K_BIT
Definition: eus.c:132
pointer lisppkg
Definition: eus.c:109
cixpair objectcp
Definition: eus.c:69
pointer C_RATIO
Definition: eus.c:148
pointer K_DISPOSE
Definition: eus.c:135
pointer cix
Definition: eus.h:336
pointer K_DOUBLE
Definition: eus.c:133
short sub
Definition: eus.h:452
pointer C_FILESTREAM
Definition: eus.c:143
char * errmsg[100]
Definition: eus.c:191
int thr_create(void *, size_t, void(*)(), void *, long, int *)
Definition: pthreads.c:43
cixpair ratiocp
Definition: eus.c:95
pointer BITVECTOR
Definition: eus.c:155
pointer C_CODE
Definition: eus.c:143
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
Definition: eus.c:297
cixpair propobjcp
Definition: eus.c:71
long eusinteger_t
Definition: eus.h:19
pointer plist
Definition: eus.h:201
pointer K_IO
Definition: eus.c:130
int export_all
Definition: intern.c:11
pointer QEXITHOOK
Definition: eus.c:122
pointer K_INVERT
Definition: eus.c:134
jmp_buf topjbuf
Definition: eus.c:185
pointer K_FILL
Definition: eus.c:131
cixpair stringcp
Definition: eus.c:91
pointer EXTNUM
Definition: eus.c:156
pointer PROBJECT
Definition: eus.c:171
pointer C_PACKAGE
Definition: eus.c:142
pointer PACKAGE
Definition: eus.c:110
int flushstream(pointer)
Definition: eusstream.c:159
Definition: eus.h:228
pointer COMPLEX
Definition: eus.c:156
pointer C_LABREF
Definition: eus.c:144
cixpair readtablecp
Definition: eus.c:87
pointer stacknlist(context *, int)
Definition: makes.c:129
pointer PRSTRUCTURE
Definition: eus.c:171
pointer ERRHANDLER
Definition: eus.c:121
void unwind(context *ctx, pointer *p)
Definition: eus.c:274
pointer defvector()
void sequence(context *, pointer)
Definition: sequence.c:1070
struct buddyfree buddy[MAXBUDDY+1]
Definition: eus.c:46
pointer xpkg
Definition: eus.c:109
int main(int argc, argv)
Definition: eus.c:1281
pointer QNOT
Definition: eus.c:127
pointer RANDSTATE
Definition: eus.c:172
pointer QFIXNUM
Definition: eus.c:120
pointer QEQUAL
Definition: eus.c:127
void arith(context *ctx, pointer mod)
Definition: arith.c:1466
pointer K_CLASS
Definition: eus.c:175
pointer K_FILE
Definition: eus.c:131
cixpair bignumcp
Definition: eus.c:97
void eusint(int s, int code, int x, eusinteger_t addr)
Definition: eus.c:976
void terpri(pointer)
Definition: printer.c:637
cixpair threadcp
Definition: eus.c:85
pointer makestring(char *, int)
Definition: makes.c:147
pointer FATALERROR
Definition: eus.c:121
void loadsave(context *, pointer)
Definition: loadelf.c:428
void init_rgc()
Definition: collector.c:484
pointer shadows
Definition: eus.h:224
pointer C_BIGNUM
Definition: eus.c:148
pointer makeclass(context *, pointer, pointer, pointer, pointer, pointer, int, pointer)
Definition: makes.c:375
Definition: eus.h:937
pointer QREADTABLE
Definition: eus.c:172
#define NULL
Definition: transargv.c:8
static void toplevel(context *ctx, int argc, argv)
Definition: eus.c:1106
Definition: eus.h:1005
int ehbypass
Definition: eus.c:160
pointer C_INTVECTOR
Definition: eus.c:146
struct object obj
Definition: eus.h:415
pointer K_FLOAT
Definition: eus.c:133
pointer QSELF
Definition: eus.c:114
pointer charmacro[256]
Definition: eus.c:163
void matrix(context *, pointer)
Definition: matrix.c:1348
pointer fd
Definition: eus.h:284
pointer QEQ
Definition: eus.c:127
pointer * gcsplimit
Definition: memory.c:411
GLfloat v[8][3]
Definition: cube.c:21
pointer C_FLTVECTOR
Definition: eus.c:146
pointer QSTDOUT
Definition: eus.c:119
pointer QCONS
Definition: eus.c:151
pointer sharpmacro[256]
Definition: eus.c:164
pointer ALLOWOTHERKEYS
Definition: eus.c:169
pointer sysobj
Definition: eus.c:54
int newchunk(int)
Definition: memory.c:67
pointer K_UPCASE
Definition: eus.c:134
static pointer brkloop()
pointer K_POINTER
Definition: eus.c:132
pointer FILESTREAM
Definition: eus.c:151
pointer * gcsp
Definition: memory.c:411
pointer K_CAPITALIZE
Definition: eus.c:134
void charstring(context *ctx, pointer mod)
Definition: charstring.c:180
pointer K_INTEGER
Definition: eus.c:132
int sema_post(sema_t *sem)
Definition: pthreads.c:148
unsigned char byte
Definition: eus.h:161
pointer QTERMIO
Definition: eus.c:172
unsigned int thr_self()
Definition: eus.c:25
Definition: eus.h:450
pointer STREAM
Definition: eus.c:151
pointer codevec
Definition: eus.h:248
pointer QOR
Definition: eus.c:127
pointer basicclass(char *name,...) pointer basicclass(va_alist) va_dcl
Definition: eus.c:405
eusinteger_t intval(pointer p)
Definition: eus.c:1356
pointer K_LONG
Definition: eus.c:132
Definition: eus.h:936
short cix
Definition: eus.h:451
pointer * gcstack
Definition: memory.c:411
struct class_desc classtab[MAXCLASS]
Definition: eus.c:138
unsigned int allocate_heap()
Definition: collector.c:1195
eusinteger_t mypid
Definition: eus.c:38
pointer pkglist
Definition: eus.c:109
cixpair complexcp
Definition: eus.c:96
int nextbclass
Definition: eus.c:101
Definition: eus.old.h:207
void mkcatchframe(context *, pointer, jmp_buf *)
Definition: makes.c:801
struct bindframe * bindfp
Definition: eus.h:529
pointer NIL
Definition: eus.c:110
pointer syspkg
Definition: eus.c:109
pointer mainport
Definition: eus.c:58
cixpair ldmodulecp
Definition: eus.c:82
pointer eval(context *, pointer)
Definition: eval.c:1361
Definition: eus.h:507
char * mainargv[32]
Definition: eus.c:1188
int count
Definition: eus.h:562
pointer v[1]
Definition: eus.h:299
pointer C_COMPLEX
Definition: eus.c:148
pointer QUNBOUND
Definition: eus.c:123
pointer ERROUT
Definition: eus.c:119
cixpair arraycp
Definition: eus.c:86
Definition: eus.h:940
pointer cls
Definition: eus.h:571
pointer QSTDIN
Definition: eus.c:119
struct built_in_cid builtinclass[64]
Definition: eus.c:100
static char * rcsid
Definition: eus.c:9
pointer keywordpkg
Definition: eus.c:109
pointer OBJECT
Definition: eus.c:154
pointer reader(context *, pointer, pointer)
Definition: reader.c:1016
pointer PRLENGTH
Definition: eus.c:171
cixpair intvectorcp
Definition: eus.c:90
pointer K_DOWNCASE
Definition: eus.c:134
pointer K_VARIABLE_DOCUMENTATION
Definition: eus.c:175
struct package pkg
Definition: eus.h:402
static void initsymbols()
Definition: eus.c:583
static void initpackage()
Definition: eus.c:549
pointer makeflt()
static void configure_eus(context *ctx)
Definition: eus.c:1136
cixpair fltvectorcp
Definition: eus.c:89


euslisp
Author(s): Toshihiro Matsui
autogenerated on Fri Feb 21 2020 03:20:54