12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303 |
- /*
- * This file is part of the UCB release of Plan 9. It is subject to the license
- * terms in the LICENSE file found in the top-level directory of this
- * distribution and at http://akaros.cs.berkeley.edu/files/Plan9License. No
- * part of the UCB release of Plan 9, including this file, may be copied,
- * modified, propagated, or distributed except according to the terms contained
- * in the LICENSE file.
- */
- #include <u.h>
- #include <libc.h>
- #include <bio.h>
- typedef void* pointer;
- #pragma varargck type "lx" pointer
- #define FATAL 0
- #define NFATAL 1
- #define BLK sizeof(Blk)
- #define PTRSZ sizeof(int*)
- #define TBLSZ 256 /* 1<<BI2BY */
- #define HEADSZ 1024
- #define STKSZ 100
- #define RDSKSZ 100
- #define ARRAYST 221
- #define MAXIND 2048
- #define NL 1
- #define NG 2
- #define NE 3
- #define length(p) ((p)->wt-(p)->beg)
- #define rewind(p) (p)->rd=(p)->beg
- #define create(p) (p)->rd = (p)->wt = (p)->beg
- #define fsfile(p) (p)->rd = (p)->wt
- #define truncate(p) (p)->wt = (p)->rd
- #define sfeof(p) (((p)->rd==(p)->wt)?1:0)
- #define sfbeg(p) (((p)->rd==(p)->beg)?1:0)
- #define sungetc(p,c) *(--(p)->rd)=c
- #define sgetc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd++)
- #define skipc(p) {if((p)->rd<(p)->wt)(p)->rd++;}
- #define slookc(p) (((p)->rd==(p)->wt)?-1:*(p)->rd)
- #define sbackc(p) (((p)->rd==(p)->beg)?-1:*(--(p)->rd))
- #define backc(p) {if((p)->rd>(p)->beg) --(p)->rd;}
- #define sputc(p,c) {if((p)->wt==(p)->last)more(p);\
- *(p)->wt++ = c; }
- #define salterc(p,c) {if((p)->rd==(p)->last)more(p);\
- *(p)->rd++ = c;\
- if((p)->rd>(p)->wt)(p)->wt=(p)->rd;}
- #define sunputc(p) (*((p)->rd = --(p)->wt))
- #define sclobber(p) ((p)->rd = --(p)->wt)
- #define zero(p) for(pp=(p)->beg;pp<(p)->last;)\
- *pp++='\0'
- #define OUTC(x) {Bputc(&bout,x); if(--count == 0){Bprint(&bout,"\\\n"); count=ll;} }
- #define TEST2 {if((count -= 2) <=0){Bprint(&bout,"\\\n");count=ll;}}
- #define EMPTY if(stkerr != 0){Bprint(&bout,"stack empty\n"); continue; }
- #define EMPTYR(x) if(stkerr!=0){pushp(x);Bprint(&bout,"stack empty\n");continue;}
- #define EMPTYS if(stkerr != 0){Bprint(&bout,"stack empty\n"); return(1);}
- #define EMPTYSR(x) if(stkerr !=0){Bprint(&bout,"stack empty\n");pushp(x);return(1);}
- #define error(p) {Bprint(&bout,p); continue; }
- #define errorrt(p) {Bprint(&bout,p); return(1); }
- #define LASTFUN 026
- typedef struct Blk Blk;
- struct Blk
- {
- char *rd;
- char *wt;
- char *beg;
- char *last;
- };
- typedef struct Sym Sym;
- struct Sym
- {
- Sym *next;
- Blk *val;
- };
- typedef struct Wblk Wblk;
- struct Wblk
- {
- Blk **rdw;
- Blk **wtw;
- Blk **begw;
- Blk **lastw;
- };
- Biobuf *curfile, *fsave;
- Blk *arg1, *arg2;
- uint8_t savk;
- int dbg;
- int ifile;
- Blk *scalptr, *basptr, *tenptr, *inbas;
- Blk *sqtemp, *chptr, *strptr, *divxyz;
- Blk *stack[STKSZ];
- Blk **stkptr,**stkbeg;
- Blk **stkend;
- Blk *hfree;
- int stkerr;
- int lastchar;
- Blk *readstk[RDSKSZ];
- Blk **readptr;
- Blk *rem;
- int k;
- Blk *irem;
- int skd,skr;
- int neg;
- Sym symlst[TBLSZ];
- Sym *stable[TBLSZ];
- Sym *sptr, *sfree;
- int32_t rel;
- int32_t nbytes;
- int32_t all;
- int32_t headmor;
- int32_t obase;
- int fw,fw1,ll;
- void (*outdit)(Blk *p, int flg);
- int logo;
- int logten;
- int count;
- char *pp;
- char *dummy;
- int32_t longest, maxsize, active;
- int lall, lrel, lcopy, lmore, lbytes;
- int inside;
- Biobuf bin;
- Biobuf bout;
- void main(int argc, char *argv[]);
- void commnds(void);
- Blk* readin(void);
- Blk* div(Blk *ddivd, Blk *ddivr);
- int dscale(void);
- Blk* removr(Blk *p, int n);
- Blk* dcsqrt(Blk *p);
- void init(int argc, char *argv[]);
- void onintr(void);
- void pushp(Blk *p);
- Blk* pop(void);
- Blk* readin(void);
- Blk* add0(Blk *p, int ct);
- Blk* mult(Blk *p, Blk *q);
- void chsign(Blk *p);
- int readc(void);
- void unreadc(char c);
- void binop(char c);
- void dcprint(Blk *hptr);
- Blk* dcexp(Blk *base, Blk *ex);
- Blk* getdec(Blk *p, int sc);
- void tenot(Blk *p, int sc);
- void oneot(Blk *p, int sc, char ch);
- void hexot(Blk *p, int flg);
- void bigot(Blk *p, int flg);
- Blk* add(Blk *a1, Blk *a2);
- int eqk(void);
- Blk* removc(Blk *p, int n);
- Blk* scalint(Blk *p);
- Blk* scale(Blk *p, int n);
- int subt(void);
- int command(void);
- int cond(char c);
- void load(void);
- int log2(int32_t n);
- Blk* salloc(int size);
- Blk* morehd(void);
- Blk* copy(Blk *hptr, int size);
- void sdump(char *s1, Blk *hptr);
- void seekc(Blk *hptr, int n);
- void salterwd(Blk *hptr, Blk *n);
- void more(Blk *hptr);
- void ospace(char *s);
- void garbage(char *s);
- void release(Blk *p);
- Blk* dcgetwd(Blk *p);
- void putwd(Blk *p, Blk *c);
- Blk* lookwd(Blk *p);
- int getstk(void);
- /********debug only**/
- void
- tpr(char *cp, Blk *bp)
- {
- print("%s-> ", cp);
- print("beg: %lx rd: %lx wt: %lx last: %lx\n", bp->beg, bp->rd,
- bp->wt, bp->last);
- for (cp = bp->beg; cp != bp->wt; cp++) {
- print("%d", *cp);
- if (cp != bp->wt-1)
- print("/");
- }
- print("\n");
- }
- /************/
- void
- main(int argc, char *argv[])
- {
- Binit(&bin, 0, OREAD);
- Binit(&bout, 1, OWRITE);
- init(argc,argv);
- commnds();
- exits(0);
- }
- void
- commnds(void)
- {
- Blk *p, *q, **ptr, *s, *t;
- int32_t 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);
- }
- }
- }
- Blk*
- div(Blk *ddivd, Blk *ddivr)
- {
- int divsign, remsign, offset, divcarry,
- carry, dig, magic, d, dd, under, first;
- int32_t 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);
- }
- 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);
- }
- Blk*
- removr(Blk *p, int n)
- {
- int nn, neg;
- Blk *q, *s, *r;
- fsfile(p);
- neg = sbackc(p);
- if(neg < 0)
- chsign(p);
- rewind(p);
- nn = (n+1)/2;
- q = salloc(nn);
- while(n>1) {
- sputc(q,sgetc(p));
- n -= 2;
- }
- r = salloc(2);
- while(sfeof(p) == 0)
- sputc(r,sgetc(p));
- release(p);
- if(n == 1){
- s = div(r,tenptr);
- release(r);
- rewind(rem);
- if(sfeof(rem) == 0)
- sputc(q,sgetc(rem));
- release(rem);
- if(neg < 0){
- chsign(s);
- chsign(q);
- irem = q;
- return(s);
- }
- irem = q;
- return(s);
- }
- if(neg < 0) {
- chsign(r);
- chsign(q);
- irem = q;
- return(r);
- }
- irem = q;
- return(r);
- }
- Blk*
- dcsqrt(Blk *p)
- {
- Blk *t, *r, *q, *s;
- int c, n, nn;
- n = length(p);
- fsfile(p);
- c = sbackc(p);
- if((n&1) != 1)
- c = c*100+(sfbeg(p)?0:sbackc(p));
- n = (n+1)>>1;
- r = salloc(n);
- zero(r);
- seekc(r,n);
- nn=1;
- while((c -= nn)>=0)
- nn+=2;
- c=(nn+1)>>1;
- fsfile(r);
- backc(r);
- if(c>=100) {
- c -= 100;
- salterc(r,c);
- sputc(r,1);
- } else
- salterc(r,c);
- for(;;){
- q = div(p,r);
- s = add(q,r);
- release(q);
- release(rem);
- q = div(s,sqtemp);
- release(s);
- release(rem);
- s = copy(r,length(r));
- chsign(s);
- t = add(s,q);
- release(s);
- fsfile(t);
- nn = sfbeg(t)?0:sbackc(t);
- if(nn>=0)
- break;
- release(r);
- release(t);
- r = q;
- }
- release(t);
- release(q);
- release(p);
- return(r);
- }
- Blk*
- dcexp(Blk *base, Blk *ex)
- {
- Blk *r, *e, *p, *e1, *t, *cp;
- int temp, c, n;
- r = salloc(1);
- sputc(r,1);
- p = copy(base,length(base));
- e = copy(ex,length(ex));
- fsfile(e);
- if(sfbeg(e) != 0)
- goto edone;
- temp=0;
- c = sbackc(e);
- if(c<0) {
- temp++;
- chsign(e);
- }
- while(length(e) != 0) {
- e1=div(e,sqtemp);
- release(e);
- e = e1;
- n = length(rem);
- release(rem);
- if(n != 0) {
- e1=mult(p,r);
- release(r);
- r = e1;
- }
- t = copy(p,length(p));
- cp = mult(p,t);
- release(p);
- release(t);
- p = cp;
- }
- if(temp != 0) {
- if((c = length(base)) == 0) {
- goto edone;
- }
- if(c>1)
- create(r);
- else {
- rewind(base);
- if((c = sgetc(base))<=1) {
- create(r);
- sputc(r,c);
- } else
- create(r);
- }
- }
- edone:
- release(p);
- release(e);
- return(r);
- }
- void
- init(int argc, char *argv[])
- {
- Sym *sp;
- Dir *d;
- ARGBEGIN {
- default:
- dbg = 1;
- break;
- } ARGEND
- ifile = 1;
- curfile = &bin;
- if(*argv){
- d = dirstat(*argv);
- if(d == nil) {
- fprint(2, "dc: can't open file %s\n", *argv);
- exits("open");
- }
- if(d->mode & DMDIR) {
- fprint(2, "dc: file %s is a directory\n", *argv);
- exits("open");
- }
- free(d);
- if((curfile = Bopen(*argv, OREAD)) == 0) {
- fprint(2,"dc: can't open file %s\n", *argv);
- exits("open");
- }
- }
- /* dummy = malloc(0); *//* prepare for garbage-collection */
- scalptr = salloc(1);
- sputc(scalptr,0);
- basptr = salloc(1);
- sputc(basptr,10);
- obase=10;
- logten=log2(10L);
- ll=70;
- fw=1;
- fw1=0;
- tenptr = salloc(1);
- sputc(tenptr,10);
- obase=10;
- inbas = salloc(1);
- sputc(inbas,10);
- sqtemp = salloc(1);
- sputc(sqtemp,2);
- chptr = salloc(0);
- strptr = salloc(0);
- divxyz = salloc(0);
- stkbeg = stkptr = &stack[0];
- stkend = &stack[STKSZ];
- stkerr = 0;
- readptr = &readstk[0];
- k=0;
- sp = sptr = &symlst[0];
- while(sptr < &symlst[TBLSZ-1]) {
- sptr->next = ++sp;
- sptr++;
- }
- sptr->next=0;
- sfree = &symlst[0];
- }
- void
- pushp(Blk *p)
- {
- if(stkptr == stkend) {
- Bprint(&bout,"out of stack space\n");
- return;
- }
- stkerr=0;
- *++stkptr = p;
- return;
- }
- Blk*
- pop(void)
- {
- if(stkptr == stack) {
- stkerr=1;
- return(0);
- }
- return(*stkptr--);
- }
- Blk*
- readin(void)
- {
- Blk *p, *q;
- int dp, dpct, c;
- dp = dpct=0;
- p = salloc(0);
- for(;;){
- c = readc();
- switch(c) {
- case '.':
- if(dp != 0)
- goto gotnum;
- dp++;
- continue;
- case '\\':
- readc();
- continue;
- default:
- if(c >= 'A' && c <= 'F')
- c = c - 'A' + 10;
- else
- if(c >= '0' && c <= '9')
- c -= '0';
- else
- goto gotnum;
- if(dp != 0) {
- if(dpct >= 99)
- continue;
- dpct++;
- }
- create(chptr);
- if(c != 0)
- sputc(chptr,c);
- q = mult(p,inbas);
- release(p);
- p = add(chptr,q);
- release(q);
- }
- }
- gotnum:
- unreadc(c);
- if(dp == 0) {
- sputc(p,0);
- return(p);
- } else {
- q = scale(p,dpct);
- return(q);
- }
- }
- /*
- * returns pointer to struct with ct 0's & p
- */
- Blk*
- add0(Blk *p, int ct)
- {
- Blk *q, *t;
- q = salloc(length(p)+(ct+1)/2);
- while(ct>1) {
- sputc(q,0);
- ct -= 2;
- }
- rewind(p);
- while(sfeof(p) == 0) {
- sputc(q,sgetc(p));
- }
- release(p);
- if(ct == 1) {
- t = mult(tenptr,q);
- release(q);
- return(t);
- }
- return(q);
- }
- Blk*
- mult(Blk *p, Blk *q)
- {
- Blk *mp, *mq, *mr;
- int sign, offset, carry;
- int cq, cp, mt, mcr;
- offset = sign = 0;
- fsfile(p);
- mp = p;
- if(sfbeg(p) == 0) {
- if(sbackc(p)<0) {
- mp = copy(p,length(p));
- chsign(mp);
- sign = ~sign;
- }
- }
- fsfile(q);
- mq = q;
- if(sfbeg(q) == 0){
- if(sbackc(q)<0) {
- mq = copy(q,length(q));
- chsign(mq);
- sign = ~sign;
- }
- }
- mr = salloc(length(mp)+length(mq));
- zero(mr);
- rewind(mq);
- while(sfeof(mq) == 0) {
- cq = sgetc(mq);
- rewind(mp);
- rewind(mr);
- mr->rd += offset;
- carry=0;
- while(sfeof(mp) == 0) {
- cp = sgetc(mp);
- mcr = sfeof(mr)?0:slookc(mr);
- mt = cp*cq + carry + mcr;
- carry = mt/100;
- salterc(mr,mt%100);
- }
- offset++;
- if(carry != 0) {
- mcr = sfeof(mr)?0:slookc(mr);
- salterc(mr,mcr+carry);
- }
- }
- if(sign < 0) {
- chsign(mr);
- }
- if(mp != p)
- release(mp);
- if(mq != q)
- release(mq);
- return(mr);
- }
- void
- chsign(Blk *p)
- {
- int carry;
- char ct;
- carry=0;
- rewind(p);
- while(sfeof(p) == 0) {
- ct=100-slookc(p)-carry;
- carry=1;
- if(ct>=100) {
- ct -= 100;
- carry=0;
- }
- salterc(p,ct);
- }
- if(carry != 0) {
- sputc(p,-1);
- fsfile(p);
- backc(p);
- ct = sbackc(p);
- if(ct == 99 /*&& !sfbeg(p)*/) {
- truncate(p);
- sputc(p,-1);
- }
- } else{
- fsfile(p);
- ct = sbackc(p);
- if(ct == 0)
- truncate(p);
- }
- return;
- }
- int
- readc(void)
- {
- loop:
- if((readptr != &readstk[0]) && (*readptr != 0)) {
- if(sfeof(*readptr) == 0)
- return(lastchar = sgetc(*readptr));
- release(*readptr);
- readptr--;
- goto loop;
- }
- lastchar = Bgetc(curfile);
- if(lastchar != -1)
- return(lastchar);
- if(readptr != &readptr[0]) {
- readptr--;
- if(*readptr == 0)
- curfile = &bin;
- goto loop;
- }
- if(curfile != &bin) {
- Bterm(curfile);
- curfile = &bin;
- goto loop;
- }
- exits(0);
- return 0; /* shut up ken */
- }
- void
- unreadc(char c)
- {
- if((readptr != &readstk[0]) && (*readptr != 0)) {
- sungetc(*readptr,c);
- } else
- Bungetc(curfile);
- return;
- }
- 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
- 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");
- }
- Blk*
- getdec(Blk *p, int sc)
- {
- int cc;
- Blk *q, *t, *s;
- rewind(p);
- if(length(p)*2 < sc) {
- q = copy(p,length(p));
- return(q);
- }
- q = salloc(length(p));
- while(sc >= 1) {
- sputc(q,sgetc(p));
- sc -= 2;
- }
- if(sc != 0) {
- t = mult(q,tenptr);
- s = salloc(cc = length(q));
- release(q);
- rewind(t);
- while(cc-- > 0)
- sputc(s,sgetc(t));
- sputc(s,0);
- release(t);
- t = div(s,tenptr);
- release(s);
- release(rem);
- return(t);
- }
- return(q);
- }
- void
- tenot(Blk *p, int sc)
- {
- int c, f;
- fsfile(p);
- f=0;
- while((sfbeg(p) == 0) && ((p->rd-p->beg-1)*2 >= sc)) {
- c = sbackc(p);
- if((c<10) && (f == 1))
- Bprint(&bout,"0%d",c);
- else
- Bprint(&bout,"%d",c);
- f=1;
- TEST2;
- }
- if(sc == 0) {
- Bprint(&bout,"\n");
- release(p);
- return;
- }
- if((p->rd-p->beg)*2 > sc) {
- c = sbackc(p);
- Bprint(&bout,"%d.",c/10);
- TEST2;
- OUTC(c%10 +'0');
- sc--;
- } else {
- OUTC('.');
- }
- while(sc>(p->rd-p->beg)*2) {
- OUTC('0');
- sc--;
- }
- while(sc > 1) {
- c = sbackc(p);
- if(c<10)
- Bprint(&bout,"0%d",c);
- else
- Bprint(&bout,"%d",c);
- sc -= 2;
- TEST2;
- }
- if(sc == 1) {
- OUTC(sbackc(p)/10 +'0');
- }
- Bprint(&bout,"\n");
- release(p);
- }
- void
- oneot(Blk *p, int sc, char ch)
- {
- Blk *q;
- q = removc(p,sc);
- create(strptr);
- sputc(strptr,-1);
- while(length(q)>0) {
- p = add(strptr,q);
- release(q);
- q = p;
- OUTC(ch);
- }
- release(q);
- Bprint(&bout,"\n");
- }
- void
- hexot(Blk *p, int flg)
- {
- int c;
- USED(flg);
- rewind(p);
- if(sfeof(p) != 0) {
- sputc(strptr,'0');
- release(p);
- return;
- }
- c = sgetc(p);
- release(p);
- if(c >= 16) {
- Bprint(&bout,"hex digit > 16");
- return;
- }
- sputc(strptr,c<10?c+'0':c-10+'a');
- }
- void
- bigot(Blk *p, int flg)
- {
- Blk *t, *q;
- int neg, l;
- if(flg == 1) {
- t = salloc(0);
- l = 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 = div(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) {
- sclobber(strptr);
- sputc(strptr,'-');
- }
- }
- sputc(strptr,' ');
- }
- Blk*
- add(Blk *a1, Blk *a2)
- {
- Blk *p;
- int carry, n, size, c, n1, n2;
- size = length(a1)>length(a2)?length(a1):length(a2);
- p = salloc(size);
- rewind(a1);
- rewind(a2);
- carry=0;
- while(--size >= 0) {
- n1 = sfeof(a1)?0:sgetc(a1);
- n2 = sfeof(a2)?0:sgetc(a2);
- n = n1 + n2 + carry;
- if(n>=100) {
- carry=1;
- n -= 100;
- } else
- if(n<0) {
- carry = -1;
- n += 100;
- } else
- carry = 0;
- sputc(p,n);
- }
- if(carry != 0)
- sputc(p,carry);
- fsfile(p);
- if(sfbeg(p) == 0) {
- c = 0;
- while(sfbeg(p) == 0 && (c = sbackc(p)) == 0)
- ;
- if(c != 0)
- salterc(p,c);
- truncate(p);
- }
- fsfile(p);
- if(sfbeg(p) == 0 && sbackc(p) == -1) {
- while((c = sbackc(p)) == 99) {
- if(c == -1)
- break;
- }
- skipc(p);
- salterc(p,-1);
- truncate(p);
- }
- return(p);
- }
- 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);
- }
- Blk*
- removc(Blk *p, int n)
- {
- Blk *q, *r;
- rewind(p);
- while(n>1) {
- skipc(p);
- n -= 2;
- }
- q = salloc(2);
- while(sfeof(p) == 0)
- sputc(q,sgetc(p));
- if(n == 1) {
- r = div(q,tenptr);
- release(q);
- release(rem);
- q = r;
- }
- release(p);
- return(q);
- }
- Blk*
- scalint(Blk *p)
- {
- int n;
- n = sunputc(p);
- p = removc(p,n);
- return(p);
- }
- Blk*
- scale(Blk *p, int n)
- {
- Blk *q, *s, *t;
- t = add0(p,n);
- q = salloc(1);
- sputc(q,n);
- s = dcexp(inbas,q);
- release(q);
- q = div(t,s);
- release(t);
- release(s);
- release(rem);
- sputc(q,n);
- return(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
- command(void)
- {
- char line[100], *sl;
- int pid, p, c;
- switch(c = readc()) {
- case '<':
- return(cond(NL));
- case '>':
- return(cond(NG));
- case '=':
- return(cond(NE));
- default:
- sl = line;
- *sl++ = c;
- while((c = readc()) != '\n')
- *sl++ = c;
- *sl = 0;
- if((pid = fork()) == 0) {
- execl("/bin/rc","rc","-c",line,nil);
- exits("shell");
- }
- for(;;) {
- if((p = waitpid()) < 0)
- break;
- if(p== pid)
- break;
- }
- Bprint(&bout,"!\n");
- return(0);
- }
- }
- int
- cond(char c)
- {
- Blk *p;
- int cc;
- if(subt() != 0)
- return(1);
- p = pop();
- sclobber(p);
- if(length(p) == 0) {
- release(p);
- if(c == '<' || c == '>' || c == NE) {
- getstk();
- return(0);
- }
- load();
- return(1);
- }
- if(c == '='){
- release(p);
- getstk();
- 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)) {
- getstk();
- return(0);
- }
- load();
- return(1);
- }
- 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
- log2(int32_t n)
- {
- int i;
- if(n == 0)
- return(0);
- i=31;
- if(n<0)
- return(i);
- while((n <<= 1) > 0)
- i--;
- return i-1;
- }
- Blk*
- salloc(int size)
- {
- Blk *hdr;
- char *ptr;
- all++;
- lall++;
- if(all - rel > active)
- active = all - rel;
- nbytes += size;
- lbytes += size;
- if(nbytes >maxsize)
- maxsize = nbytes;
- if(size > longest)
- longest = size;
- ptr = malloc((unsigned)size);
- if(ptr == 0){
- garbage("salloc");
- if((ptr = malloc((unsigned)size)) == 0)
- ospace("salloc");
- }
- if((hdr = hfree) == 0)
- hdr = morehd();
- hfree = (Blk *)hdr->rd;
- hdr->rd = hdr->wt = hdr->beg = ptr;
- hdr->last = ptr+size;
- return(hdr);
- }
- Blk*
- morehd(void)
- {
- Blk *h, *kk;
- headmor++;
- nbytes += HEADSZ;
- hfree = h = (Blk *)malloc(HEADSZ);
- if(hfree == 0) {
- garbage("morehd");
- if((hfree = h = (Blk*)malloc(HEADSZ)) == 0)
- ospace("headers");
- }
- kk = h;
- while(h<hfree+(HEADSZ/BLK))
- (h++)->rd = (char*)++kk;
- (h-1)->rd=0;
- return(hfree);
- }
- Blk*
- copy(Blk *hptr, int size)
- {
- Blk *hdr;
- unsigned sz;
- char *ptr;
- all++;
- lall++;
- lcopy++;
- nbytes += size;
- lbytes += size;
- if(size > longest)
- longest = size;
- if(size > maxsize)
- maxsize = size;
- sz = length(hptr);
- ptr = malloc(size);
- if(ptr == 0) {
- Bprint(&bout,"copy size %d\n",size);
- ospace("copy");
- }
- memmove(ptr, hptr->beg, sz);
- if (size-sz > 0)
- memset(ptr+sz, 0, size-sz);
- if((hdr = hfree) == 0)
- hdr = morehd();
- hfree = (Blk *)hdr->rd;
- hdr->rd = hdr->beg = ptr;
- hdr->last = ptr+size;
- hdr->wt = ptr+sz;
- ptr = hdr->wt;
- while(ptr<hdr->last)
- *ptr++ = '\0';
- return(hdr);
- }
- void
- sdump(char *s1, Blk *hptr)
- {
- char *p;
- if(hptr == nil) {
- Bprint(&bout, "%s no block\n", s1);
- return;
- }
- Bprint(&bout,"%s %lx rd %lx wt %lx beg %lx last %lx\n",
- s1,hptr,hptr->rd,hptr->wt,hptr->beg,hptr->last);
- p = hptr->beg;
- while(p < hptr->wt)
- Bprint(&bout,"%d ",*p++);
- Bprint(&bout,"\n");
- }
- void
- seekc(Blk *hptr, int n)
- {
- char *nn,*p;
- nn = hptr->beg+n;
- if(nn > hptr->last) {
- nbytes += nn - hptr->last;
- if(nbytes > maxsize)
- maxsize = nbytes;
- lbytes += nn - hptr->last;
- if(n > longest)
- longest = n;
- /* free(hptr->beg); */
- p = realloc(hptr->beg, n);
- if(p == 0) {
- /* hptr->beg = realloc(hptr->beg, hptr->last-hptr->beg);
- ** garbage("seekc");
- ** if((p = realloc(hptr->beg, n)) == 0)
- */ ospace("seekc");
- }
- hptr->beg = p;
- hptr->wt = hptr->last = hptr->rd = p+n;
- return;
- }
- hptr->rd = nn;
- if(nn>hptr->wt)
- hptr->wt = nn;
- }
- void
- salterwd(Blk *ahptr, Blk *n)
- {
- Wblk *hptr;
- hptr = (Wblk*)ahptr;
- if(hptr->rdw == hptr->lastw)
- more(ahptr);
- *hptr->rdw++ = n;
- if(hptr->rdw > hptr->wtw)
- hptr->wtw = hptr->rdw;
- }
- void
- more(Blk *hptr)
- {
- unsigned size;
- char *p;
- if((size=(hptr->last-hptr->beg)*2) == 0)
- size=2;
- nbytes += size/2;
- if(nbytes > maxsize)
- maxsize = nbytes;
- if(size > longest)
- longest = size;
- lbytes += size/2;
- lmore++;
- /* free(hptr->beg);*/
- p = realloc(hptr->beg, size);
- if(p == 0) {
- /* hptr->beg = realloc(hptr->beg, (hptr->last-hptr->beg));
- ** garbage("more");
- ** if((p = realloc(hptr->beg,size)) == 0)
- */ ospace("more");
- }
- hptr->rd = p + (hptr->rd - hptr->beg);
- hptr->wt = p + (hptr->wt - hptr->beg);
- hptr->beg = p;
- hptr->last = p+size;
- }
- void
- ospace(char *s)
- {
- Bprint(&bout,"out of space: %s\n",s);
- Bprint(&bout,"all %ld rel %ld headmor %ld\n",all,rel,headmor);
- Bprint(&bout,"nbytes %ld\n",nbytes);
- sdump("stk",*stkptr);
- abort();
- }
- void
- garbage(char *s)
- {
- USED(s);
- }
- void
- release(Blk *p)
- {
- rel++;
- lrel++;
- nbytes -= p->last - p->beg;
- p->rd = (char*)hfree;
- hfree = p;
- free(p->beg);
- }
- Blk*
- dcgetwd(Blk *p)
- {
- Wblk *wp;
- wp = (Wblk*)p;
- if(wp->rdw == wp->wtw)
- return(0);
- return(*wp->rdw++);
- }
- void
- putwd(Blk *p, Blk *c)
- {
- Wblk *wp;
- wp = (Wblk*)p;
- if(wp->wtw == wp->lastw)
- more(p);
- *wp->wtw++ = c;
- }
- Blk*
- lookwd(Blk *p)
- {
- Wblk *wp;
- wp = (Wblk*)p;
- if(wp->rdw == wp->wtw)
- return(0);
- return(*wp->rdw);
- }
- int
- getstk(void)
- {
- int n;
- uint8_t c;
- c = readc();
- if(c != '<')
- return c;
- n = 0;
- while(1) {
- c = readc();
- if(c == '>')
- break;
- n = n*10+c-'0';
- }
- return n;
- }
|