/*********************************************************/
/*                                                       */
/* 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.                                          */
/*                                                       */
/*********************************************************/

/* second pistol module, February, 1982 */

#include "bdscio.h"
#include "pistol.h"

init()
{int psemcol(),wstore(),times(),plus(),subtract(),
       divmod(),pif(),wat(),abort(),sp(),
       load(),pelse(),wrd(),rp(),drop(),
       puser(),exec(),exitop(),lit(),rpop(),
       swap(),tyi(),tyo(),rpsh(),semicf(),
       rat(),compme(),comphere(),dollarc(),colon(),
       semcol(),ifop(),elseop(),thenop(),doop(),
       loopop(),beginop(),endop(),repet(),geoln(),pdollar(),
       pcolon(),casat(),pdo(),pploop(),plloop(),
       cat(),cstore(),ploop(),gt(),semidol(),
       kernq(),strange(),sat(),findop(),listfil(),
       lat(),ofcas(),ccolon(),semicc(),ndcas(),
       pofcas(),pccol(),psemicc(),getline(),intoken(),
       openr(),openw(),readl(),writl(),cordmp(),
       restor();

       farray[PSEMICOL]=psemcol;
       farray[WSTORE]=wstore;
       farray[TIMES]=times;
       farray[PLUS]=plus;
       farray[SUBTRACT]=subtract;
       farray[DIVMOD]=divmod;
       farray[PIF]=pif;
       farray[WAT]=wat;
       farray[ABRT]=abort;
       farray[SP]=sp;
       farray[LOAD]=load;
       farray[PELSE]=pelse;
       farray[WRD]=wrd;
       farray[RP]=rp;
       farray[DROPOP]=drop;
       farray[PUSER]=puser;
       farray[EXEC]=exec;
       farray[EXITOP]=exitop;
       farray[STRLIT]=farray[LIT]=lit;
       farray[RPOP]=rpop;
       farray[SWP]=swap;
       farray[TYI]=tyi;
       farray[TYO]=tyo;
       farray[RPSH]=rpsh;
       farray[SEMICF]=semicf;
       farray[RAT]=rat;
       farray[COMPME]=compme;
       farray[COMPHERE]=comphere;
       farray[DOLLARC]=dollarc;
       farray[COLON]=colon;
       farray[SEMICOLON]=semcol;
       farray[IFOP]=ifop;
       farray[ELSEOP]=elseop;
       farray[THENOP]=thenop;
       farray[DOOP]=doop;
       farray[LOOPOP]=loopop;
       farray[BEGINOP]=beginop;
       farray[ENDOP]=endop;
       farray[REPET]=repet;
       farray[PERCENT]=geoln;
       farray[PDOLLAR]=pdollar;
       farray[PCOLON]=pcolon;
       farray[CASAT]=casat;
       farray[PDOOP]=pdo;
       farray[PPLOOP]=pploop;
       farray[PLLOOP]=plloop;
       farray[CAT]=cat;
       farray[CSTORE]=cstore;
       farray[PLOOP]=ploop;
       farray[GT]=gt;
       farray[SEMIDOL]=semidol;
       farray[KRNQ]=kernq;
       farray[53]=farray[54]=strange;
       farray[SAT]=sat;
       farray[FINDOP]=findop;
       farray[LISTFIL]=listfil;
       farray[58]=strange;
       farray[LAT]=lat;
       farray[OFCAS]=ofcas;
       farray[CCOLON]=ccolon;
       farray[SEMICC]=semicc;
       farray[NDCAS]=ndcas;
       farray[POFCAS]=pofcas;
       farray[PCCOL]=pccol;
       farray[PSEMICC]=psemicc;
       farray[GTLIN]=getline;
       farray[WORD]=intoken();
       farray[OPENR]=openr;
       farray[OPENW]=openw;
       farray[READL]=readl;
       farray[WRITL]=writl;
       farray[CORDMP]=cordmp;
       farray[RESTOR]=restor;

       penter(2,"W!",WSTORE);
       penter(1,"*",TIMES);
       penter(1,"+",PLUS);
       penter(1,"-",SUBTRACT);
       penter(4,"/MOD",DIVMOD);
       penter(2,"W@",WAT);
       penter(5,"ABORT",ABRT);
       penter(2,"SP",SP);
       penter(4,"LOAD",LOAD);
       penter(1,"W",WRD);
       penter(2,"RP",RP);
       penter(4,"DROP",DROPOP);
       penter(4,"USER",PUSER);
       penter(4,"EXEC",EXEC);
       penter(4,"EXIT",EXITOP);
       penter(2,"R>",RPOP);
       penter(4,"SWAP",SWP);
       penter(3,"TYI",TYI);
       penter(3,"TYO",TYO);
       penter(2,"<R",RPSH);
       penter(2,";F",SEMICF);
       penter(2,"R@",RAT);
       penter(2,"$:",-DOLLARC);
       penter(1,":",-COLON);
       penter(1,";",-SEMICOLON);
       penter(2,"IF",-IFOP);
       penter(4,"ELSE",-ELSEOP);
       penter(4,"THEN",-THENOP);
       penter(2,"DO",-DOOP);
       penter(4,"LOOP",-LOOPOP);
       penter(5,"BEGIN",-BEGINOP);
       penter(3,"END",-ENDOP);
       penter(6,"REPEAT",-REPET);
       penter(1,"%",-PERCENT);
       penter(5,"CASE@",CASAT);
       penter(5,"+LOOP",-PLLOOP);
       penter(2,"C@",CAT);
       penter(2,"C!",CSTORE);
       penter(2,"GT",GT);
       penter(2,";$",-SEMIDOL);
       penter(7,"KERNEL?",KRNQ);
       penter(2,"S@",SAT);
       penter(4,"FIND",FINDOP);
       penter(8,"LISTFILE",LISTFIL);
       penter(2,"L@",LAT);
       penter(6,"OFCASE",-OFCAS);
       penter(2,"C:",-CCOLON);
       penter(2,";C",-SEMICC);
       penter(7,"ENDCASE",-NDCAS);
       penter(4,"(;C)",PSEMICC);
       penter(7,"GETLINE",GTLIN);
       penter(4,"WORD",WORD);
       penter(5,"OPENR",OPENR);
       penter(5,"OPENW",OPENW);
       penter(8,"READLINE",READL);
       penter(9,"WRITELINE",WRITL);
       penter(8,"COREDUMP",CORDMP);
       penter(7,"RESTORE",RESTOR);
}


tyi()   /* inputs a character from the keyboard,buffered line*/
{       if(*ram[-15].pc == NEWLINE) cinline();
       else nextch();
       push(*ram[-15].pc);
}

psemcol()
{ ip=rstack[rptr--];
}

wstore()
{       drop(); drop(); Pw=stack[2+stkptr];
                       *Pw=stack[1+stkptr];
}

times()
{       drop(); stack[stkptr] *= stack[1+stkptr];
}

plus()
{       drop(); stack[stkptr] += stack[1+stkptr];
}

subtract()
{       drop();stack[stkptr] -= stack[1+stkptr];
}

divmod()
{       if(stack[stkptr])
               {stack[1+stkptr]=
                       stack[stkptr-1]/stack[stkptr];
               stack[stkptr]=
                       stack[-1+stkptr]%stack[stkptr];
               stack[stkptr-1]=stack[stkptr+1];
               }
       else merr(divby0);
}

pif()
{       drop();
       if(stack[1+stkptr]) ip+=W;
       else{Pw=ip;ip+=*Pw;}
}

wat()
{ Pw=stack[stkptr]; stack[stkptr]=*Pw;
}

sp()
{ push(stkptr); }

load()
{       drop();
       ram[-11].in=stack[stkptr+1];
       if(ram[-11].in>MAXLINNO)
               {movmem(ram[-11].pc+1,infil1,
                               *ram[-11].pc);
               infil1[*ram[-11].pc]='\0';
               if(fopen(infil1,ldfil1) == ERROR)
                       {printf("can't open %s\n",
                               infil1);
                       abort();
                       }
               ram[-29].in=0;
               }
}

pelse()
{ Pw=ip; ip += *Pw;}

wrd()
{ push(W); }

rp()
{ push(rptr); }

puser()
{ push(ram); }

exec()
{       instr=stack[stkptr]; drop();
       if(instr<(RESTOR+1)) (*farray[instr])();
       else {rpush(ip);ip=instr;}
}

exitop()
{       if(lptr<3) abort();
       else lstack[lptr]=lstack[lptr-1];
}

lit()
{ Pw=ip; push(*Pw); ip +=W; }

rpop()
{ push(rstack[rptr]);rptr--; }

tyo()
{ drop(); chout(stack[stkptr+1]); }

rpsh()
{ rpush(stack[stkptr]);drop(); }

semicf()
{       if(ram[-24].in) carret();
       if((ram[-11].in<MAXLINNO)&&(ram[-11].in>0))
               {ram[-11].in--;
               printf("\n THROUGH LINE %d(DECIMAL) LOADED\n",
                       ram[-11].in);
               if(ram[-12].in)
               fprintf(list,
                       "\n THROUGH LINE %d(DECIMAL) LOADED\n",
                       ram[-11].in);
               }
       if(ram[-11].in>=MAXLINNO)
               {printf("%s LOADED\n",infil1);
               if(ram[-12].in)
                       fprintf(list,"%s LOADED\n",infil1);
               }
       ram[-11].in=0;
}

rat()
{       drop();
       if(rptr<stack[1+stkptr])merr(undflo);
       push(rstack[rptr-stack[stkptr+1]]);
}

compme()
{       Pw2=ip;Pw2 -= 4; j=*Pw2; Pw2=ip;
       while(Pw2<j)    {compile(*Pw2);Pw2++;}
       ip=rstack[rptr--];
}

comphere()
{       compile(ip);
       ip=rstack[rptr--];
}

dollarc()
{       pushck('$');compile(PDOLLAR);
       fwdref();
}

colon()
{       pushck(':'); compile(PCOLON);
       fwdref();
}

semcol()
{       if(strings[1+strings[1]]==':')
               {dropck();compile(PSEMICOLON);touchup();}
       else synterr();
}

ifop()
{ pushck('F');compile(PIF);fwdref(); }

elseop()
{       if(strings[1+strings[1]]=='F')
               {strings[1+strings[1]]='E';
               compile(PELSE);fwdref();
               swap();touchup();
               }
       else synterr();
}

thenop()
{       Pc= &strings[1]; Pc += *Pc;
       if((*Pc=='F')||(*Pc=='E'))
               {dropck();touchup();}
       else synterr();
}

doop()
{ pushck('D');compile(PDOOP);fwdref(); }

loopop()
{       if(strings[1+strings[1]]=='D')
               {dropck(); compile(PLOOP);
               compile(stack[stkptr]-ram[-2].in+W);
               touchup();
               }
       else synterr();
}

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.