void
load(void){
register int c;
register struct blk *p,*q;
struct blk *t,*s;
c = readc() & 0377;
sptr = stable[c];
if(sptr != 0){
p = sptr->val;
if(c >= ARRAYST){
q = salloc(length(p));
rewind(p);
while(sfeof(p) == 0){
s = dcgetwd(p);
if(s == 0){putwd(q, (struct blk *)NULL);}
else{
t = copy(s,length(s));
putwd(q,t);
}
}
pushp(q);
}
else{
q = copy(p,length(p));
pushp(q);
}
}
else{
q = salloc(1);
sputc(q,0);
pushp(q);
}
return;
}
main()
{ /* Main Program */
char infx[50], pofx[50], ch, elem;
int i = 0, k = 0;
printf("\n\nRead the Infix Expression ? ");
scanf("%s", infx);
push('#');
while ((ch = infx[i++]) != '\0')
{
if (ch == '(')
push(ch);
else if (isalnum(ch))
pofx[k++] = ch;
else if (ch == ')')
{
while (s[top] != '(')
pofx[k++] = pop();
elem = pop(); /* Remove ( */
}
else
{ /* Operator */
while (pr(s[top]) >= pr(ch))
pofx[k++] = pop();
push(ch);
}
}
while (s[top] != '#') /* Pop from stack till empty */
pofx[k++] = pop();
pofx[k] = '\0'; /* Make pofx as valid string */
printf("\n The Infix : %s \t Postfix : %s\n",infx,pofx);
char ca;
int op1,op2;i=0;
while( (ca=pofx[i++]) != '\0')
{
if(isdigit(ca))
pushp(ca-'0'); /* Push the operand */
else
{ /* Operator,pop two operands */
op2=popp();
op1=popp();
switch(ca)
{
case '+':pushp(op1+op2);break;
case '-':pushp(op1-op2);break;
case '*':pushp(op1*op2);break;
case '/':pushp(op1/op2);break;
}
}
}
printf("\n Result after Evaluation: %d\n",a[top]);
} //End of Program
int
dscale(void){
register struct blk *dd,*dr;
register struct blk *r;
int c;
dr = pop();
EMPTYS;
dd = pop();
EMPTYSR(dr);
fsfile(dd);
skd = sunputc(dd);
fsfile(dr);
skr = sunputc(dr);
if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)){
sputc(dr,skr);
pushp(dr);
errorrt("divide by 0\n");
}
c = k-skd+skr;
if(c < 0)r = removr(dd,-c);
else {
r = add0(dd,c);
irem = 0;
}
arg1 = r;
arg2 = dr;
savk = k;
return(0);
}
void coinpos(stack *s)
{ //infix to postfix
printf("\n Enter the infix expression : ");
scanf(" %s",aa);
int len=strlen(aa);
printf("\n Length of above expression is : %d \n",len);
printf("\n The postfix expression is :\t");
for(i=0; i<len ; i++)
{
if(check(aa[i])==0) //operand
printf("%c",aa[i]);
else
if(aa[i]=='(')
pushp(s,'(');
else
{
if(aa[i]==')')
while((xx=popp(s))!='(')
printf("%c",xx);
else
{
while(prec(aa[i])<=prec(top_p(s)) && !empty(s))
{
xx=popp(s);
}
pushp(s,aa[i]);
printf("%c",xx);
}
}
}
while(!empty(s))
{
xx=popp(s);
printf("%c",xx);
}
printf("\n\n");
options_p(s);
}
void
load(void)
{
int c;
Blk *p, *q, *t, *s;
c = getstk() & 0377;
sptr = stable[c];
if(sptr != 0) {
p = sptr->val;
if(c >= ARRAYST) {
q = salloc(length(p));
rewind(p);
while(sfeof(p) == 0) {
s = dcgetwd(p);
if(s == 0) {
putwd(q, (Blk*)0);
} else {
t = copy(s,length(s));
putwd(q,t);
}
}
pushp(q);
} else {
q = copy(p,length(p));
pushp(q);
}
} else {
q = salloc(1);
if(c <= LASTFUN) {
Bprint(&bout,"function %c undefined\n",c+'a'-1);
sputc(q,'c');
sputc(q,'0');
sputc(q,' ');
sputc(q,'1');
sputc(q,'Q');
}
else
sputc(q,0);
pushp(q);
}
}
int
subt(void){
arg1=pop();
EMPTYS;
savk = sunputc(arg1);
chsign(arg1);
sputc(arg1,savk);
pushp(arg1);
if(eqk() != 0)return(1);
binop('+');
return(0);
}
int
dscale(void)
{
Blk *dd, *dr, *r;
int c;
dr = pop();
EMPTYS;
dd = pop();
EMPTYSR(dr);
fsfile(dd);
skd = sunputc(dd);
fsfile(dr);
skr = sunputc(dr);
if(sfbeg(dr) == 1 || (sfbeg(dr) == 0 && sbackc(dr) == 0)) {
sputc(dr,skr);
pushp(dr);
Bprint(&bout,"divide by 0\n");
return(1);
}
if(sfbeg(dd) == 1 || (sfbeg(dd) == 0 && sbackc(dd) == 0)) {
sputc(dd,skd);
pushp(dd);
return(1);
}
c = k-skd+skr;
if(c < 0)
r = removr(dd,-c);
else {
r = add0(dd,c);
irem = 0;
}
arg1 = r;
arg2 = dr;
savk = k;
return(0);
}
void
binop(char c)
{
Blk *r;
r = 0;
switch(c) {
case '+':
r = add(arg1,arg2);
break;
case '*':
r = mult(arg1,arg2);
break;
case '/':
r = div(arg1,arg2);
break;
}
release(arg1);
release(arg2);
sputc(r,savk);
pushp(r);
}
void
binop(char c)
{
register struct blk *r = NULL;
switch(c){
case '+':
r = add(arg1,arg2);
break;
case '*':
r = mult(arg1,arg2);
break;
case '/':
r = dcdiv(arg1,arg2);
break;
}
release(arg1);
release(arg2);
sputc(r,savk);
pushp(r);
return;
}
void ExecFrame::execute_ops(int num)
{
int opcode, param;
floatval fa,fb;
int ia, ib, ifor, iparam, ijmp;
//char opfor,pfor;
Vec2 *v1,*v2;
Vec2 v;
VMInterface* obj;
ExecFrame* frame;
CodeObj* cobj;
while(num-- != 0)
{
opcode = (int)code->code[iptr++];
param = (int)code->code[iptr++];
//std::cout << opcode << ':' << param << std::endl;
switch(opcode) {
case OPC_EXIT:
iptr-=2;
return;
case OPC_VMCALL:
cobj = (CodeObj*)popp();
ia = popi();
frame = new ExecFrame(cobj);
frame->restart();
if (param > 0) move(param, frame);
frame->execute();
if (ia > 0) frame->move(ia, this);
delete frame;
break;
case OPC_CONSTF:
pushf(code->conarray_f[param]);
break;
case OPC_CONSTI:
pushi(code->conarray_i[param]);
break;
case OPC_CONSTV:
pushv(code->conarray_v[param]);
break;
case OPC_CONSTP:
pushp(code->conarray_p[param]);
break;
case OPC_PUSHVARF:
pushf(vararray_f[param]);
break;
case OPC_PUSHVARI:
pushi(vararray_i[param]);
break;
case OPC_PUSHVARV:
pushv(vararray_v[param]);
break;
case OPC_PUSHVARP:
pushp(vararray_p[param]);
break;
case OPC_POP:
top -= param;
break;
case OPC_SETVARF:
vararray_f[param] = popf();
break;
case OPC_SETVARI:
vararray_i[param] = popi();
break;
case OPC_SETVARV:
fb = popf();
fa = popf();
vararray_v[param].set(fa,fb);
break;
case OPC_SETVARP:
vararray_p[param] = popp();
break;
case OPC_GETPROP:
obj = (VMInterface*)popp();
obj->VM_GetProp(this, param);
break;
case OPC_SETPROP:
obj = (VMInterface*)popp();
obj->VM_SetProp(this, param);
break;
case OPC_METCALL:
obj = (VMInterface*)popp();
obj->VM_MetCall(this, param);
break;
case OPC_GETPROPV:
v1 = (Vec2*)popp();
v1->VM_GetProp(this, param);
break;
case OPC_SETPROPV:
v1 = (Vec2*)popp();
v1->VM_SetProp(this, param);
break;
case OPC_METCALLV:
v1 = (Vec2*)popp();
v1->VM_MetCall(this, param);
break;
case OPC_JUMP:
iptr += param*2;
break;
case OPC_IFJUMP:
ia = popi();
if (ia == 0) iptr += param*2;
break;
case OPC_INITFOR:
ib = popi();
ia = popi();
++iptr;
iparam = code->code[iptr++];
ijmp = iptr;
for(ifor=ia;ifor<ib;++ifor)
{
iptr = ijmp;
vararray_i[param] = ifor;
execute_ops(iparam);
/*for(iptr=ijmp;iptr<ijmp+iparam*2;++iptr)
{
opfor = code->code[iptr];
pfor = code->code[++iptr];
if (opfor == OPC_EXIT)
{
--iptr;
return;
}
execute_op(opfor, pfor);
}*/
}
break;
case OPC_LOOP:
; // TODO
break;
case OPC_I2F:
// this will break is floatval uses doubles !!
/* ia = *((int*)top);
*((floatval*)top) = (float)ia;*/
ia = popi();
pushf((floatval)ia);
break;
case OPC_F2I:
/*fa = *((floatval*)top);
*((int*)top) = (int)fa;*/
fa = popf();
pushi((int)fa);
break;
case OPC_VEC2P:
fb = popf();
fa = popf();
v1 = vectemp + (vecidx % 5);
++vecidx;
v1->set(fa,fb);
pushp(v1);
break;
case OPC_P2VEC:
v1 = popv();
pushv(*v1);
break;
case OPC_LASTVEC:
v1 = vectemp + ((vecidx-1)%5);
pushv(*v1);
break;
// --------------------------------------------------
// -------------------- OPERATORS -------------------
// --------------------------------------------------
case OPC_OP_ADDFF:
fa = popf();
*(((floatval*)top)-1) += fa;
break;
case OPC_OP_ADDII:
ia = popi();
*(((int*)top)-1) += ia;
break;
case OPC_OP_ADDVV:
v2 = popv();
v1 = popv();
v.set(*v1);
v.add(*v2);
pushv(v);
break;
case OPC_OP_ANDBB:
ib = popi();
ia = popi();
pushi(ia & ib);
break;
case OPC_OP_DIVFF:
fa = popf();
*(((floatval*)top)-1) /= fa;
break;
case OPC_OP_DIVII:
ia = popi();
*(((int*)top)-1) /= ia;
break;
case OPC_OP_DIVVF:
fa = popf();
v1 = (Vec2*)popp();
v.set(*v1);
v.div(fa);
pushv(v);
break;
case OPC_OP_EQFF:
fb = popf();
fa = popf();
pushi((int)(fa == fb));
break;
case OPC_OP_EQII:
ib = popi();
ia = popi();
pushi((int)(ia == ib));
break;
case OPC_OP_EQVV:
v2 = popv();
v1 = popv();
pushi((int)(ia == ib));
break;
case OPC_OP_GEFF:
fb = popf();
fa = popf();
pushi((int)(fa >= fb));
break;
case OPC_OP_GEII:
ib = popi();
ia = popi();
pushi((int)(ia >= ib));
break;
case OPC_OP_GTFF:
fb = popf();
fa = popf();
pushi((int)(fa > fb));
break;
case OPC_OP_GTII:
ib = popi();
ia = popi();
pushi((int)(ia > ib));
break;
case OPC_OP_LEFF:
fb = popf();
fa = popf();
pushi((int)(fa <= fb));
break;
case OPC_OP_LEII:
ib = popi();
ia = popi();
pushi((int)(ia <= ib));
break;
case OPC_OP_LTFF:
fb = popf();
fa = popf();
pushi((int)(fa < fb));
break;
case OPC_OP_LTII:
ib = popi();
ia = popi();
pushi((int)(ia < ib));
break;
case OPC_OP_MULFF:
fa = popf();
*(((floatval*)top)-1) *= fa;
break;
case OPC_OP_MULII:
ia = popi();
*(((int*)top)-1) *= ia;
break;
case OPC_OP_MULVF:
fa = popf();
v1 = popv();
v.set(*v1);
v.mul(fa);
pushv(v);
break;
case OPC_OP_NEFF:
fb = popf();
fa = popf();
pushi((int)(fa != fb));
break;
case OPC_OP_NEGF:
*(((floatval*)top)-1) = -(*((floatval*)top));
break;
case OPC_OP_NEGI:
*(((int*)top)-1) = -(*((int*)top));
break;
case OPC_OP_NEGV:
v1 = popv();
v.set(-v1->x, -v1->y);
pushv(v);
break;
case OPC_OP_NEII:
ib = popi();
ia = popi();
pushi((int)(ia != ib));
break;
case OPC_OP_NEVV:
v2 = popv();
v1 = popv();
pushi((int)(ia != ib));
break;
case OPC_OP_NOTBB:
; // TODO
break;
case OPC_OP_ORBB:
; // TODO
break;
case OPC_OP_SUBFF:
fa = popf();
*(((floatval*)top)-1) -= fa;
break;
case OPC_OP_SUBII:
ia = popi();
*(((int*)top)-1) -= ia;
break;
case OPC_OP_SUBVV:
v2 = (Vec2*)popp();
v1 = (Vec2*)popp();
v.set(*v1);
v.sub(*v2);
pushv(v);
break;
case OPC_OP_XORBB:
; // TODO
break;
}
}
}
Blk*
div(Blk *ddivd, Blk *ddivr)
{
int divsign, remsign, offset, divcarry,
carry, dig, magic, d, dd, under, first;
long c, td, cc;
Blk *ps, *px, *p, *divd, *divr;
dig = 0;
under = 0;
divcarry = 0;
rem = 0;
p = salloc(0);
if(length(ddivr) == 0) {
pushp(ddivr);
Bprint(&bout,"divide by 0\n");
return(p);
}
divsign = remsign = first = 0;
divr = ddivr;
fsfile(divr);
if(sbackc(divr) == -1) {
divr = copy(ddivr,length(ddivr));
chsign(divr);
divsign = ~divsign;
}
divd = copy(ddivd,length(ddivd));
fsfile(divd);
if(sfbeg(divd) == 0 && sbackc(divd) == -1) {
chsign(divd);
divsign = ~divsign;
remsign = ~remsign;
}
offset = length(divd) - length(divr);
if(offset < 0)
goto ddone;
seekc(p,offset+1);
sputc(divd,0);
magic = 0;
fsfile(divr);
c = sbackc(divr);
if(c < 10)
magic++;
c = c * 100 + (sfbeg(divr)?0:sbackc(divr));
if(magic>0){
c = (c * 100 +(sfbeg(divr)?0:sbackc(divr)))*2;
c /= 25;
}
while(offset >= 0) {
first++;
fsfile(divd);
td = sbackc(divd) * 100;
dd = sfbeg(divd)?0:sbackc(divd);
td = (td + dd) * 100;
dd = sfbeg(divd)?0:sbackc(divd);
td = td + dd;
cc = c;
if(offset == 0)
td++;
else
cc++;
if(magic != 0)
td = td<<3;
dig = td/cc;
under=0;
if(td%cc < 8 && dig > 0 && magic) {
dig--;
under=1;
}
rewind(divr);
rewind(divxyz);
carry = 0;
while(sfeof(divr) == 0) {
d = sgetc(divr)*dig+carry;
carry = d / 100;
salterc(divxyz,d%100);
}
salterc(divxyz,carry);
rewind(divxyz);
seekc(divd,offset);
carry = 0;
while(sfeof(divd) == 0) {
d = slookc(divd);
d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
carry = 0;
if(d < 0) {
d += 100;
carry = 1;
}
salterc(divd,d);
}
divcarry = carry;
backc(p);
salterc(p,dig);
backc(p);
fsfile(divd);
d=sbackc(divd);
if((d != 0) && /*!divcarry*/ (offset != 0)) {
d = sbackc(divd) + 100;
salterc(divd,d);
}
if(--offset >= 0)
divd->wt--;
}
if(under) { /* undershot last - adjust*/
px = copy(divr,length(divr)); /*11/88 don't corrupt ddivr*/
chsign(px);
ps = add(px,divd);
fsfile(ps);
if(length(ps) > 0 && sbackc(ps) < 0) {
release(ps); /*only adjust in really undershot*/
} else {
release(divd);
salterc(p, dig+1);
divd=ps;
}
}
if(divcarry != 0) {
salterc(p,dig-1);
salterc(divd,-1);
ps = add(divr,divd);
release(divd);
divd = ps;
}
rewind(p);
divcarry = 0;
while(sfeof(p) == 0){
d = slookc(p)+divcarry;
divcarry = 0;
if(d >= 100){
d -= 100;
divcarry = 1;
}
salterc(p,d);
}
if(divcarry != 0)salterc(p,divcarry);
fsfile(p);
while(sfbeg(p) == 0) {
if(sbackc(p) != 0)
break;
truncate(p);
}
if(divsign < 0)
chsign(p);
fsfile(divd);
while(sfbeg(divd) == 0) {
if(sbackc(divd) != 0)
break;
truncate(divd);
}
ddone:
if(remsign<0)
chsign(divd);
if(divr != ddivr)
release(divr);
rem = divd;
return(p);
}
void
commnds(void)
{
Blk *p, *q, **ptr, *s, *t;
long l;
Sym *sp;
int sk, sk1, sk2, c, sign, n, d;
while(1) {
Bflush(&bout);
if(((c = readc())>='0' && c <= '9') ||
(c>='A' && c <='F') || c == '.') {
unreadc(c);
p = readin();
pushp(p);
continue;
}
switch(c) {
case ' ':
case '\t':
case '\n':
case -1:
continue;
case 'Y':
sdump("stk",*stkptr);
Bprint(&bout, "all %ld rel %ld headmor %ld\n",all,rel,headmor);
Bprint(&bout, "nbytes %ld\n",nbytes);
Bprint(&bout, "longest %ld active %ld maxsize %ld\n", longest,
active, maxsize);
Bprint(&bout, "new all %d rel %d copy %d more %d lbytes %d\n",
lall, lrel, lcopy, lmore, lbytes);
lall = lrel = lcopy = lmore = lbytes = 0;
continue;
case '_':
p = readin();
savk = sunputc(p);
chsign(p);
sputc(p,savk);
pushp(p);
continue;
case '-':
subt();
continue;
case '+':
if(eqk() != 0)
continue;
binop('+');
continue;
case '*':
arg1 = pop();
EMPTY;
arg2 = pop();
EMPTYR(arg1);
sk1 = sunputc(arg1);
sk2 = sunputc(arg2);
savk = sk1+sk2;
binop('*');
p = pop();
if(savk>k && savk>sk1 && savk>sk2) {
sclobber(p);
sk = sk1;
if(sk<sk2)
sk = sk2;
if(sk<k)
sk = k;
p = removc(p,savk-sk);
savk = sk;
sputc(p,savk);
}
pushp(p);
continue;
case '/':
casediv:
if(dscale() != 0)
continue;
binop('/');
if(irem != 0)
release(irem);
release(rem);
continue;
case '%':
if(dscale() != 0)
continue;
binop('/');
p = pop();
release(p);
if(irem == 0) {
sputc(rem,skr+k);
pushp(rem);
continue;
}
p = add0(rem,skd-(skr+k));
q = add(p,irem);
release(p);
release(irem);
sputc(q,skd);
pushp(q);
continue;
case 'v':
p = pop();
EMPTY;
savk = sunputc(p);
if(length(p) == 0) {
sputc(p,savk);
pushp(p);
continue;
}
if(sbackc(p)<0) {
error("sqrt of neg number\n");
}
if(k<savk)
n = savk;
else {
n = k*2-savk;
savk = k;
}
arg1 = add0(p,n);
arg2 = dcsqrt(arg1);
sputc(arg2,savk);
pushp(arg2);
continue;
case '^':
neg = 0;
arg1 = pop();
EMPTY;
if(sunputc(arg1) != 0)
error("exp not an integer\n");
arg2 = pop();
EMPTYR(arg1);
if(sfbeg(arg1) == 0 && sbackc(arg1)<0) {
neg++;
chsign(arg1);
}
if(length(arg1)>=3) {
error("exp too big\n");
}
savk = sunputc(arg2);
p = dcexp(arg2,arg1);
release(arg2);
rewind(arg1);
c = sgetc(arg1);
if(c == -1)
c = 0;
else
if(sfeof(arg1) == 0)
c = sgetc(arg1)*100 + c;
d = c*savk;
release(arg1);
/* if(neg == 0) { removed to fix -exp bug*/
if(k>=savk)
n = k;
else
n = savk;
if(n<d) {
q = removc(p,d-n);
sputc(q,n);
pushp(q);
} else {
sputc(p,d);
pushp(p);
}
/* } else { this is disaster for exp <-127 */
/* sputc(p,d); */
/* pushp(p); */
/* } */
if(neg == 0)
continue;
p = pop();
q = salloc(2);
sputc(q,1);
sputc(q,0);
pushp(q);
pushp(p);
goto casediv;
case 'z':
p = salloc(2);
n = stkptr - stkbeg;
if(n >= 100) {
sputc(p,n/100);
n %= 100;
}
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Z':
p = pop();
EMPTY;
n = (length(p)-1)<<1;
fsfile(p);
backc(p);
if(sfbeg(p) == 0) {
if((c = sbackc(p))<0) {
n -= 2;
if(sfbeg(p) == 1)
n++;
else {
if((c = sbackc(p)) == 0)
n++;
else
if(c > 90)
n--;
}
} else
if(c < 10)
n--;
}
release(p);
q = salloc(1);
if(n >= 100) {
sputc(q,n%100);
n /= 100;
}
sputc(q,n);
sputc(q,0);
pushp(q);
continue;
case 'i':
p = pop();
EMPTY;
p = scalint(p);
release(inbas);
inbas = p;
continue;
case 'I':
p = copy(inbas,length(inbas)+1);
sputc(p,0);
pushp(p);
continue;
case 'o':
p = pop();
EMPTY;
p = scalint(p);
sign = 0;
n = length(p);
q = copy(p,n);
fsfile(q);
l = c = sbackc(q);
if(n != 1) {
if(c<0) {
sign = 1;
chsign(q);
n = length(q);
fsfile(q);
l = c = sbackc(q);
}
if(n != 1) {
while(sfbeg(q) == 0)
l = l*100+sbackc(q);
}
}
logo = log2(l);
obase = l;
release(basptr);
if(sign == 1)
obase = -l;
basptr = p;
outdit = bigot;
if(n == 1 && sign == 0) {
if(c <= 16) {
outdit = hexot;
fw = 1;
fw1 = 0;
ll = 70;
release(q);
continue;
}
}
n = 0;
if(sign == 1)
n++;
p = salloc(1);
sputc(p,-1);
t = add(p,q);
n += length(t)*2;
fsfile(t);
if(sbackc(t)>9)
n++;
release(t);
release(q);
release(p);
fw = n;
fw1 = n-1;
ll = 70;
if(fw>=ll)
continue;
ll = (70/fw)*fw;
continue;
case 'O':
p = copy(basptr,length(basptr)+1);
sputc(p,0);
pushp(p);
continue;
case '[':
n = 0;
p = salloc(0);
for(;;) {
if((c = readc()) == ']') {
if(n == 0)
break;
n--;
}
sputc(p,c);
if(c == '[')
n++;
}
pushp(p);
continue;
case 'k':
p = pop();
EMPTY;
p = scalint(p);
if(length(p)>1) {
error("scale too big\n");
}
rewind(p);
k = 0;
if(!sfeof(p))
k = sgetc(p);
release(scalptr);
scalptr = p;
continue;
case 'K':
p = copy(scalptr,length(scalptr)+1);
sputc(p,0);
pushp(p);
continue;
case 'X':
p = pop();
EMPTY;
fsfile(p);
n = sbackc(p);
release(p);
p = salloc(2);
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Q':
p = pop();
EMPTY;
if(length(p)>2) {
error("Q?\n");
}
rewind(p);
if((c = sgetc(p))<0) {
error("neg Q\n");
}
release(p);
while(c-- > 0) {
if(readptr == &readstk[0]) {
error("readstk?\n");
}
if(*readptr != 0)
release(*readptr);
readptr--;
}
continue;
case 'q':
if(readptr <= &readstk[1])
exits(0);
if(*readptr != 0)
release(*readptr);
readptr--;
if(*readptr != 0)
release(*readptr);
readptr--;
continue;
case 'f':
if(stkptr == &stack[0])
Bprint(&bout,"empty stack\n");
else {
for(ptr = stkptr; ptr > &stack[0];) {
dcprint(*ptr--);
}
}
continue;
case 'p':
if(stkptr == &stack[0])
Bprint(&bout,"empty stack\n");
else {
dcprint(*stkptr);
}
continue;
case 'P':
p = pop();
EMPTY;
sputc(p,0);
Bprint(&bout,"%s",p->beg);
release(p);
continue;
case 'd':
if(stkptr == &stack[0]) {
Bprint(&bout,"empty stack\n");
continue;
}
q = *stkptr;
n = length(q);
p = copy(*stkptr,n);
pushp(p);
continue;
case 'c':
while(stkerr == 0) {
p = pop();
if(stkerr == 0)
release(p);
}
continue;
case 'S':
if(stkptr == &stack[0]) {
error("save: args\n");
}
c = getstk() & 0377;
sptr = stable[c];
sp = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)
goto sempty;
sp->next = sptr;
p = pop();
EMPTY;
if(c >= ARRAYST) {
q = copy(p,length(p)+PTRSZ);
for(n = 0;n < PTRSZ;n++) {
sputc(q,0);
}
release(p);
p = q;
}
sp->val = p;
continue;
sempty:
error("symbol table overflow\n");
case 's':
if(stkptr == &stack[0]) {
error("save:args\n");
}
c = getstk() & 0377;
sptr = stable[c];
if(sptr != 0) {
p = sptr->val;
if(c >= ARRAYST) {
rewind(p);
while(sfeof(p) == 0)
release(dcgetwd(p));
}
release(p);
} else {
sptr = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)
goto sempty;
sptr->next = 0;
}
p = pop();
sptr->val = p;
continue;
case 'l':
load();
continue;
case 'L':
c = getstk() & 0377;
sptr = stable[c];
if(sptr == 0) {
error("L?\n");
}
stable[c] = sptr->next;
sptr->next = sfree;
sfree = sptr;
p = sptr->val;
if(c >= ARRAYST) {
rewind(p);
while(sfeof(p) == 0) {
q = dcgetwd(p);
if(q != 0)
release(q);
}
}
pushp(p);
continue;
case ':':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
error("neg index\n");
}
if(length(q)>2) {
error("index too big\n");
}
if(sfbeg(q) == 0)
c = c*100+sbackc(q);
if(c >= MAXIND) {
error("index too big\n");
}
release(q);
n = getstk() & 0377;
sptr = stable[n];
if(sptr == 0) {
sptr = stable[n] = sfree;
sfree = sfree->next;
if(sfree == 0)
goto sempty;
sptr->next = 0;
p = salloc((c+PTRSZ)*PTRSZ);
zero(p);
} else {
p = sptr->val;
if(length(p)-PTRSZ < c*PTRSZ) {
q = copy(p,(c+PTRSZ)*PTRSZ);
release(p);
p = q;
}
}
seekc(p,c*PTRSZ);
q = lookwd(p);
if(q!=0)
release(q);
s = pop();
EMPTY;
salterwd(p, s);
sptr->val = p;
continue;
case ';':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)) {
error("neg index\n");
}
if(length(q)>2) {
error("index too big\n");
}
if(sfbeg(q) == 0)
c = c*100+sbackc(q);
if(c >= MAXIND) {
error("index too big\n");
}
release(q);
n = getstk() & 0377;
sptr = stable[n];
if(sptr != 0){
p = sptr->val;
if(length(p)-PTRSZ >= c*PTRSZ) {
seekc(p,c*PTRSZ);
s = dcgetwd(p);
if(s != 0) {
q = copy(s,length(s));
pushp(q);
continue;
}
}
}
q = salloc(1); /*so uninitialized array elt prints as 0*/
sputc(q, 0);
pushp(q);
continue;
case 'x':
execute:
p = pop();
EMPTY;
if((readptr != &readstk[0]) && (*readptr != 0)) {
if((*readptr)->rd == (*readptr)->wt)
release(*readptr);
else {
if(readptr++ == &readstk[RDSKSZ]) {
error("nesting depth\n");
}
}
} else
readptr++;
*readptr = p;
if(p != 0)
rewind(p);
else {
if((c = readc()) != '\n')
unreadc(c);
}
continue;
case '?':
if(++readptr == &readstk[RDSKSZ]) {
error("nesting depth\n");
}
*readptr = 0;
fsave = curfile;
curfile = &bin;
while((c = readc()) == '!')
command();
p = salloc(0);
sputc(p,c);
while((c = readc()) != '\n') {
sputc(p,c);
if(c == '\\')
sputc(p,readc());
}
curfile = fsave;
*readptr = p;
continue;
case '!':
if(command() == 1)
goto execute;
continue;
case '<':
case '>':
case '=':
if(cond(c) == 1)
goto execute;
continue;
default:
Bprint(&bout,"%o is unimplemented\n",c);
}
}
}
void
dcprint(Blk *hptr)
{
Blk *p, *q, *dec;
int dig, dout, ct, sc;
rewind(hptr);
while(sfeof(hptr) == 0) {
if(sgetc(hptr)>99) {
rewind(hptr);
while(sfeof(hptr) == 0) {
Bprint(&bout,"%c",sgetc(hptr));
}
Bprint(&bout,"\n");
return;
}
}
fsfile(hptr);
sc = sbackc(hptr);
if(sfbeg(hptr) != 0) {
Bprint(&bout,"0\n");
return;
}
count = ll;
p = copy(hptr,length(hptr));
sclobber(p);
fsfile(p);
if(sbackc(p)<0) {
chsign(p);
OUTC('-');
}
if((obase == 0) || (obase == -1)) {
oneot(p,sc,'d');
return;
}
if(obase == 1) {
oneot(p,sc,'1');
return;
}
if(obase == 10) {
tenot(p,sc);
return;
}
/* sleazy hack to scale top of stack - divide by 1 */
pushp(p);
sputc(p, sc);
p=salloc(0);
create(p);
sputc(p, 1);
sputc(p, 0);
pushp(p);
if(dscale() != 0)
return;
p = div(arg1, arg2);
release(arg1);
release(arg2);
sc = savk;
create(strptr);
dig = logten*sc;
dout = ((dig/10) + dig) / logo;
dec = getdec(p,sc);
p = removc(p,sc);
while(length(p) != 0) {
q = div(p,basptr);
release(p);
p = q;
(*outdit)(rem,0);
}
release(p);
fsfile(strptr);
while(sfbeg(strptr) == 0)
OUTC(sbackc(strptr));
if(sc == 0) {
release(dec);
Bprint(&bout,"\n");
return;
}
create(strptr);
OUTC('.');
ct=0;
do {
q = mult(basptr,dec);
release(dec);
dec = getdec(q,sc);
p = removc(q,sc);
(*outdit)(p,1);
} while(++ct < dout);
release(dec);
rewind(strptr);
while(sfeof(strptr) == 0)
OUTC(sgetc(strptr));
Bprint(&bout,"\n");
}
void
commnds(void){
register int c;
register struct blk *p,*q;
long l;
int sign;
struct blk **ptr,*s,*t;
struct sym *sp;
int sk,sk1,sk2;
int n,d;
while(1){
if(((c = readc())>='0' && c <= '9')|| (c>='A' && c <='F') || c == '.'){
unreadc(c);
p = readin();
pushp(p);
continue;
}
switch(c){
case ' ':
case '\n':
case 0377:
case EOF:
continue;
case 'Y':
sdump("stk",*stkptr);
printf("all %ld rel %ld headmor %ld\n",all,rel,headmor);
printf("nbytes %ld\n",nbytes);
continue;
case '_':
p = readin();
savk = sunputc(p);
chsign(p);
sputc(p,savk);
pushp(p);
continue;
case '-':
subt();
continue;
case '+':
if(eqk() != 0)continue;
binop('+');
continue;
case '*':
arg1 = pop();
EMPTY;
arg2 = pop();
EMPTYR(arg1);
sk1 = sunputc(arg1);
sk2 = sunputc(arg2);
binop('*');
p = pop();
sunputc(p);
savk = n = sk1+sk2;
if(n>k && n>sk1 && n>sk2){
sk = sk1;
if(sk<sk2)sk = sk2;
if(sk<k)sk = k;
p = removc(p,n-sk);
savk = sk;
}
sputc(p,savk);
pushp(p);
continue;
case '/':
casediv:
if(dscale() != 0)continue;
binop('/');
if(irem != 0)release(irem);
release(rem);
continue;
case '%':
if(dscale() != 0)continue;
binop('/');
p = pop();
release(p);
if(irem == 0){
sputc(rem,skr+k);
pushp(rem);
continue;
}
p = add0(rem,skd-(skr+k));
q = add(p,irem);
release(p);
release(irem);
sputc(q,skd);
pushp(q);
continue;
case 'v':
p = pop();
EMPTY;
savk = sunputc(p);
if(length(p) == 0){
sputc(p,savk);
pushp(p);
continue;
}
if((c = sbackc(p))<0){
error("sqrt of neg number\n");
}
if(k<savk)n = savk;
else{
n = k*2-savk;
savk = k;
}
arg1 = add0(p,n);
arg2 = dcsqrt(arg1);
sputc(arg2,savk);
pushp(arg2);
continue;
case '^':
neg = 0;
arg1 = pop();
EMPTY;
if(sunputc(arg1) != 0)error("exp not an integer\n");
arg2 = pop();
EMPTYR(arg1);
if(sfbeg(arg1) == 0 && sbackc(arg1)<0){
neg++;
chsign(arg1);
}
if(length(arg1)>=3){
error("exp too big\n");
}
savk = sunputc(arg2);
p = dcexp(arg2,arg1);
release(arg2);
rewind(arg1);
c = sgetc(arg1);
if(sfeof(arg1) == 0)
c = sgetc(arg1)*100 + c;
d = c*savk;
release(arg1);
if(neg == 0){
if(k>=savk)n = k;
else n = savk;
if(n<d){
q = removc(p,d-n);
sputc(q,n);
pushp(q);
}
else {
sputc(p,d);
pushp(p);
}
}
else {
sputc(p,d);
pushp(p);
}
if(neg == 0)continue;
p = pop();
q = salloc(2);
sputc(q,1);
sputc(q,0);
pushp(q);
pushp(p);
goto casediv;
case 'z':
p = salloc(2);
n = stkptr - stkbeg;
if(n >= 100){
sputc(p,n/100);
n %= 100;
}
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Z':
p = pop();
EMPTY;
n = (length(p)-1)<<1;
fsfile(p);
sbackc(p);
if(sfbeg(p) == 0){
if((c = sbackc(p))<0){
n -= 2;
if(sfbeg(p) == 1)n += 1;
else {
if((c = sbackc(p)) == 0)n += 1;
else if(c > 90)n -= 1;
}
}
else if(c < 10) n -= 1;
}
release(p);
q = salloc(1);
if(n >= 100){
sputc(q,n%100);
n /= 100;
}
sputc(q,n);
sputc(q,0);
pushp(q);
continue;
case 'i':
p = pop();
EMPTY;
p = scalint(p);
release(inbas);
inbas = p;
continue;
case 'I':
p = copy(inbas,length(inbas)+1);
sputc(p,0);
pushp(p);
continue;
case 'o':
p = pop();
EMPTY;
p = scalint(p);
sign = 0;
n = length(p);
q = copy(p,n);
fsfile(q);
l = c = sbackc(q);
if(n != 1){
if(c<0){
sign = 1;
chsign(q);
n = length(q);
fsfile(q);
l = c = sbackc(q);
}
if(n != 1){
while(sfbeg(q) == 0)l = l*100+sbackc(q);
}
}
if (l > BC_BASE_MAX)
error("output base is too large\n");
logo = log_2(l);
obase = l;
release(basptr);
if(sign == 1)obase = (long)-l;
basptr = p;
outdit = (int (*)(struct blk *, int, int))bigot;
if(n == 1 && sign == 0){
if(c <= 16){
outdit = (int (*)(struct blk *, int, int))hexot;
fw = 1;
fw1 = 0;
ll = 68;
release(q);
continue;
}
}
n = 0;
if(sign == 1)n++;
p = salloc(1);
sputc(p,-1);
t = add(p,q);
n += length(t)*2;
fsfile(t);
if((c = sbackc(t))>9)n++;
release(t);
release(q);
release(p);
fw = n;
fw1 = n-1;
ll = 68;
if(fw>=ll)continue;
ll = (68/fw)*fw;
continue;
case 'O':
p = copy(basptr,length(basptr)+1);
sputc(p,0);
pushp(p);
continue;
case '[':
n = 0;
p = salloc(0);
while(1){
if((c = readc()) == ']'){
if(n == 0)break;
n--;
}
sputc(p,c);
if(c == '[')n++;
}
pushp(p);
continue;
case 'k':
p = pop();
EMPTY;
p = scalint(p);
if(length(p)>1){
error("scale too big\n");
}
rewind(p);
k = sfeof(p)?0:sgetc(p);
release(scalptr);
scalptr = p;
continue;
case 'K':
p = copy(scalptr,length(scalptr)+1);
sputc(p,0);
pushp(p);
continue;
case 'X':
p = pop();
EMPTY;
fsfile(p);
n = sbackc(p);
release(p);
p = salloc(2);
sputc(p,n);
sputc(p,0);
pushp(p);
continue;
case 'Q':
p = pop();
EMPTY;
if(length(p)>2){
error("Q?\n");
}
rewind(p);
if((c = sgetc(p))<0){
error("neg Q\n");
}
release(p);
while(c-- > 0){
if(readptr == &readstk[0]){
error("readstk?\n");
}
if(*readptr != 0)release(*readptr);
readptr--;
}
continue;
case 'q':
if(readptr <= &readstk[1])exit(0);
if(*readptr != 0)release(*readptr);
readptr--;
if(*readptr != 0)release(*readptr);
readptr--;
continue;
case 'f':
if(stkptr == &stack[0])printf("empty stack\n");
else {
for(ptr = stkptr; ptr > &stack[0];){
print(*ptr--);
}
}
continue;
case 'p':
if(stkptr == &stack[0])printf("empty stack\n");
else{
print(*stkptr);
}
continue;
case 'P':
p = pop();
EMPTY;
sputc(p,0);
printf("%s",p->beg);
release(p);
continue;
case 'd':
if(stkptr == &stack[0]){
printf("empty stack\n");
continue;
}
q = *stkptr;
n = length(q);
p = copy(*stkptr,n);
pushp(p);
continue;
case 'c':
while(stkerr == 0){
p = pop();
if(stkerr == 0)release(p);
}
continue;
case 'S':
if(stkptr == &stack[0]){
error("save: args\n");
}
c = readc() & 0377;
sptr = stable[c];
sp = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)goto sempty;
sp->next = sptr;
p = pop();
EMPTY;
if(c >= ARRAYST){
q = copy(p,length(p));
for(n = 0;n < PTRSZ;n++)sputc(q,0);
release(p);
p = q;
}
sp->val = p;
continue;
sempty:
error("symbol table overflow\n");
case 's':
if(stkptr == &stack[0]){
error("save:args\n");
}
c = readc() & 0377;
sptr = stable[c];
if(sptr != 0){
p = sptr->val;
if(c >= ARRAYST){
rewind(p);
while(sfeof(p) == 0)release(dcgetwd(p));
}
release(p);
}
else{
sptr = stable[c] = sfree;
sfree = sfree->next;
if(sfree == 0)goto sempty;
sptr->next = 0;
}
p = pop();
sptr->val = p;
continue;
case 'l':
load();
continue;
case 'L':
c = readc() & 0377;
sptr = stable[c];
if(sptr == 0){
error("L?\n");
}
stable[c] = sptr->next;
sptr->next = sfree;
sfree = sptr;
p = sptr->val;
if(c >= ARRAYST){
rewind(p);
while(sfeof(p) == 0){
q = dcgetwd(p);
if(q != 0)release(q);
}
}
pushp(p);
continue;
case ':':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
error("neg index\n");
}
if(length(q)>2){
error("index too big\n");
}
if(sfbeg(q) == 0)c = c*100+sbackc(q);
if(c >= BC_DIM_MAX){
error("index too big\n");
}
release(q);
n = readc() & 0377;
sptr = stable[n];
if(sptr == 0){
sptr = stable[n] = sfree;
sfree = sfree->next;
if(sfree == 0)goto sempty;
sptr->next = 0;
p = salloc((c+PTRSZ)*PTRSZ);
zero(p);
}
else{
p = sptr->val;
if(length(p)-PTRSZ < c*PTRSZ){
q = copy(p,(c+PTRSZ)*PTRSZ);
release(p);
p = q;
}
}
seekc(p,c*PTRSZ);
q = lookwd(p);
if (q!=NULL) release(q);
s = pop();
EMPTY;
salterwd((struct wblk *)p,s);
sptr->val = p;
continue;
case ';':
p = pop();
EMPTY;
q = scalint(p);
fsfile(q);
c = 0;
if((sfbeg(q) == 0) && ((c = sbackc(q))<0)){
error("neg index\n");
}
if(length(q)>2){
error("index too big\n");
}
if(sfbeg(q) == 0)c = c*100+sbackc(q);
if(c >= BC_DIM_MAX){
error("index too big\n");
}
release(q);
n = readc() & 0377;
sptr = stable[n];
if(sptr != 0){
p = sptr->val;
if(length(p)-PTRSZ >= c*PTRSZ){
seekc(p,c*PTRSZ);
s = dcgetwd(p);
if(s != 0){
q = copy(s,length(s));
pushp(q);
continue;
}
}
}
q = salloc(1);
sputc(q, 0);
pushp(q);
continue;
case 'x':
execute:
p = pop();
EMPTY;
if((readptr != &readstk[0]) && (*readptr != 0)){
if((*readptr)->rd == (*readptr)->wt)
release(*readptr);
else{
if(readptr++ == &readstk[RDSKSZ]){
error("nesting depth\n");
}
}
}
else readptr++;
*readptr = p;
if(p != 0)rewind(p);
else{
if((c = readc()) != '\n')unreadc(c);
}
continue;
case '?':
if(++readptr == &readstk[RDSKSZ]){
error("nesting depth\n");
}
*readptr = 0;
fsave = curfile;
curfile = stdin;
while((c = readc()) == '!')command();
p = salloc(0);
sputc(p,c);
while((c = readc()) != '\n'){
sputc(p,c);
if(c == '\\')sputc(p,readc());
}
curfile = fsave;
*readptr = p;
continue;
case '!':
if(command() == 1)goto execute;
continue;
case '<':
case '>':
case '=':
if(cond(c) == 1)goto execute;
continue;
default:
printf("%o is unimplemented\n",c);
}
}
}
struct blk *
div(struct blk *ddivd,struct blk *ddivr)
{
int divsign,remsign,offset,divcarry = 0;
int carry, dig = 0,magic,d = 0,dd;
long c,td,cc;
struct blk *ps;
register struct blk *p,*divd,*divr;
rem = 0;
p = salloc(0);
if(length(ddivr) == 0){
pushp(ddivr);
printf("divide by 0\n");
return NULL;
}
divsign = remsign = 0;
divr = ddivr;
fsfile(divr);
if(sbackc(divr) == -1){
divr = copy(ddivr,length(ddivr));
chsign(divr);
divsign = ~divsign;
}
divd = copy(ddivd,length(ddivd));
fsfile(divd);
if(sfbeg(divd) == 0 && sbackc(divd) == -1){
chsign(divd);
divsign = ~divsign;
remsign = ~remsign;
}
offset = length(divd) - length(divr);
if(offset < 0)goto ddone;
seekc(p,offset+1);
sputc(divd,0);
magic = 0;
fsfile(divr);
c = sbackc(divr);
if(c<10)magic++;
c = c*100 + (sfbeg(divr)?0:sbackc(divr));
if(magic>0){
c = (c*100 +(sfbeg(divr)?0:sbackc(divr)))*2;
c /= 25;
}
while(offset >= 0){
fsfile(divd);
td = sbackc(divd)*100;
dd = sfbeg(divd)?0:sbackc(divd);
td = (td+dd)*100;
dd = sfbeg(divd)?0:sbackc(divd);
td = td+dd;
cc = c;
if(offset == 0)td += 1;
else cc += 1;
if(magic != 0)td = td<<3;
dig = td/cc;
rewind(divr);
rewind(divxyz);
carry = 0;
while(sfeof(divr) == 0){
d = sgetc(divr)*dig+carry;
carry = d / 100;
salterc(divxyz,d%100);
}
salterc(divxyz,carry);
rewind(divxyz);
seekc(divd,offset);
carry = 0;
while(sfeof(divd) == 0){
d = slookc(divd);
d = d-(sfeof(divxyz)?0:sgetc(divxyz))-carry;
carry = 0;
if(d < 0){
d += 100;
carry = 1;
}
salterc(divd,d);
}
divcarry = carry;
sbackc(p);
salterc(p,dig);
sbackc(p);
if(--offset >= 0){
if(d > 0){
sbackc(divd);
dd=sbackc(divd);
salterc(divd,dd+100);
}
divd->wt--;
}
}
if(divcarry != 0){
salterc(p,dig-1);
salterc(divd,-1);
ps = add(divr,divd);
release(divd);
divd = ps;
}
rewind(p);
divcarry = 0;
while(sfeof(p) == 0){
d = slookc(p)+divcarry;
divcarry = 0;
if(d >= 100){
d -= 100;
divcarry = 1;
}
salterc(p,d);
}
if(divcarry != 0)salterc(p,divcarry);
fsfile(p);
while(sfbeg(p) == 0){
if(sbackc(p) == 0)truncate(p);
else break;
}
if(divsign < 0)chsign(p);
fsfile(divd);
while(sfbeg(divd) == 0){
if(sbackc(divd) == 0)truncate(divd);
else break;
}
ddone:
if(remsign<0)chsign(divd);
if(divr != ddivr)release(divr);
rem = divd;
return(p);
}
/* cparser parse the c source code and find
* rudimentary syntax errors of unbalanced
* parentheses, brackets and braces.
* This it the solution to the K&R 1-24 */
main()
{
int c;
char qmark, paren;
int state;
int line; /* the current line num */
state = OUT;
line = 1;
sp = -1; /* initial the stack pointer */
while ((c = getchar()) != EOF){
if (c == '\n') /* record the line number */
++line;
if (state == OUT){
putchar(c);
if (c == '\'' || c == '\"'){ /* when we met quotes */
qmark = c;
state = INQ;
}
else if (c == '/'){ /* when we met comments */
if ((c = getchar()) == '*')
state = INC;
}
else if (c == '{' || c == '(' || c == '['){
if (pushp(c) == '\0'){
printf("Sorry, we can't handle source code contains too"
" many brackets.\n");
return -1;
}
}
else if (c == '}' || c == ')' || c == ']'){
paren = getp();
switch (paren){
case '{':
if(c == '}')
popp();
else
printf("\nUnbalanced brackets in line %d.\n", line);
break;
case '(':
if(c == ')')
popp();
else
printf("\nUnbalanced parentheses in line %d.\n", line);
break;
case '[':
if(c == ']')
popp();
else
printf("\nUnbalanced braces in line %d.\n", line);
break;
default:
printf("\nUnbalanced %c in line %d.\n", c, line);
}
}
}
else if (state == INC){
if (c == '*' && (c = getchar()) == '/'){
state = OUT;
}
}
else if (state == INQ){
putchar(c);
if (c == '\\'){
c = getchar(); /* skip the escape seqence */
putchar(c);
c = getchar();
putchar(c);
}
if (c == qmark)
state = OUT;
}
}
return 0;
}
