Charles.Forsyth20060303a828770d19 years agoHistory
1692 lines · 23.0 KB · C
RawDownload
#include <lib9.h>#include "isa.h"#include "interp.h"#include "raise.h"#include "pool.h" REG	R;			/* Virtual Machine registers */String	snil;			/* String known to be zero length */ #define Stmp	*((WORD*)(R.FP+NREG*IBY2WD))#define Dtmp	*((WORD*)(R.FP+(NREG+2)*IBY2WD)) #define OP(fn)	void fn(void)#define B(r)	*((BYTE*)(R.r))#define W(r)	*((WORD*)(R.r))#define UW(r)	*((UWORD*)(R.r))#define F(r)	*((REAL*)(R.r))#define V(r)	*((LONG*)(R.r))	#define UV(r)	*((ULONG*)(R.r))	#define	S(r)	*((String**)(R.r))#define	A(r)	*((Array**)(R.r))#define	L(r)	*((List**)(R.r))#define P(r)	*((WORD**)(R.r))#define C(r)	*((Channel**)(R.r))#define T(r)	*((void**)(R.r))#define JMP(r)	R.PC = *(Inst**)(R.r)#define SH(r)	*((SHORT*)(R.r))#define SR(r)	*((SREAL*)(R.r)) OP(runt) {}OP(negf) { F(d) = -F(s); }OP(jmp)  { JMP(d); }OP(movpc){ T(d) = &R.M->prog[W(s)]; }OP(movm) { memmove(R.d, R.s, W(m)); }OP(lea)  { W(d) = (WORD)R.s; }OP(movb) { B(d) = B(s); }OP(movw) { W(d) = W(s); }OP(movf) { F(d) = F(s); }OP(movl) { V(d) = V(s); }OP(cvtbw){ W(d) = B(s); }OP(cvtwb){ B(d) = W(s); }OP(cvtrf){ F(d) = SR(s); }OP(cvtfr){ SR(d) = F(s); }OP(cvtws){ SH(d) = W(s); }OP(cvtsw){ W(d) = SH(s); }OP(cvtwf){ F(d) = W(s); }OP(addb) { B(d) = B(m) + B(s); }OP(addw) { W(d) = W(m) + W(s); }OP(addl) { V(d) = V(m) + V(s); }OP(addf) { F(d) = F(m) + F(s); }OP(subb) { B(d) = B(m) - B(s); }OP(subw) { W(d) = W(m) - W(s); }OP(subl) { V(d) = V(m) - V(s); }OP(subf) { F(d) = F(m) - F(s); }OP(divb) { B(d) = B(m) / B(s); }OP(divw) { W(d) = W(m) / W(s); }OP(divl) { V(d) = V(m) / V(s); }OP(divf) { F(d) = F(m) / F(s); }OP(modb) { B(d) = B(m) % B(s); }OP(modw) { W(d) = W(m) % W(s); }OP(modl) { V(d) = V(m) % V(s); }OP(mulb) { B(d) = B(m) * B(s); }OP(mulw) { W(d) = W(m) * W(s); }OP(mull) { V(d) = V(m) * V(s); }OP(mulf) { F(d) = F(m) * F(s); }OP(andb) { B(d) = B(m) & B(s); }OP(andw) { W(d) = W(m) & W(s); }OP(andl) { V(d) = V(m) & V(s); }OP(xorb) { B(d) = B(m) ^ B(s); }OP(xorw) { W(d) = W(m) ^ W(s); }OP(xorl) { V(d) = V(m) ^ V(s); }OP(orb)  { B(d) = B(m) | B(s); }OP(orw)  { W(d) = W(m) | W(s); }OP(orl)  { V(d) = V(m) | V(s); }OP(shlb) { B(d) = B(m) << W(s); }OP(shlw) { W(d) = W(m) << W(s); }OP(shll) { V(d) = V(m) << W(s); }OP(shrb) { B(d) = B(m) >> W(s); }OP(shrw) { W(d) = W(m) >> W(s); }OP(shrl) { V(d) = V(m) >> W(s); }OP(lsrw) { W(d) = UW(m) >> W(s); }OP(lsrl) { V(d) = UV(m) >> W(s); }OP(beqb) { if(B(s) == B(m)) JMP(d); }OP(bneb) { if(B(s) != B(m)) JMP(d); }OP(bltb) { if(B(s) <  B(m)) JMP(d); }OP(bleb) { if(B(s) <= B(m)) JMP(d); }OP(bgtb) { if(B(s) >  B(m)) JMP(d); }OP(bgeb) { if(B(s) >= B(m)) JMP(d); }OP(beqw) { if(W(s) == W(m)) JMP(d); }OP(bnew) { if(W(s) != W(m)) JMP(d); }OP(bltw) { if(W(s) <  W(m)) JMP(d); }OP(blew) { if(W(s) <= W(m)) JMP(d); }OP(bgtw) { if(W(s) >  W(m)) JMP(d); }OP(bgew) { if(W(s) >= W(m)) JMP(d); }OP(beql) { if(V(s) == V(m)) JMP(d); }OP(bnel) { if(V(s) != V(m)) JMP(d); }OP(bltl) { if(V(s) <  V(m)) JMP(d); }OP(blel) { if(V(s) <= V(m)) JMP(d); }OP(bgtl) { if(V(s) >  V(m)) JMP(d); }OP(bgel) { if(V(s) >= V(m)) JMP(d); }OP(beqf) { if(F(s) == F(m)) JMP(d); }OP(bnef) { if(F(s) != F(m)) JMP(d); }OP(bltf) { if(F(s) <  F(m)) JMP(d); }OP(blef) { if(F(s) <= F(m)) JMP(d); }OP(bgtf) { if(F(s) >  F(m)) JMP(d); }OP(bgef) { if(F(s) >= F(m)) JMP(d); }OP(beqc) { if(stringcmp(S(s), S(m)) == 0) JMP(d); }OP(bnec) { if(stringcmp(S(s), S(m)) != 0) JMP(d); }OP(bltc) { if(stringcmp(S(s), S(m)) <  0) JMP(d); }OP(blec) { if(stringcmp(S(s), S(m)) <= 0) JMP(d); }OP(bgtc) { if(stringcmp(S(s), S(m)) >  0) JMP(d); }OP(bgec) { if(stringcmp(S(s), S(m)) >= 0) JMP(d); }OP(iexit){ error(""); }OP(cvtwl){ V(d) = W(s); }OP(cvtlw){ W(d) = V(s); }OP(cvtlf){ F(d) = V(s); }OP(cvtfl){	REAL f; 	f = F(s);	V(d) = f < 0 ? f - .5 : f + .5;}OP(cvtfw){	REAL f; 	f = F(s);	W(d) = f < 0 ? f - .5 : f + .5;}OP(cvtcl){	String *s; 	s = S(s);	if(s == H)		V(d) = 0;	else		V(d) = strtoll(string2c(s), nil, 10);}OP(iexpw){	int inv;	WORD x, n, r; 	x = W(m);	n = W(s);	inv = 0;	if(n < 0){		n = -n;		inv = 1;	}	r = 1;	for(;;){		if(n&1)			r *= x;		if((n >>= 1) == 0)			break;		x *= x;	}	if(inv)		r = 1/r;	W(d) = r;}OP(iexpl){	int inv;	WORD n;	LONG x, r; 	x = V(m);	n = W(s);	inv = 0;	if(n < 0){		n = -n;		inv = 1;	}	r = 1;	for(;;){		if(n&1)			r *= x;		if((n >>= 1) == 0)			break;		x *= x;	}	if(inv)		r = 1/r;	V(d) = r;}OP(iexpf){	int inv;	WORD n;	REAL x, r; 	x = F(m);	n = W(s);	inv = 0;	if(n < 0){		n = -n;		inv = 1;	}	r = 1;	for(;;){		if(n&1)			r *= x;		if((n >>= 1) == 0)			break;		x *= x;	}	if(inv)		r = 1/r;	F(d) = r;}OP(indx){	ulong i;	Array *a; 	a = A(s);	i = W(d);	if(a == H || i >= a->len)		error(exBounds);	W(m) = (WORD)(a->data+i*a->t->size);}OP(indw){	ulong i;	Array *a; 	a = A(s);	i = W(d);	if(a == H || i >= a->len)		error(exBounds);	W(m) = (WORD)(a->data+i*sizeof(WORD));}OP(indf){	ulong i;	Array *a; 	a = A(s);	i = W(d);	if(a == H || i >= a->len)		error(exBounds);	W(m) = (WORD)(a->data+i*sizeof(REAL));}OP(indl){	ulong i;	Array *a; 	a = A(s);	i = W(d);	if(a == H || i >= a->len)		error(exBounds);	W(m) = (WORD)(a->data+i*sizeof(LONG));}OP(indb){	ulong i;	Array *a; 	a = A(s);	i = W(d);	if(a == H || i >= a->len)		error(exBounds);	W(m) = (WORD)(a->data+i*sizeof(BYTE));}OP(movp){	Heap *h;	WORD *dv, *sv; 	sv = P(s);	if(sv != H) {		h = D2H(sv);		h->ref++;		Setmark(h);	}	dv = P(d);	P(d) = sv;	destroy(dv);}OP(movmp){	Type *t; 	t = R.M->type[W(m)]; 	incmem(R.s, t);	if (t->np)		freeptrs(R.d, t);	memmove(R.d, R.s, t->size);}OP(new){	Heap *h;	WORD **wp, *t; 	h = heap(R.M->type[W(s)]);	wp = R.d;	t = *wp;	*wp = H2D(WORD*, h);	destroy(t);}OP(newz){	Heap *h;	WORD **wp, *t; 	h = heapz(R.M->type[W(s)]);	wp = R.d;	t = *wp;	*wp = H2D(WORD*, h);	destroy(t);}OP(mnewz){	Heap *h;	WORD **wp, *t;	Modlink *ml; 	ml = *(Modlink**)R.s;	if(ml == H)		error(exModule);	h = heapz(ml->type[W(m)]);	wp = R.d;	t = *wp;	*wp = H2D(WORD*, h);	destroy(t);}OP(frame){	Type *t;	Frame *f;	uchar *nsp; 	t = R.M->type[W(s)];	nsp = R.SP + t->size;	if(nsp >= R.TS) {		R.s = t;		extend();		T(d) = R.s;		return;	}	f = (Frame*)R.SP;	R.SP  = nsp;	f->t  = t;	f->mr = nil;	if (t->np)		initmem(t, f);	T(d) = f;}OP(mframe){	Type *t;	Frame *f;	uchar *nsp;	Modlink *ml;	int o; 	ml = *(Modlink**)R.s;	if(ml == H)		error(exModule); 	o = W(m);	if(o >= 0){		if(o >= ml->nlinks)			error("invalid mframe");		t = ml->links[o].frame;	}	else		t = ml->m->ext[-o-1].frame;	nsp = R.SP + t->size;	if(nsp >= R.TS) {		R.s = t;		extend();		T(d) = R.s;		return;	}	f = (Frame*)R.SP;	R.SP = nsp;	f->t = t;	f->mr = nil;	if (t->np)		initmem(t, f);	T(d) = f;}voidacheck(int tsz, int sz){	if(sz < 0)		error(exNegsize);	/* test for overflow; assumes sz >>> tsz */	if((int)(sizeof(Array) + sizeof(Heap) + tsz*sz) < sz && tsz != 0)		error(exHeap);}OP(newa){	int sz;	Type *t;	Heap *h;	Array *a, *at, **ap; 	t = R.M->type[W(m)];	sz = W(s);	acheck(t->size, sz);	h = nheap(sizeof(Array) + (t->size*sz));	h->t = &Tarray;	Tarray.ref++;	a = H2D(Array*, h);	a->t = t;	a->len = sz;	a->root = H;	a->data = (uchar*)a + sizeof(Array);	initarray(t, a); 	ap = R.d;	at = *ap;	*ap = a;	destroy(at);}OP(newaz){	int sz;	Type *t;	Heap *h;	Array *a, *at, **ap; 	t = R.M->type[W(m)];	sz = W(s);	acheck(t->size, sz);	h = nheap(sizeof(Array) + (t->size*sz));	h->t = &Tarray;	Tarray.ref++;	a = H2D(Array*, h);	a->t = t;	a->len = sz;	a->root = H;	a->data = (uchar*)a + sizeof(Array);	memset(a->data, 0, t->size*sz);	initarray(t, a); 	ap = R.d;	at = *ap;	*ap = a;	destroy(at);}Channel*cnewc(Type *t, void (*mover)(void), int len){	Heap *h;	Channel *c; 	h = heap(&Tchannel);	c = H2D(Channel*, h);	c->send = (Progq*)malloc(sizeof(Progq));	c->recv = (Progq*)malloc(sizeof(Progq));	if(c->send == nil || c->recv == nil){		free(c->send);		free(c->recv);		error(exNomem);	}	c->send->prog = c->recv->prog = nil;	c->send->next = c->recv->next = nil;	c->mover = mover;	c->buf = H;	if(len > 0)		c->buf = H2D(Array*, heaparray(t, len));	c->front = 0;	c->size = 0;	if(mover == movtmp){		c->mid.t = t;		t->ref++;	}	return c;}Channel*newc(Type *t, void (*mover)(void)){	Channel **cp, *oldc;	WORD len; 	len = 0;	if(R.m != R.d){		len = W(m);		if(len < 0)			error(exNegsize);	}	cp = R.d;	oldc = *cp;	*cp = cnewc(t, mover, len);	destroy(oldc);	return *cp;}OP(newcl)  { newc(&Tlong, movl);  }OP(newcb)  { newc(&Tbyte, movb);  }OP(newcw)  { newc(&Tword, movw);  }OP(newcf)  { newc(&Treal, movf);  }

Lines 1–500 of 1692.