int eqk(void) { Blk *p, *q; int skp, skq; p = pop(); EMPTYS; q = pop(); EMPTYSR(p); skp = sunputc(p); skq = sunputc(q); if(skp == skq) { arg1=p; arg2=q; savk = skp; return(0); } if(skp < skq) { savk = skq; p = add0(p,skq-skp); } else { savk = skp; q = add0(q,skp-skq); } arg1=p; arg2=q; return(0); }
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); }
struct blk * scalint(struct blk *p) { register int n; n = sunputc(p); p = removc(p,n); return(p); }
Blk* scalint(Blk *p) { int n; n = sunputc(p); p = removc(p,n); return(p); }
int subt(void){ arg1=pop(); EMPTYS; savk = sunputc(arg1); chsign(arg1); sputc(arg1,savk); pushp(arg1); if(eqk() != 0)return(1); binop('+'); return(0); }
void bigot(struct blk *p,int flg,int putspc) { register struct blk *t,*q; register int l = 0; int neg; if(flg == 1)t = salloc(0); else{ t = strptr; l = length(strptr)+fw-1; } neg=0; if(length(p) != 0){ fsfile(p); if(sbackc(p)<0){ neg=1; chsign(p); } while(length(p) != 0){ q = dcdiv(p,tenptr); release(p); p = q; rewind(rem); sputc(t,sfeof(rem)?'0':sgetc(rem)+'0'); release(rem); } } release(p); if(flg == 1){ l = fw1-length(t); if(neg != 0){ l--; sputc(strptr,'-'); } fsfile(t); while(l-- > 0)sputc(strptr,'0'); while(sfbeg(t) == 0)sputc(strptr,sbackc(t)); release(t); } else{ l -= length(strptr); while(l-- > 0)sputc(strptr,'0'); if(neg != 0){ sunputc(strptr); sputc(strptr,'-'); } } if (putspc) sputc(strptr,' '); return; }
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); }
int cond(char c) { register struct blk *p; register int cc; if(subt() != 0)return(1); p = pop(); sunputc(p); if(length(p) == 0){ release(p); if(c == '<' || c == '>' || c == NE){ readc(); return(0); } load(); return(1); } else { if(c == '='){ release(p); readc(); return(0); } } if(c == NE){ release(p); load(); return(1); } fsfile(p); cc = sbackc(p); release(p); if((cc<0 && (c == '<' || c == NG)) || (cc >0) && (c == '>' || c == NL)){ readc(); return(0); } load(); return(1); }
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 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); } } }
void print(struct blk *hptr) { int sc; register struct blk *p,*q,*dec; int dig,dout,ct; rewind(hptr); while(sfeof(hptr) == 0){ if(sgetc(hptr)>99){ rewind(hptr); while(sfeof(hptr) == 0){ printf("%c",sgetc(hptr)); } printf("\n"); return; } } fsfile(hptr); sc = sbackc(hptr); if(sfbeg(hptr) != 0){ printf("0\n"); return; } count = ll; p = copy(hptr,length(hptr)); sunputc(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; } create(strptr); dig = log_10*sc; dout = ((dig/10) + dig) /logo; dec = getdec(p,sc); p = removc(p,sc); while(length(p) != 0){ q = dcdiv(p,basptr); release(p); p = q; (*outdit)(rem,0,1); } release(p); fsfile(strptr); while(sfbeg(strptr) == 0)OUTC(sbackc(strptr)); if(sc == 0){ release(dec); printf("\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,ct+1<dout); }while(++ct < dout); release(dec); rewind(strptr); while(sfeof(strptr) == 0)OUTC(sgetc(strptr)); printf("\n"); return; }