compsub.c
Go to the documentation of this file.
00001 /****************************************************************/
00002 /* fast code for compiled execution:
00003 /*      common error routines
00004 /*      global variable access
00005 /*      car/cdr's
00006 /*      catch/throw
00007 /*      minilist to list up rest arguments
00008 /*      Copyright(c) Toshihiro MATSUI, Electrotechnical Laboratory,1988.
00009 /****************************************************************/
00010 static char *rcsid="@(#)$Id$";
00011 
00012 #include "eus.h"
00013 
00014 maerror()
00015 { error(E_MISMATCHARG);}
00016 
00017 pointer loadglobal(s)
00018 register pointer s;
00019 { register pointer v;
00020   context *ctx;
00021   int vt;
00022   vt=intval(s->c.sym.vtype);
00023   if (vt>=3) { /*thread special*/
00024     ctx=euscontexts[thr_self()];
00025     v=spevalof(s,vt);
00026     if (v==UNBOUND) {
00027       v=s->c.sym.speval;
00028       if (v==UNBOUND)  error(E_UNBOUND,s);
00029       else return(v);}
00030     return(v);}
00031   v=s->c.sym.speval;
00032   if (v==UNBOUND) error(E_UNBOUND,s);
00033   else return(v);}
00034 
00035 pointer storeglobal(s,v)
00036 register pointer s,v;
00037 { pointer vt;
00038   int x;
00039   context *ctx;
00040   vt=s->c.sym.vtype;
00041   if (vt==V_CONSTANT) error(E_SETCONST);
00042   else if (vt>=V_SPECIAL) {
00043     ctx=euscontexts[thr_self()];
00044     x=intval(vt);
00045     pointer_update(spevalof(s,x), v);}
00046   else pointer_update(s->c.sym.speval, v);
00047   return(v);}
00048 
00049 pointer xcar(p)
00050 register pointer p;
00051 { if (iscons(p)) return(p->c.cons.car);
00052   if (p==NIL) return(NIL);
00053   else error(E_NOLIST);}
00054 
00055 pointer xcdr(p)
00056 register pointer p;
00057 { if (islist(p)) return(p->c.cons.cdr);
00058   if (p==NIL) return(NIL);
00059   else error(E_NOLIST);}
00060 
00061 pointer xcadr(p)
00062 register pointer p;
00063 { if (islist(p)) p=p->c.cons.cdr;
00064   else if (p==NIL) return(NIL);
00065   else error(E_NOLIST);
00066   if (islist(p)) return(p->c.cons.car);
00067   else if (p==NIL) return(NIL);
00068   else error(E_NOLIST);}
00069 
00070 pointer minilist(ctx,p,n)
00071 register context *ctx;
00072 register pointer *p;
00073 register int n;
00074 { register pointer r=NIL;
00075   while (n-->0) r=cons(ctx,*--p,r);
00076   return(r);}
00077 
00078 pointer restorecatch(ctx)
00079 register context *ctx;
00080 { register struct catchframe *cfp=ctx->catchfp;
00081   ctx->vsp    = (pointer *)cfp;
00082   ctx->callfp = cfp->cf;
00083   ctx->bindfp = cfp->bf;
00084   ctx->catchfp= cfp->nextcatch;}
00085 


euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Mar 9 2017 04:57:49