1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
/****************************************************************/
/* fast code for compiled execution:
/* common error routines
/* global variable access
/* car/cdr's
/* catch/throw
/* minilist to list up rest arguments
/* Copyright(c) Toshihiro MATSUI, Electrotechnical Laboratory,1988.
/****************************************************************/
static char *rcsid="@(#)$Id$";
#include "eus.h"
int maerror()
{ error(E_MISMATCHARG);}
pointer loadglobal(s)
register pointer s;
{ register pointer v;
context *ctx;
int vt;
vt=intval(s->c.sym.vtype);
if (vt>=3) { /*thread special*/
ctx=euscontexts[thr_self()];
v=spevalof(s,vt);
if (v==UNBOUND) {
v=s->c.sym.speval;
if (v==UNBOUND) error(E_UNBOUND,s);
else return(v);}
return(v);}
v=s->c.sym.speval;
if (v==UNBOUND) error(E_UNBOUND,s);
else return(v);}
pointer storeglobal(s,v)
register pointer s,v;
{ pointer vt;
int x;
context *ctx;
vt=s->c.sym.vtype;
if (vt==V_CONSTANT) error(E_SETCONST);
else if (vt>=V_SPECIAL) {
ctx=euscontexts[thr_self()];
x=intval(vt);
pointer_update(spevalof(s,x), v);}
else pointer_update(s->c.sym.speval, v);
return(v);}
pointer xcar(p)
register pointer p;
{ if (iscons(p)) return(p->c.cons.car);
if (p==NIL) return(NIL);
else error(E_NOLIST);}
pointer xcdr(p)
register pointer p;
{ if (islist(p)) return(p->c.cons.cdr);
if (p==NIL) return(NIL);
else error(E_NOLIST);}
pointer xcadr(p)
register pointer p;
{ if (islist(p)) p=p->c.cons.cdr;
else if (p==NIL) return(NIL);
else error(E_NOLIST);
if (islist(p)) return(p->c.cons.car);
else if (p==NIL) return(NIL);
else error(E_NOLIST);}
pointer minilist(ctx,p,n)
register context *ctx;
register pointer *p;
register int n;
{ register pointer r=NIL;
while (n-->0) r=cons(ctx,*--p,r);
return(r);}
pointer restorecatch(ctx)
register context *ctx;
{ register struct catchframe *cfp=ctx->catchfp;
ctx->vsp = (pointer *)cfp;
ctx->callfp = cfp->cf;
ctx->bindfp = cfp->bf;
ctx->catchfp= cfp->nextcatch;}
|
