Go to the documentation of this file.
9 static char *
rcsid=
"@(#) $Id$";
21 #include <lwp/stackdep.h>
29 #if Linux && !OLD_LINUX && !Darwin
48 #define DEFAULT_MAX_GCSTACK 16384
203 "attempt to set to constant",
205 "undefined function",
214 "illegal lambda form",
215 "illegal lambda parameter syntax",
219 "illegal stream direction keyword",
222 "error in open file",
225 "class table overflow",
228 "array size must be positive",
229 "duplicated object variable name",
230 "cannot make instance",
231 "array index out of range",
232 "cannot find method",
234 "unknown sharp macro",
235 "list expected for an element of an alist",
239 "invalid lisp object form",
240 "no such object variable",
242 "illegal start/end index",
244 "invalid format string",
245 "float vector expected",
246 "char code out of range",
247 "vector dimension 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",
260 "array dimension mismatch",
261 "keyword expected for arguments",
263 "integer vector expected",
264 "sequence index out of range",
266 "no such external symbol",
279 cleanup=ctx->protfp->cleaner;
280 ctx->protfp=ctx->protfp->protlink;
289 while (ctx->blkfp>(
struct blockframe *)p) ctx->blkfp=ctx->blkfp->dynklink;
291 while (ctx->catchfp>(
struct catchframe *)p) ctx->catchfp=ctx->catchfp->nextcatch;
293 while (ctx->fletfp>(
struct fletframe *)p) ctx->fletfp=ctx->fletfp->dynlink;
305 register char *errstr;
326 fprintf( stderr,
"Call Stack (max depth: %d):\n",
n );
329 fprintf( stderr,
" %d: at ", i );
332 fprintf( stderr,
"\n" ); }
333 if (vf->vlink !=
NULL) {
334 fprintf (stderr,
" And more...\n"); }}
339 fprintf( stderr,
"Internal warning: error: ec will be string.(%lx)\n",
345 if ((
unsigned int)ec<=E_FATAL) {
348 fprintf(stderr,
"exiting\n"); exit(ec);}
352 switch((
unsigned int)ec) {
358 msg = va_arg(args,
pointer);
break;
365 if (errhandler!=
NIL) {
366 vpush(
makeint((
unsigned int)ec));
369 switch((
unsigned int)ec) {
374 vpush(msg);
argc=4;
break;
377 default:
argc=3;
break;}
396 fprintf(stderr,
" in ");
415 pointer classsym,
class,varvector,superv,typevector,forwardvector;
425 name=va_arg(ap,
byte *);
428 cixp=va_arg(ap,
cixpair *);
n=va_arg(ap,
int);
436 svcount=vecsize(superv);}
442 for (i=0; i<svcount; 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);
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);
470 for (i=2; i<MAXBUDDY; i++) {
475 #if (WORD_SIZE == 64)
494 for (i=2; i<MAXBUDDY; i++) {
499 #if (WORD_SIZE == 64)
508 fprintf(stderr,
"allocate_heap: %d bytes\n", tmp*4);
710 "VALUE",
"VTYPE",
"FUNCTION",
"PNAME",
"HOMEPKG");
714 8,
"NAMES",
"USE",
"SYMVECTOR",
"SYMCOUNT",
715 "INTSYMVECTOR",
"INTSYMCOUNT",
"SHADOWS",
"USED-BY");
719 4,
"DIRECTION",
"BUFFER",
"COUNT",
"TAIL");
729 7,
"NAME",
"SUPER",
"CIX",
"VARS",
"TYPES",
"FORWARDS",
"METHODS");
733 2,
"ELEMENT-TYPE",
"SIZE");
737 4,
"SYNTAX",
"MACRO",
"DISPATCH-MACRO",
"CASE");
741 11,
"ENTITY",
"RANK",
"FILL-POINTER",
"DISPLACED-INDEX-OFFSET",
742 "DIM0",
"DIM1",
"DIM2",
"DIM3",
"DIM4",
"DIM5",
"DIM6");
746 10,
"ID",
"REQUESTER",
"REQUEST-SEM",
"DONE-SEM",
747 "FUNC",
"ARGS",
"RESULT",
"CONTEXT",
758 #if (WORD_SIZE == 64)
765 "ENV0",
"ENV1",
"ENV2");
783 "SYMBOL-TABLE",
"OBJECT-FILE",
"HANDLE");
787 "LABEL",
"VALUE",
"UNSOLVED",
"NEXT");
825 for (i=0;i<MAXTHREAD;i++) {
834 extern char *makedate;
835 extern char *gitrevision;
836 extern char *compilehost;
840 p=
makestring(compilehost,strlen(compilehost));
844 p=
makestring(gitrevision,strlen(gitrevision));
956 sprintf(tmp,
"WORD-SIZE=%zd",
sizeof(
void*)*8);
974 #include <sys/wait.h>
985 fprintf(stderr,
";; eusint: sig=%d, %d; thr=%d ctx=%p\n",
994 fprintf(stderr,
";; child proc terminated; wait=0x%x\n",stat);
998 fprintf(stderr,
";; floating exception\n");
1002 fprintf(stderr,
";; pipe broken %d %x %lx\n",
code,x,(
unsigned long)addr);
1006 fprintf(stderr,
";; Segmentation Fault.\n");
1009 fprintf(stderr,
";; Bus Error.\n");
1015 fprintf(stderr,
";; in ");
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);
1022 fprintf(stderr,
";; No, you cannot continue the previous evaluation.\n");
1028 #if Solaris2 || system5
1039 if (debug) { fprintf(stderr,
";; eusint exit: intsig=%d\n",ctx->
intsig);}
1052 if ((val=(
pointer)eussetjmp(brkjmp))==0) val=
reploop(ctx,prompt);
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);
1061 {
pointer sighandler,*vspsave;
1066 if (debug) printf(
"sigbreak: intsig=%d thr_self=%d\n", is,
thr_self());
1068 if (isintvector(sighandler))
return;
1072 if (sighandler!=
NIL) {
1077 fprintf(stderr,
"signal=%d to thread %d, \n",is,
thr_self());
1096 printf(
"%s:",ccar(p->
c.
pkg.
names)->c.str.chars);}
1097 printf(
"%s",prompt);
1115 ctx->vsp=ctx->stack;
1126 for (i=0; i<
argc; i++) vpush(
makestring(argv[i],strlen(argv[i])));
1131 fprintf(stderr,
"entering reploop\n");
1140 char *eusdir, *eusrt;
1146 eusdir=(
char *)getenv(
"EUSDIR");
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);
1152 #if !Solaris2 || GCC
1157 "$EUSDIR/lib/eus.init.l was not found\nfailed to initialize.\n"
1158 "Entering raweus.\n"
1159 "To exit, type (unix::exit)\n");
1174 eusrt=(
char *)getenv(
"EUSRT");
1175 if (eusrt==
NULL) sprintf(fname,
"%s/lib/eusrt.l", eusdir);
1176 else strcpy(fname, eusrt);
1178 fprintf(stderr,
"configuring by \"%s\"\n", fname); }
1191 #pragma GCC push_options
1192 #pragma GCC optimize ("no-tree-dce")
1199 m=(
unsigned char *)malloc(4*1024*1024);
1215 for (i=0; i<MAX_SPECIALS; i++) specialtab->
c.
vec.
v[i]=
NIL;
1216 ctx->specials=specialtab; }
1260 ctx->vsp=ctx->stack;
1263 signal(SIGCHLD, (
void (*)())
eusint);
1264 signal(SIGFPE, (
void (*)())
eusint);
1265 signal(SIGPIPE, (
void (*)())
eusint);
1269 signal(SIGSEGV, (
void (*)())
eusint);
1271 signal(SIGBUS, (
void (*)())
eusint);
1276 if (exithook !=
NIL) {
1305 #if Linux && !OLD_LINUX && !Darwin
1306 mallopt(M_MMAP_MAX,0);
1311 m=(
unsigned char *)malloc(4*1024*1024);
1324 mutex_init(&
mark_lock, USYNC_THREAD, 0);
1327 { sigset_t mainsig, omainsig;
1328 sigemptyset(&mainsig);
1329 sigaddset(&mainsig, SIGINT);
1331 thr_sigsetmask(SIG_BLOCK, &mainsig, &omainsig);
1335 #if SunOS4_1 || alpha || PTHREAD
1348 if (exithook !=
NIL) {
1354 #pragma GCC pop_options
1356 #if (WORD_SIZE == 64)
1360 return(mkbigint(
v));
1368 fprintf(stderr,
"p=null\n");
1371 else if ((i&0x3L)==0x3L) {
1373 else if (isbignum(p)) {
1374 return (bigintval(p)); }
1375 else if ((i&0x7)==0x0L) {
1376 fprintf(stderr,
";p=pointer?(%p)\n", p);
1382 if (
v>(
int)MAXPOSFIXNUM ||
v<(
int)MINNEGFIXNUM) {
1386 return(mkbigint(
v));
1394 fprintf(stderr,
"p=null\n");
1396 else if ((i&0x3)==0x3) {
1398 else if (isbignum(p)) {
1399 return (bigintval(p)); }
1400 else if ((i&0x3)==0x0) {
1401 fprintf(stderr,
";p=pointer?(%p)\n", p);
pointer makemodule(context *, int)
pointer alloc(int, int, int, int)
pointer makeclass(context *, pointer, pointer, pointer, pointer, pointer, int, pointer)
eusinteger_t hide_ptr(pointer p)
pointer mkfilestream(context *, pointer, pointer, int, pointer)
struct buddyfree buddy[MAXBUDDY+1]
void matrix(context *, pointer)
pointer K_FUNCTION_DOCUMENTATION
void unwind(context *ctx, pointer *p)
pointer makeint(eusinteger_t v)
static void toplevel(context *ctx, int argc, argv)
static void configure_eus(context *ctx)
pointer deflocal(context *, char *, pointer, pointer)
void loadsave(context *, pointer)
pointer defkeyword(context *, char *)
void sequence(context *, pointer)
static pointer reploop(context *, char *)
pointer makevector(pointer, int)
void lispio(context *, pointer)
pointer makelabref(pointer, pointer, pointer)
struct built_in_cid builtinclass[64]
void foreign(context *ctx, pointer mod)
pointer list_module_initializers(context *, pointer)
struct filestream fstream
pointer makestring(char *, int)
void mkcatchframe(context *, pointer, jmp_buf *)
void unbindspecial(context *, struct specialbindframe *)
pointer rawcons(context *, pointer, pointer)
pointer defconst(context *, char *, pointer, pointer)
pointer intern(context *, char *, int, pointer)
void vectorarray(context *, pointer)
pointer defvar(context *, char *, pointer, pointer)
void lists(context *, pointer)
struct bindframe * bindfp
pointer K_METHOD_DOCUMENTATION
void arith(context *ctx, pointer mod)
void initreader(context *)
pointer reader(context *, pointer, pointer)
void leo(context *, pointer)
void rgcfunc(register context *ctx, pointer mod)
eusinteger_t intval(pointer p)
pointer K_CLASS_DOCUMENTATION
static void initfeatures()
context * euscontexts[MAXTHREAD]
struct class_desc classtab[MAXCLASS]
pointer basicclass(char *name,...) pointer basicclass(va_alist) va_dcl
pointer prinx(context *, pointer, pointer)
unsigned long euspointer_t
context * makelispcontext(int)
pointer cons(context *, pointer, pointer)
pointer eval(context *, pointer)
pointer error(enum errorcode ec,...) pointer error(va_alist) va_dcl
static void initpackage()
pointer MAXCALLSTACKDEPTH
void predicates(context *, pointer)
void eusioctl(context *, pointer)
pointer openfile(context *, char *, int, int, int)
pointer makepkg(context *, pointer, pointer, pointer)
void unixcall(context *, pointer)
unsigned int allocate_heap()
pointer stacknlist(context *, int)
int thr_create(void *, size_t, void(*)(), void *, long, int *)
long buddysize[MAXBUDDY+1]
void specials(context *, pointer)
int sema_post(sema_t *sem)
pointer K_VARIABLE_DOCUMENTATION
static void initclassid()
void sysfunc(context *, pointer)
struct callframe * callfp
static void initclasses()
static void initsymbols()
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
void charstring(context *ctx, pointer mod)
pointer makethreadport(context *)
pointer SRCLOAD(context *, int, pointer *)
void eusint(int s, int code, int x, eusinteger_t addr)
int mthread(context *ctx, pointer mod)
int thr_join(int tid, int *depature, void **status)
void mainthread(context *ctx)
euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43