home *** CD-ROM | disk | FTP | other *** search
- /*********************************************************/
- /* */
- /* PISTOL-Portably Implemented Stack Oriented Language */
- /* Version 1.3 */
- /* (C) 1982 by Ernest E. Bergmann */
- /* Physics, Building #16 */
- /* Lehigh Univerisity */
- /* Bethlehem, Pa. 18015 */
- /* */
- /* Permission is hereby granted for all reproduction and */
- /* distribution of this material provided this notice is */
- /* is included. */
- /* */
- /*********************************************************/
-
- /* sixth and final module in BDS 'C', February, 1982 */
-
- #include "bdscio.h"
- #include "pistol.h"
-
- synterr()
- {ram[-14].in=TRU;if(ram[-24].in)carret();
- if((ram[-11].in) && (ram[-13].in==FALS))
- message(&strings[LINEBUF]);
- merr(synt);
- }
-
- pushck(chkch)
- char chkch;
- { if(CHKLMT>(++strings[1])) strings[1+strings[1]]=chkch;
- else{ram[-14].in=TRU; message(ovflo); synterr();}
- }
-
- aloop()
- {if(lstack[lptr]<lstack[lptr-1]){Pw=ip;ip += *Pw; }
- else{lptr -=3; if(lptr<0) merr(undflo); ip +=W ; }
- }
-
- pdo()
- {drop(); drop();
- if(stack[stkptr+2]<stack[stkptr+1])
- {lpush(stack[stkptr+2]);
- lpush(stack[stkptr+1]);
- lpush(stack[stkptr+2]); ip += W;
- }
- else{ Pw=ip; ip += *Pw; }
- }
-
- dropck()
- {if(strings[1]) strings[1]--; else synterr(); }
-
- geoln() /* Feb 17 */
- { while(*ram[-15].pc != NEWLINE) ram[-15].pc++;
- }
-
- move(as,ad,nowd)
- int as,ad,nowd;
- {int endaddr;
- endaddr=as+nowd; Pw=as; Pw2=ad;
- while(Pw <= endaddr)
- { *Pw2=*Pw ; Pw++; Pw2++;}
- }
-
- swap() /* Feb 17 */
- {Pc=stack[stkptr];stack[stkptr]=stack[stkptr-1];
- stack[stkptr-1]=Pc;
- }
-
- permstrings()
- { if(ram[-5].pc<ram[-4].pc) ram[-5].pc=ram[-4].pc;
- }
-
- enter() /* Feb 17 eliminate Pw */
- {drop();temp=find(stack[stkptr+1]);
- if(temp){message(redef);spaces(3);
- message(stack[stkptr+1]);carret();
- }append(0);
- append((*ram[-6].pw).in);
- append(stack[stkptr+1]);
- append(COMPHERE);
- (*ram[-6].pw).in=ram[-3].in;
- }
-
- fenter(i) /* Feb 17, shortened */
- int i;
- { Pw = (*ram[-6].pw).pw - 4 ; *Pw = i ; }
-
- getline()
- {if(!ram[-11].in)
- {/* input from console*/
- cinline();
- }
- else
- {/*input from file*/
- finline(ldfil1,&Pc); /*Pc can get*/
- } /*clobbered if eof*/
- if(ram[-13].in&&ram[-11].in) message(&strings[LINEBUF]);
- }
-
- lpush(item)
- int item;
- {if(LSIZE<= ++lptr) merr(ovflo); lstack[lptr]=item;}
-
- cpush(item)
- int item;
- {if(CSIZE<= ++cptr) merr(ovflo); cstack[cptr]=item; }
-
- touchup()
- {int val;
- Pw=val=stack[stkptr];drop();*Pw=ram[-2].in-val; }
-
- fwdref()
- { push(ram[-2].in); compile(0); }
-
- compile(address) /* Feb 17 */
- int address;
- { if(ram[-2].pw >= &ram[RAMSIZE-2]) merr(ovflo);
- Pw=ram[-2].pw++ ; *Pw=address;
- }
-
-
-
- /* addstring - convenience for initialization phase to emplace
- string and update ram[-4]
- */
- char *addstring(length,string)
- int length;
- char *string;
- {
- int i;
- char *start;
- start=ram[-4].pc++;
- movmem(string,ram[-4].pc,length);
- ram[-4].pc += length;
- permstrings();
- *start=length;
- return(start);
- }
-
- append(item) /* place item at end of dictionary */
- int item; /* doesn't check for overflow yet, Feb 17 */
- {
- (*ram[-3].pw).in=item;
- ram[-3].pw++;
- }
-
- penter(length, name, opcode) /* Feb 17 */
- int length,opcode;
- char *name;
- {
- Pc=addstring(length,name);
- append(0);
- append((*ram[-6].pw).in);
- append(Pc);
- if(opcode<0)
- {append(-opcode);append(PSEMICOLON);}
- else
- {append(COMPME);append(opcode);}
- (*ram[-6].pw).pw = ram[-3].pw - 1 ;
- fenter(ram[-3].in);
- }
-
- carret() /* outputs the CR-LF sequence*/
- { if(ram[-14].in)
- { if(ram[-21].in == ++ram[-22].in)
- {ram[-22].in=0;
- cinline(); Pc =ram[-15].pc;
- if('Q' == toupper(*Pc)) abort();
- }
- ram[-24].in=0;
- printf("\n");
- }
- if(ram[-12].in) fprintf(list,"\n");
- }
-
- merr(m)
- char *m;
- { ram[-14].in=TRU;
- if(ram[-24].in) carret();
- message(m);
- abort();
- }
-
- message(st)
- char *st;
- {char *last;
- char len;
- len=*st;
- last=st + *st;
- while(st < last){st++; chout(*st);}
- }
-
- drop()
- { if(stkptr<1)merr(undflo);
- else stkptr--;
- }
-
- push(item)
- int item;
- { if(++stkptr >= SSIZE) merr(ovflo);
- stack[stkptr]=item;
- }
-
- rpush(item)
- int item;
- { if(++rptr >= RSIZE) merr(ovflo);
- rstack[rptr]=item;
- }
-
- chout(ch)
- char ch;
- { if(ch == 13) carret();
- else if(ch == 9) tab();
- else{if(ram[-24].in==ram[-23].in)carret();
- ram[-24].in++;
- if(ram[-14].in)putc(ch,1);
- if(ram[-12].in)putc(ch,list);
- }
- }
-
- tab()
- { if(ram[-27].in>0)
- spaces(ram[-27].in-ram[-24].in%ram[-27].in);
- }
-
- spaces(num)
- int num;
- { while(num>0){chout(' ');num--;}
- }
-
- cinline() /*input line from console*/
- { ram[-15].pc=&strings[LINEBUF+1];
- ram[-16].in=1+strlen(gets(&strings[LINEBUF+1]));
- Pc=&strings[LINEBUF];
- *Pc=ram[-16].in;
- Pc += ram[-16].in;
- *Pc=NEWLINE; Pc++ ;
- *Pc=10 ; Pc++ ;
- *Pc = 0;
- if(ram[-12].in)fputs(ram[-15].pc,list);
- }
-
- finline(iobuf,iostat)
- char *iobuf;
- int *iostat; /*not used anymore ???*/
- { ram[-15].pc=fgets(&strings[LINEBUF+1],iobuf);
- if(!ram[-15].in) merr(feof);
- ram[-16].in=strlen(ram[-15].pc);
- Pc=&strings[LINEBUF];
- *Pc=ram[-16].in;
- Pc += ram[-16].in;
- *Pc=NEWLINE; Pc++ ;
- *Pc=10; Pc++ ;
- *Pc=0 ;
- }
-
- eof(iobuf) /* used to test for eof status on */
- char *iobuf; /* buffered i/o in analogy to PASCAL*/
- {int c;
- c=getc(iobuf);
- if((c == ERROR) || (c== CPMEOF)) return(TRU);
- ungetc(c,iobuf);
- return(FALS);
- }
-
-