eus.old.h
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* eus.h        Etl, Umezono, Sakura-mura Lisp
00003 /*      
00004 /*      Copyright(c)1988, Toshihiro Matsui, Electrotechnical Laboratory,
00005 /*      all rights reserved, all wrongs left.
00006 /*      created on:     1986-May
00007 /*      needed to be included by all euslisp kernel (.c) files and
00008 /*      user functions compiled by euscomp.
00009 /****************************************************************/
00010 
00011 #if vxworks
00012 #include <vxWorks.h>
00013 #include <stdioLib.h>
00014 #define errno errnoGet()
00015 #define _setjmp(buf) setjmp(buf)
00016 #define _longjmp(buf,val) longjmp(buf,val)
00017 #else
00018 #include <stdio.h>
00019 #define min(x,y) ((x<y)?x:y)
00020 #define max(x,y) ((x<y)?y:x)
00021 #endif
00022 
00023 #if Solaris2
00024 #define _setjmp(buf) setjmp(buf)
00025 #define _longjmp(buf,val) longjmp(buf,val)
00026 #include <synch.h>
00027 #endif
00028 
00029 #include <setjmp.h>
00030 
00031 #define ERR (-1)
00032 #define STOPPER makepointer(0)  /*impossible pointer object*/
00033 #define UNBOUND makepointer(0)
00034 
00035 /* dynamic value type */
00036 #define V_CONSTANT      makeint(0)
00037 #define V_VARIABLE      makeint(1)
00038 #define V_SPECIAL       makeint(2)
00039 
00040 /* function types*/
00041 #define SUBR_FUNCTION   makeint(0)
00042 #define SUBR_MACRO      makeint(1)
00043 #define SUBR_SPECIAL    makeint(2)
00044 #define SUBR_ENTRY      makeint(3)
00045 
00046 /* stack frame types (lots more)*/
00047 #define BLOCKFRAME      makeint(0)
00048 #define TAGBODYFRAME    makeint(1)
00049 
00050 /*vector element types*/
00051 #define ELM_FIXED       0
00052 #define ELM_BIT         1
00053 #define ELM_CHAR        2
00054 #define ELM_BYTE        3
00055 #define ELM_INT         4
00056 #define ELM_FLOAT       5
00057 #define ELM_FOREIGN     6
00058 #define ELM_POINTER     7
00059 
00060 /****************************************************************/
00061 /* configuration constants                                      */
00062 /****************************************************************/
00063 
00064 #define DEFAULTCHUNKINDEX       16      /*fib2(12)=754*/
00065 #define MAXBUDDY        30      /*fib(30) is big enough*/
00066 #define MAXSTACK        16384   /*can be expanded by sys:newstack*/
00067 #define SYMBOLHASH      60      /*initial obvector size in package*/
00068 #define MAXCLASS        256             /* by M.Inaba from 64 */
00069 #define KEYWORDPARAMETERLIMIT 32        /*determined by bits in a long word*/
00070 #define ARRAYRANKLIMIT  7       /*minimal requirement for CommonLisp*/
00071 #define MAXTHREAD       64      /*maximum number of threads*/
00072 
00073 /* type definitions:
00074         bix is buddy index,
00075         and cix is class index, which is sometimes refered as cid */
00076 
00077 typedef unsigned char byte;
00078 typedef unsigned short word;    /*seldom used*/
00079 typedef struct cell *pointer;
00080 
00081 struct cellheader {
00082   unsigned mark:1;      /* GC mark*/
00083   unsigned b:1;         /* buddy: indicates the side in which its buddy should be found */
00084   unsigned m:1;         /* memory: records b or m of parent cell when it's split*/
00085   unsigned smark:1;     /* shared mark*/
00086   unsigned pmark:1;     /* print mark*/
00087   unsigned elmtype:3;
00088   byte     bix;         /*5 bits are enough*/
00089   short    cix;};       /*8 bits may be enough*/
00090 
00091 /****************************************************************/
00092 /* struct definition for lisp object cell
00093 /****************************************************************/
00094 struct cons {
00095     pointer car,        /*cons is made of a car and a cdr*/
00096             cdr;};      /*what a familiar structure!*/
00097 
00098 struct propertied_object {
00099     pointer plist;};
00100 
00101 struct symbol {
00102     pointer plist,      /*inherited from prop_obj*/
00103             speval,
00104             vtype,      /*const,var,special*/
00105             spefunc,
00106             pname,
00107             homepkg;};
00108 
00109 struct string {         /*resembles with vector*/
00110     pointer length;     /*boxed*/
00111     byte chars[1];};    /*long word aligned*/
00112 
00113 struct package {
00114     pointer plist;
00115     pointer names;      /*package name at car, nicknames in cdr*/
00116     pointer use;        /*spreaded use-package list*/
00117     pointer symvector;  /*hashed obvector*/
00118     pointer symcount;   /*number of interned symbols in this package*/
00119     pointer intsymvector;
00120     pointer intsymcount;
00121     pointer shadows;
00122     pointer used_by;
00123     };
00124 
00125 struct code {
00126     pointer codevec;
00127     pointer quotevec;
00128     pointer subrtype;   /*function,macro,special*/
00129     pointer entry;      /*offset from beginning of codevector*/
00130     };
00131 
00132 struct fcode {          /*foreign function code*/
00133     pointer codevec;
00134     pointer quotevec;
00135     pointer subrtype;
00136     pointer entry;
00137     pointer paramtypes;
00138     pointer resulttype;};
00139 
00140 struct ldmodule {       /*foreign language object module*/
00141     pointer codevec;
00142     pointer quotevec;
00143     pointer subrtype;   /*function,macro,special*/
00144     pointer entry;
00145     pointer symtab;
00146     pointer objname;
00147     pointer handle;};   /* dl's handle */
00148 
00149 struct closure {
00150     pointer codevec;
00151     pointer quotevec;
00152     pointer subrtype;   /*function,macro,special*/
00153     pointer entry;      /*offset from beginning of codevector*/
00154     pointer *env1;      /*argument pointer:     argv*/
00155     pointer *env2;};    /*local variable frame: local*/
00156 
00157 struct stream {
00158     pointer plist;
00159     pointer direction;
00160     pointer buffer;
00161     pointer count;
00162     pointer tail;};
00163 
00164 struct filestream {
00165     pointer plist;
00166     pointer direction;
00167     pointer buffer;
00168     pointer count;
00169     pointer tail;
00170     pointer fd;
00171     pointer fname;};
00172 
00173 struct iostream {
00174     pointer plist;
00175     pointer in,out;};
00176 
00177 struct labref {         /*used for reading labeled forms: #n#,#n=*/
00178     pointer label;
00179     pointer value;
00180     pointer unsolved;
00181     pointer next; };
00182 
00183 struct vector {
00184     pointer size;
00185     pointer v[1];};
00186 
00187 struct intvector {
00188     pointer length;
00189     long iv[1];};
00190 
00191 struct floatvector {
00192     pointer length;
00193     float fv[1];};
00194 
00195 struct arrayheader {
00196   pointer plist;
00197   pointer entity,
00198           rank,
00199           fillpointer,
00200           offset,
00201           dim[ARRAYRANKLIMIT];};
00202 
00203 /* structs for object oriented programming */
00204 struct object {
00205   pointer iv[2];};      /*instance variables*/
00206 
00207 struct class {
00208   pointer plist;
00209   pointer name;         /*class name symbol*/
00210   pointer super;        /*super class*/
00211   pointer cix;
00212   pointer vars;         /*var names including inherited ones*/
00213   pointer types;
00214   pointer forwards;
00215   pointer methods;      /*method list*/
00216   };
00217 
00218 struct vecclass {       /*vector class*/
00219   pointer plist;
00220   pointer name;
00221   pointer super;
00222   pointer cix;
00223   pointer vars;
00224   pointer types;
00225   pointer forwards;
00226   pointer methods;
00227   pointer elmtype;
00228   pointer size;};
00229 
00230 struct readtable {
00231   pointer plist;
00232   pointer syntax;
00233   pointer macro;
00234   pointer dispatch;};
00235 
00236 struct threadport {
00237   pointer plist;
00238   pointer id;
00239   pointer requester;
00240   pointer reqsem;
00241   pointer donesem;
00242   pointer func;
00243   pointer args;
00244   pointer result;
00245   pointer contex;
00246   pointer idle;
00247   pointer wait;};
00248 
00249 /****************************************************************/
00250 typedef 
00251   struct cell {
00252 #if vax || sun4 || news || mips
00253     unsigned mark:1;
00254     unsigned b:1;
00255     unsigned m:1;
00256     unsigned smark:1;
00257     unsigned pmark:1;
00258     unsigned elmtype:3;
00259     byte     bix;
00260 #endif
00261     short cix;
00262     union cellunion {
00263       struct cons cons;
00264       struct symbol sym;
00265       struct string str;
00266       struct package pkg;
00267       struct stream stream;
00268       struct filestream fstream;
00269       struct iostream iostream;
00270       struct code code;
00271       struct fcode fcode;
00272       struct ldmodule ldmod;
00273       struct closure clo;
00274       struct labref lab;
00275       struct arrayheader ary;
00276       struct vector vec;
00277       struct floatvector fvec;
00278       struct intvector ivec;
00279       struct object obj;
00280       struct class cls;
00281       struct vecclass vcls;
00282       struct readtable rdtab;
00283       struct threadport thrp;
00284       } c;
00285     } cell;
00286 
00287 typedef 
00288   union numunion {
00289     float fval;
00290     int   ival;
00291     struct {short low,high;} sval;
00292     } numunion;
00293 
00294 /* buddy cell */
00295 struct bcell {
00296     struct cellheader h;
00297     union {
00298       struct bcell *nextbcell;
00299       struct cell  *c[2];} b;} bcell;
00300 
00301 typedef struct bcell *bpointer;
00302 
00303 struct chunk {
00304   struct chunk *nextchunk;
00305   int chunkbix;
00306   struct bcell rootcell;};
00307 
00308 typedef struct {
00309         short cix;
00310         short sub;} cixpair;
00311 
00312 enum ch_type {
00313         ch_illegal,
00314         ch_white,
00315         ch_comment,
00316         ch_macro,
00317         ch_constituent,
00318         ch_sglescape,
00319         ch_multiescape,
00320         ch_termmacro,
00321         ch_nontermacro};
00322 
00323 enum ch_attr {
00324         alphabetic,package_marker,illegal,alphadigit};
00325 
00326 
00327 /****************************************************************/
00328 /* stack frames and context
00329 /****************************************************************/
00330 struct callframe {
00331   struct  callframe *vlink;
00332   pointer form;
00333   };
00334 
00335 struct bindframe {      /*to achieve lexical binding in the interpreter*/
00336   struct  bindframe *dynblink, *lexblink;       /*links to upper level*/
00337   pointer sym;          /*symbol*/
00338   pointer val;};        /*bound value*/
00339 
00340 struct specialbindframe {       /*special value binding frame*/
00341   struct  specialbindframe *sblink;
00342   pointer sym;          /*pointer to the symbol word(dynval or dynfunc)*/
00343   pointer oldval;};
00344 
00345 struct blockframe {
00346   pointer kind;
00347   struct  blockframe *dynklink,*lexklink;
00348   pointer name;
00349   jmp_buf *jbp;};
00350 
00351 struct catchframe {
00352   struct  catchframe *nextcatch;
00353   pointer label;
00354   struct  bindframe *bf;        /*bind frame save*/
00355   struct  callframe *cf;        /*call frame save*/
00356   struct  fletframe *ff;
00357   jmp_buf *jbp;
00358   };
00359 
00360 struct protectframe {
00361   struct protectframe *protlink;
00362   pointer cleaner;      /*cleanup form closure*/
00363   };
00364 
00365 struct  fletframe {
00366   pointer name;
00367   pointer fclosure;
00368   struct  fletframe *scope;
00369   struct  fletframe *lexlink;
00370   struct  fletframe *dynlink;};
00371 
00372 #define MAXMETHCACHE 256 /*must be power to 2*/
00373 
00374 struct methdef {
00375   pointer selector,class,ownerclass,method;
00376   } methcache[MAXMETHCACHE];
00377 
00378 typedef struct {
00379         pointer *stack, *vsp,*stacklimit;
00380         struct  callframe       *callfp;
00381         struct  catchframe      *catchfp;
00382         struct  bindframe       *bindfp;
00383         struct  specialbindframe *sbindfp;
00384         struct  blockframe      *blkfp;
00385         struct  protectframe    *protfp;
00386         struct  fletframe       *fletfp, *newfletfp;
00387         pointer lastalloc;
00388         pointer errhandler;
00389         struct  methdef         *methcache;
00390         }
00391         context;
00392 
00393 /****************************************************************
00394 /* memory and class management structures
00395 /****************************************************************/
00396 struct buddybase {
00397   int size;
00398   bpointer bp;}  buddy[MAXBUDDY+1];
00399 
00400 struct class_desc {     /* per- class descripter */
00401   short cix;
00402   short subcix;
00403   pointer def; };
00404 
00405 struct built_in_cid {
00406   pointer cls;
00407   cixpair *cp; };
00408 
00409 
00410 /****************************************************************/
00411 /* global variables for eus
00412 /*      date:   1986-Apr
00413 /*      1987-Apr
00414 /****************************************************************/
00415 /* process id and program name*/
00416 extern int mypid;
00417 extern char *progname;
00418 
00419 /* heap management */
00420 /* every free cell is linked to the buddybase structure*/
00421 extern struct buddybase buddy[MAXBUDDY+1];
00422 extern struct chunk *chunklist;
00423 extern char *maxmemory;
00424 extern long freeheap, totalheap;        /*size of heap left and allocated*/
00425 
00426 /* memory management timers for performance evaluation */
00427 extern long gccount,marktime,sweeptime;
00428 extern long alloccount[MAXBUDDY];
00429 
00430 /* System internal objects are connected to sysobj list
00431 /* to protect from garbage-collection */
00432 extern pointer sysobj;
00433 extern pointer lastalloc;
00434 
00435 /* thread euscontexts */
00436 context *euscontexts[MAXTHREAD];
00437 
00438 /****************************************************************/
00439 /* system defined (built-in) class index
00440 /*      modified to accept  dynamic type extension (1987-Jan)
00441 /****************************************************************/
00442 
00443 extern cixpair objectcp;
00444 extern cixpair conscp;
00445 extern cixpair propobjcp;
00446 extern cixpair symbolcp;
00447 extern cixpair packagecp;
00448 extern cixpair streamcp;
00449 extern cixpair filestreamcp;
00450 extern cixpair iostreamcp;
00451 extern cixpair metaclasscp;
00452 extern cixpair vecclasscp;
00453 extern cixpair codecp;
00454 extern cixpair fcodecp;
00455 /*cixpair modulecp; */
00456 extern cixpair ldmodulecp;
00457 extern cixpair closurecp;
00458 extern cixpair labrefcp;
00459 extern cixpair threadcp;
00460 extern cixpair arraycp;
00461 extern cixpair readtablecp;
00462 extern cixpair vectorcp;
00463 extern cixpair fltvectorcp;
00464 extern cixpair intvectorcp;
00465 extern cixpair stringcp;
00466 extern cixpair bitvectorcp;
00467 
00468 extern struct built_in_cid  builtinclass[64];
00469 extern int nextbclass;
00470 
00471 
00472 /*symbol management*/
00473 extern pointer pkglist,lisppkg,keywordpkg,userpkg,syspkg,unixpkg,xpkg;
00474 extern pointer NIL,PACKAGE,T,QUOTE;
00475 extern pointer FUNCTION;
00476 extern pointer QDECLARE,QSPECIAL;
00477 extern pointer SELF,CLASS;
00478 extern pointer STDIN,STDOUT,ERROUT,QSTDIN,QSTDOUT,QERROUT;
00479 extern pointer QINTEGER,QFIXNUM,QFLOAT,QNUMBER;
00480 extern pointer TOPLEVEL,QEVALHOOK,ERRHANDLER;
00481 extern pointer QUNBOUND,QDEBUG;
00482 extern pointer QTHREADS;
00483 
00484 /*memory management parameters*/
00485 extern pointer GCMERGE,GCMARGIN;
00486 
00487 /* keywords */
00488 extern pointer K_IN,K_OUT,K_IO; /*direction keyword*/
00489 extern pointer K_FLUSH,K_FILL,K_FILE,K_STRING;
00490 extern pointer K_NOMETHOD,K_BIT,K_BYTE,K_CHAR,K_SHORT,K_LONG,K_INTEGER;
00491 extern pointer K_FLOAT,K_DOUBLE,K_FOREIGN;
00492 extern pointer K_DOWNCASE,K_UPCASE;
00493 
00494 /*class management*/
00495 extern struct class_desc classtab[MAXCLASS];
00496 extern int nextcix;
00497 
00498 /*class cells*/
00499 extern pointer C_CONS, C_OBJECT, C_SYMBOL, C_PACKAGE;
00500 extern pointer C_STREAM, C_FILESTREAM, C_IOSTREAM, C_CODE, C_FCODE;
00501 extern pointer C_LDMOD;
00502 extern pointer C_VECTOR, C_METACLASS, C_CLOSURE, C_LABREF;
00503 extern pointer C_THREAD;
00504 extern pointer C_VCLASS, C_FLTVECTOR, C_INTVECTOR, C_STRING, C_BITVECTOR;
00505 extern pointer C_FOREIGNCODE,C_ARRAY,C_READTABLE;
00506 
00507 /*class names*/
00508 extern pointer QCONS,STRING,STREAM,FILESTREAM,IOSTREAM,SYMBOL,  
00509         CODE, FCODE,LDMODULE, PKGCLASS,METACLASS,CLOSURE,LABREF;
00510 extern pointer THREAD;
00511 extern pointer VECTOR,VECCLASS,FLTVECTOR,INTVECTOR,OBJECT,READTABLE;
00512 extern pointer FOREIGNCODE,ARRAY,BITVECTOR;
00513 
00514 /*toplevel & evaluation control*/
00515 extern int intsig,intcode;
00516 extern int ehbypass;
00517 
00518 /*reader variables*/
00519 extern pointer charmacro[256];
00520 extern pointer sharpmacro[256];
00521 extern int export_all;
00522 
00523 /****************************************************************/
00524 /* macro definition for euslisp
00525 /****************************************************************/
00526 
00527 #define carof(p,err) (islist(p)?(p)->c.cons.car:error(err))
00528 #define cdrof(p,err) (islist(p)?(p)->c.cons.cdr:error(err))
00529 #define ccar(p) ((p)->c.cons.car)
00530 #define ccdr(p) ((p)->c.cons.cdr)
00531 #define cixof(p) ((p)->cix)
00532 #define classof(p) (classtab[(p)->cix].def)
00533 #define subcixof(p) (classtab[(p)->cix].subcix)
00534 #define spevalof(p) ((p)->c.sym.speval)
00535 #define superof(p) ((p)->c.cls.super)
00536 
00537 #if sun3 || apollo || system5 || sanyo || vxworks || NEXT
00538 #define makepointer(bp) ((pointer)((int)(bp) | 2))
00539 #define isint(p) (!((int)(p) & 3))
00540 #define isflt(p) (((int)(p) & 3)==1)
00541 #define isnum(p) (((int)(p) & 2)==0)
00542 #define ispointer(p) ((int)(p) & 2)
00543 #define makeint(v) ((pointer)(((int)v)<<2))
00544 #define bpointerof(p) ((bpointer)((int)(p)-2))
00545 #endif
00546 
00547 #if vax || sun4 || news || mips
00548 #define makepointer(bp) ((pointer)(bp))
00549 #define isint(p) (((int)(p) & 3)==2)
00550 #define isflt(p) (((int)(p) & 3)==1)
00551 #define isnum(p) (((int)(p) & 3))
00552 #define ispointer(p) (!((int)(p) & 3))
00553 #define makeint(v) ((pointer)((((int)v)<<2)+2))
00554 #define bpointerof(p) ((bpointer)(p))
00555 #endif
00556 
00557 #define intval(p) (((int)(p))>>2)
00558 #define ckintval(p) (isint(p)?intval(p):(int)error(E_NOINT))
00559 #define elmtypeof(p) (bpointerof(p)->h.elmtype)
00560 #define bixof(p) (bpointerof(p)->h.bix)
00561 
00562 #if sun3 || sun4 || system5 || apollo || news || sanyo || vxworks || mips || NEXT
00563 #define fltval(p) (nu.ival=(int)p & 0xfffffffc, nu.fval)
00564 #define makeflt(f) (nu.fval=(f), (pointer)((nu.ival & 0xfffffffc) | 1))
00565 #define ckfltval(p) (isflt(p)?fltval(p):(isint(p)?intval(p):(int)error(E_NONUMBER)))
00566 #endif
00567 
00568 /*predicates to test object type*/
00569 #define pislist(p)  (p->cix<=conscp.sub)
00570 #define piscons(p)  (p->cix<=conscp.sub)
00571 #define pispropobj(p) (propobjcp.cix<=(p)->cix && (p)->cix<=propobjcp.sub)
00572 #define ispropobj(p) (ispointer(p) && pispropobj(p))
00573 #define pissymbol(p) (symbolcp.cix<=(p)->cix && (p)->cix<=symbolcp.sub)
00574 #define issymbol(p) (ispointer(p) && pissymbol(p))
00575 #define pisstring(p)  (stringcp.cix<=(p)->cix && (p)->cix<=stringcp.sub)
00576 #define isstring(p) (ispointer(p) && pisstring(p))
00577 #define islist(p) (ispointer(p) && pislist(p))
00578 #define iscons(p) (ispointer(p) && piscons(p))
00579 #define piscode(p) (codecp.cix<=(p)->cix && (p)->cix<=codecp.sub)
00580 #define iscode(p) (ispointer(p) && piscode(p))
00581 #define pisfcode(p) (fcodecp.cix<=(p)->cix && (p)->cix<=fcodecp.sub)
00582 #define isfcode(p) (ispointer(p) && pisfcode(p))
00583 #define pisldmod(p) (ldmodulecp.cix<=(p)->cix && (p)->cix<=ldmodulecp.sub)
00584 #define isldmod(p) (ispointer(p) && pisldmod(p))
00585 #define pisstream(p) (streamcp.cix<=(p)->cix && (p)->cix<=streamcp.sub)
00586 #define isstream(p) (ispointer(p) && pisstream(p))
00587 #define pisfilestream(p) (filestreamcp.cix<=(p)->cix && (p)->cix<=filestreamcp.sub)
00588 #define isfilestream(p) (ispointer(p) && pisfilestream(p))
00589 #define pisiostream(p) (iostreamcp.cix<=(p)->cix && (p)->cix<=iostreamcp.sub)
00590 #define isiostream(p) (ispointer(p) && pisiostream(p))
00591 #define pisreadtable(p) (readtablecp.cix<=((p)->cix) && ((p)->cix)<=readtablecp.sub)
00592 #define isreadtable(p) (ispointer(p) && pisreadtable(p))
00593 #define pisarray(p) (arraycp.cix<=((p)->cix) && ((p)->cix)<=arraycp.sub)
00594 #define isarray(p) (ispointer(p) && pisarray(p))
00595 #define pisvector(p) (elmtypeof(p))
00596 #define isvector(p) (ispointer(p) && pisvector(p))
00597 #define isfltvector(p) (ispointer(p) && (elmtypeof(p)==ELM_FLOAT))
00598 #define isptrvector(p) (ispointer(p) && (elmtypeof(p)==ELM_POINTER))
00599 #define isintvector(p) (ispointer(p) && (elmtypeof(p)==ELM_INT))
00600 #define pisclass(p) (metaclasscp.cix<=(p)->cix && (p)->cix<=metaclasscp.sub)
00601 #define isclass(p) (ispointer(p) && pisclass(p))
00602 #define pisvecclass(p) (vecclasscp.cix<=(p)->cix && (p)->cix<=vecclasscp.sub)
00603 #define isvecclass(p) (ispointer(p) && pisvecclass(p))
00604 #define pispackage(p) (packagecp.cix<=(p)->cix && (p)->cix<=packagecp.sub)
00605 #define ispackage(p) (ispointer(p) && pispackage(p))
00606 #define pisclosure(p) (closurecp.cix<=(p)->cix && (p)->cix<=closurecp.sub)
00607 #define isclosure(p) (ispointer(p) && pisclosure(p))
00608 #define pislabref(p) (labrefcp.cix<=(p)->cix && (p)->cix<=labrefcp.sub)
00609 #define islabref(p) (ispointer(p) && pislabref(p))
00610 
00611 #define strlength(p) (intval((p)->c.str.length))
00612 #define vecsize(p) (intval((p)->c.vec.size))
00613 #define objsize(p) (vecsize(classof(p)->c.cls.vars))
00614 
00615 #define vpush(v) (*ctx->vsp++=((pointer)v))
00616 #define ckpush(v) (ctx->vsp<ctx->stacklimit?vpush(v):error(E_STACKOVER))
00617 #define vpop() (*(--(ctx->vsp)))
00618 
00619 #define ckarg(req) if (n!=(req)) error(E_MISMATCHARG)
00620 #define ckarg2(req1,req2) if ((n<(req1))||((req2)<n)) error(E_MISMATCHARG)
00621 
00622 #define breakck if (intsig) sigbreak()
00623 #define stackck if (ctx->vsp>ctx->stacklimit) error(E_STACKOVER)
00624 #define debug (spevalof(QDEBUG)!=NIL)
00625 
00626 /****************************************************************/
00627 /* error code definition
00628 /*      1986-Jun-17
00629 /****************************************************************/
00630 
00631 enum errorcode {
00632   E_NORMAL,             /*0*/
00633   E_STACKOVER,          /*stack overflow*/
00634   E_ALLOCATION,
00635   E_DUMMY3,
00636   E_DUMMY4,
00637   E_DUMMY5,
00638   E_DUMMY6,
00639   E_DUMMY7,
00640   E_DUMMY8,
00641   E_DUMMY9,
00642   E_DUMMY10,
00643   E_SETCONST,           /*11 attempt to set to constant*/
00644   E_UNBOUND,
00645   E_UNDEF,
00646   E_MISMATCHARG,
00647   E_ILLFUNC,
00648   E_ILLCH,
00649   E_READ,
00650   E_WRITE,
00651   E_LONGSTRING,         /*19: string too long*/
00652   E_NOSYMBOL,           /*20: symbol expected*/
00653   E_NOLIST,             /*list expected*/
00654   E_LAMBDA,             /*illegal lambda form*/
00655   E_PARAMETER,          /*illegal lambda parameter syntax*/  
00656   E_NOCATCHER,          /*no catch block */
00657   E_NOBLOCK,            /*no block to return*/
00658   E_STREAM,             /*stream expected*/
00659   E_IODIRECTION,        /*io stream direction keyword*/
00660   E_NOINT,              /*integer value expected*/
00661   E_NOSTRING,           /*string expected*/
00662   E_OPENFILE,           /*30: error in open*/
00663   E_EOF,                /*EOF encountered*/
00664   E_NONUMBER,           /*number expected*/
00665   E_CLASSOVER,          /*class table overflow*/
00666   E_NOCLASS,            /*class expected*/
00667   E_NOVECTOR,           /*vector expected*/
00668   E_VECSIZE,            /*error of vector size*/
00669   E_DUPOBJVAR,          /*duplicated object variable name*/
00670   E_INSTANTIATE,        /*38: cannot make an instance*/
00671   E_ARRAYINDEX,
00672   E_NOMETHOD,           /*40*/
00673   E_CIRCULAR,
00674   E_SHARPMACRO,         /*unknown sharp macro*/
00675   E_ALIST,              /*list expected for an element of an alist*/
00676   E_NOMACRO,            /*macro expected*/
00677   E_NOPACKAGE,          /*no such package */
00678   E_PKGNAME,            /*the package already exists*/
00679   E_NOOBJ,              /*invalid form*/
00680   E_NOOBJVAR,           /*48: not an object variable*/
00681   E_NOSEQ,              /*sequence(list,string,vector) expected*/
00682   E_STARTEND,           /*illegal subsequence index*/
00683   E_NOSUPER,            /*no superclass*/
00684   E_FORMATSTRING,       /*invalid format string character*/
00685   E_FLOATVECTOR,        /*float vector expected*/
00686   E_CHARRANGE,          /*0..255*/
00687   E_VECINDEX,           /*vector index mismatch*/
00688   E_NOOBJECT,           /*other than numbers expected*/
00689   E_TYPEMISMATCH,       /*the: type mismatch*/
00690   E_DECLARE,            /*illegal declaration*/
00691   E_DECLFORM,           /*invalid declaration form*/
00692   E_NOVARIABLE,         /*constant is used in let or lambda*/
00693   E_ROTAXIS,            /*illegal rotation axis spec*/
00694   E_MULTIDECL,
00695   E_READLABEL,          /*illegal #n= or #n# label*/
00696   E_READFVECTOR,        /*error of #f( expression*/
00697   E_READOBJECT,         /*error in #V or #J format*/
00698   E_SOCKET,             /*error of socket address*/
00699   E_NOARRAY,            /*array expected*/
00700   E_ARRAYDIMENSION,     /*array dimension mismatch*/
00701   E_KEYPARAM,           /*keyword parameter*/
00702   E_NOKEYPARAM,         /*no such keyword*/
00703   E_NOINTVECTOR,        /*integer vector expected*/
00704   E_SEQINDEX,           /*sequence index out of range*/
00705   E_BITVECTOR,          /*not a bit vector*/
00706   E_EXTSYMBOL,          /*no such external symbol*/
00707   E_SYMBOLCONFLICT,     /*symbol conflict in a package*/
00708   };
00709 
00710 /* function prototypes */
00711 
00712 /*system*/
00713 extern pointer error(),alloc(),halloc();
00714 
00715 /*eval*/
00716 extern pointer eval(context *, pointer);
00717 extern pointer eval2(context *, pointer, pointer);
00718 extern pointer ufuncall(context *, pointer, pointer, pointer,
00719                          struct bindframe *, int);
00720 extern pointer progn(context *, pointer);
00721 extern pointer csend();
00722 extern pointer getval(context *, pointer);
00723 extern pointer setval(context *, pointer, pointer);
00724 extern pointer getfunc(context *, pointer);
00725 extern struct  bindframe *declare(context *, pointer, struct bindframe *);
00726 extern struct  bindframe *vbind(context *, pointer, pointer,
00727                                  struct bindframe *, struct bindframe*);
00728 extern struct  bindframe *fastbind(context *, pointer, pointer,
00729                                 struct bindframe *);
00730 extern void bindspecial(context *, pointer, pointer);
00731 extern void unbindspecial(context *, struct specialbindframe *);
00732 extern struct bindframe *bindkeyparams(context *, pointer, pointer *,
00733                         int, struct bindframe *, struct bindframe *);
00734 
00735 extern pointer Getstring();
00736 extern pointer findpkg();
00737 extern pointer memq();
00738 
00739 /*allocater*/
00740 extern pointer makebuffer(int);
00741 extern pointer makevector(pointer, int);
00742 extern pointer makeclass(context *, pointer, pointer, pointer,pointer, pointer,
00743                         int, pointer);
00744 extern pointer makecode(pointer, pointer(*)(), pointer);
00745 extern pointer makematrix(context *, int, int);
00746 extern pointer makeobject(pointer);
00747 extern pointer rawcons(context *, pointer, pointer);
00748 extern pointer cons(context *, pointer, pointer);
00749 extern pointer makestring(char *, int);
00750 extern pointer makesymbol(context *, char *, int, pointer);
00751 extern pointer intern(context *, char *, int, pointer);
00752 extern pointer makepkg(context *, pointer, pointer, pointer);
00753 extern pointer mkstream(context *, pointer, pointer);
00754 extern pointer mkfilestream(context *, pointer,pointer,int,pointer);
00755 extern pointer mkiostream(context *, pointer,pointer);
00756 extern pointer makemodule(context *, int);
00757 extern pointer defun(context *, char *, pointer, pointer(*)());
00758 extern pointer defmacro(context *, char *, pointer, pointer(*)());
00759 extern pointer defspecial(context *, char *, pointer, pointer(*)());
00760 extern pointer defunpkg(context *, char *, pointer, pointer(*)(),pointer);
00761 extern void addcmethod(context *, pointer, pointer (*)(),
00762                                  pointer, pointer, pointer);
00763 extern pointer defkeyword(context *, char *);
00764 extern pointer defvar(context *, char *, pointer, pointer);
00765 extern pointer defconst(context *, char *, pointer, pointer);
00766 extern pointer stacknlist(context *, int);
00767 #if Solaris2
00768 extern makethreadport(context *);
00769 #endif
00770 
00771 /*boxing,unboxing*/
00772 #if vax
00773 extern float fltval(),ckfltval();
00774 extern pointer makeflt();
00775 #endif
00776 
00777 /*io*/
00778 extern pointer reader(context *, pointer, pointer);
00779 extern pointer prinx(context *, pointer, pointer);
00780 
00781 /*for compiled code*/
00782 extern pointer makeclosure(pointer,pointer,int,pointer*, pointer*);
00783 extern pointer fcall();
00784 extern pointer minilist();
00785 extern pointer xcar(pointer), xcdr(pointer), xcadr(pointer);
00786 extern pointer *ovafptr(pointer,pointer);
00787 
00788 /* mutex locks*/
00789 
00790 extern mutex_t mark_lock;
00791 extern char *mark_locking;
00792 extern int mark_lock_thread;
00793 extern mutex_t p_mark_lock;
00794 
00795 


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 6 2019 18:05:53