Go to the documentation of this file.00001
00002
00003
00004
00005
00006
00007
00008
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) {
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