home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol059 / pistb.c < prev    next >
Encoding:
C/C++ Source or Header  |  1984-04-29  |  7.3 KB  |  356 lines
  1. /*********************************************************/
  2. /*                             */
  3. /* PISTOL-Portably Implemented Stack Oriented Language     */
  4. /*            Version 1.3             */
  5. /* (C) 1982 by    Ernest E. Bergmann             */
  6. /*        Physics, Building #16             */
  7. /*        Lehigh Univerisity             */
  8. /*        Bethlehem, Pa. 18015             */
  9. /*                             */
  10. /* Permission is hereby granted for all reproduction and */
  11. /* distribution of this material provided this notice is */
  12. /* is included.                         */
  13. /*                             */
  14. /*********************************************************/
  15.  
  16. /* second pistol module, February, 1982 */
  17.  
  18. #include "bdscio.h"
  19. #include "pistol.h"
  20.  
  21. init()
  22. {int psemcol(),wstore(),times(),plus(),subtract(),
  23.     divmod(),pif(),wat(),abort(),sp(),
  24.     load(),pelse(),wrd(),rp(),drop(),
  25.     puser(),exec(),exitop(),lit(),rpop(),
  26.     swap(),tyi(),tyo(),rpsh(),semicf(),
  27.     rat(),compme(),comphere(),dollarc(),colon(),
  28.     semcol(),ifop(),elseop(),thenop(),doop(),
  29.     loopop(),beginop(),endop(),repet(),geoln(),pdollar(),
  30.     pcolon(),casat(),pdo(),pploop(),plloop(),
  31.     cat(),cstore(),ploop(),gt(),semidol(),
  32.     kernq(),strange(),sat(),findop(),listfil(),
  33.     lat(),ofcas(),ccolon(),semicc(),ndcas(),
  34.     pofcas(),pccol(),psemicc(),getline(),intoken(),
  35.     openr(),openw(),readl(),writl(),cordmp(),
  36.     restor();
  37.  
  38.     farray[PSEMICOL]=psemcol;
  39.     farray[WSTORE]=wstore;
  40.     farray[TIMES]=times;
  41.     farray[PLUS]=plus;
  42.     farray[SUBTRACT]=subtract;
  43.     farray[DIVMOD]=divmod;
  44.     farray[PIF]=pif;
  45.     farray[WAT]=wat;
  46.     farray[ABRT]=abort;
  47.     farray[SP]=sp;
  48.     farray[LOAD]=load;
  49.     farray[PELSE]=pelse;
  50.     farray[WRD]=wrd;
  51.     farray[RP]=rp;
  52.     farray[DROPOP]=drop;
  53.     farray[PUSER]=puser;
  54.     farray[EXEC]=exec;
  55.     farray[EXITOP]=exitop;
  56.     farray[STRLIT]=farray[LIT]=lit;
  57.     farray[RPOP]=rpop;
  58.     farray[SWP]=swap;
  59.     farray[TYI]=tyi;
  60.     farray[TYO]=tyo;
  61.     farray[RPSH]=rpsh;
  62.     farray[SEMICF]=semicf;
  63.     farray[RAT]=rat;
  64.     farray[COMPME]=compme;
  65.     farray[COMPHERE]=comphere;
  66.     farray[DOLLARC]=dollarc;
  67.     farray[COLON]=colon;
  68.     farray[SEMICOLON]=semcol;
  69.     farray[IFOP]=ifop;
  70.     farray[ELSEOP]=elseop;
  71.     farray[THENOP]=thenop;
  72.     farray[DOOP]=doop;
  73.     farray[LOOPOP]=loopop;
  74.     farray[BEGINOP]=beginop;
  75.     farray[ENDOP]=endop;
  76.     farray[REPET]=repet;
  77.     farray[PERCENT]=geoln;
  78.     farray[PDOLLAR]=pdollar;
  79.     farray[PCOLON]=pcolon;
  80.     farray[CASAT]=casat;
  81.     farray[PDOOP]=pdo;
  82.     farray[PPLOOP]=pploop;
  83.     farray[PLLOOP]=plloop;
  84.     farray[CAT]=cat;
  85.     farray[CSTORE]=cstore;
  86.     farray[PLOOP]=ploop;
  87.     farray[GT]=gt;
  88.     farray[SEMIDOL]=semidol;
  89.     farray[KRNQ]=kernq;
  90.     farray[53]=farray[54]=strange;
  91.     farray[SAT]=sat;
  92.     farray[FINDOP]=findop;
  93.     farray[LISTFIL]=listfil;
  94.     farray[58]=strange;
  95.     farray[LAT]=lat;
  96.     farray[OFCAS]=ofcas;
  97.     farray[CCOLON]=ccolon;
  98.     farray[SEMICC]=semicc;
  99.     farray[NDCAS]=ndcas;
  100.     farray[POFCAS]=pofcas;
  101.     farray[PCCOL]=pccol;
  102.     farray[PSEMICC]=psemicc;
  103.     farray[GTLIN]=getline;
  104.     farray[WORD]=intoken();
  105.     farray[OPENR]=openr;
  106.     farray[OPENW]=openw;
  107.     farray[READL]=readl;
  108.     farray[WRITL]=writl;
  109.     farray[CORDMP]=cordmp;
  110.     farray[RESTOR]=restor;
  111.  
  112.     penter(2,"W!",WSTORE);
  113.     penter(1,"*",TIMES);
  114.     penter(1,"+",PLUS);
  115.     penter(1,"-",SUBTRACT);
  116.     penter(4,"/MOD",DIVMOD);
  117.     penter(2,"W@",WAT);
  118.     penter(5,"ABORT",ABRT);
  119.     penter(2,"SP",SP);
  120.     penter(4,"LOAD",LOAD);
  121.     penter(1,"W",WRD);
  122.     penter(2,"RP",RP);
  123.     penter(4,"DROP",DROPOP);
  124.     penter(4,"USER",PUSER);
  125.     penter(4,"EXEC",EXEC);
  126.     penter(4,"EXIT",EXITOP);
  127.     penter(2,"R>",RPOP);
  128.     penter(4,"SWAP",SWP);
  129.     penter(3,"TYI",TYI);
  130.     penter(3,"TYO",TYO);
  131.     penter(2,"<R",RPSH);
  132.     penter(2,";F",SEMICF);
  133.     penter(2,"R@",RAT);
  134.     penter(2,"$:",-DOLLARC);
  135.     penter(1,":",-COLON);
  136.     penter(1,";",-SEMICOLON);
  137.     penter(2,"IF",-IFOP);
  138.     penter(4,"ELSE",-ELSEOP);
  139.     penter(4,"THEN",-THENOP);
  140.     penter(2,"DO",-DOOP);
  141.     penter(4,"LOOP",-LOOPOP);
  142.     penter(5,"BEGIN",-BEGINOP);
  143.     penter(3,"END",-ENDOP);
  144.     penter(6,"REPEAT",-REPET);
  145.     penter(1,"%",-PERCENT);
  146.     penter(5,"CASE@",CASAT);
  147.     penter(5,"+LOOP",-PLLOOP);
  148.     penter(2,"C@",CAT);
  149.     penter(2,"C!",CSTORE);
  150.     penter(2,"GT",GT);
  151.     penter(2,";$",-SEMIDOL);
  152.     penter(7,"KERNEL?",KRNQ);
  153.     penter(2,"S@",SAT);
  154.     penter(4,"FIND",FINDOP);
  155.     penter(8,"LISTFILE",LISTFIL);
  156.     penter(2,"L@",LAT);
  157.     penter(6,"OFCASE",-OFCAS);
  158.     penter(2,"C:",-CCOLON);
  159.     penter(2,";C",-SEMICC);
  160.     penter(7,"ENDCASE",-NDCAS);
  161.     penter(4,"(;C)",PSEMICC);
  162.     penter(7,"GETLINE",GTLIN);
  163.     penter(4,"WORD",WORD);
  164.     penter(5,"OPENR",OPENR);
  165.     penter(5,"OPENW",OPENW);
  166.     penter(8,"READLINE",READL);
  167.     penter(9,"WRITELINE",WRITL);
  168.     penter(8,"COREDUMP",CORDMP);
  169.     penter(7,"RESTORE",RESTOR);
  170. }
  171.  
  172.  
  173. tyi()    /* inputs a character from the keyboard,buffered line*/
  174. {    if(*ram[-15].pc == NEWLINE) cinline();
  175.     else nextch();
  176.     push(*ram[-15].pc);
  177. }
  178.  
  179. psemcol()
  180. { ip=rstack[rptr--]; 
  181. }
  182.  
  183. wstore()
  184. {    drop(); drop(); Pw=stack[2+stkptr];
  185.             *Pw=stack[1+stkptr];
  186. }
  187.  
  188. times()
  189. {    drop(); stack[stkptr] *= stack[1+stkptr];
  190. }
  191.  
  192. plus()
  193. {    drop(); stack[stkptr] += stack[1+stkptr];
  194. }
  195.  
  196. subtract()
  197. {    drop();stack[stkptr] -= stack[1+stkptr];
  198. }
  199.  
  200. divmod()
  201. {    if(stack[stkptr])
  202.         {stack[1+stkptr]=
  203.             stack[stkptr-1]/stack[stkptr];
  204.         stack[stkptr]=
  205.             stack[-1+stkptr]%stack[stkptr];
  206.         stack[stkptr-1]=stack[stkptr+1];
  207.         }
  208.     else merr(divby0);
  209. }
  210.  
  211. pif()
  212. {    drop();
  213.     if(stack[1+stkptr]) ip+=W;
  214.     else{Pw=ip;ip+=*Pw;}
  215. }
  216.  
  217. wat()
  218. { Pw=stack[stkptr]; stack[stkptr]=*Pw;
  219. }
  220.  
  221. sp()
  222. { push(stkptr); }
  223.  
  224. load()
  225. {    drop();
  226.     ram[-11].in=stack[stkptr+1];
  227.     if(ram[-11].in>MAXLINNO)
  228.         {movmem(ram[-11].pc+1,infil1,
  229.                 *ram[-11].pc);
  230.         infil1[*ram[-11].pc]='\0';
  231.         if(fopen(infil1,ldfil1) == ERROR)
  232.             {printf("can't open %s\n",
  233.                 infil1);
  234.             abort();
  235.             }
  236.         ram[-29].in=0;
  237.         }
  238. }
  239.  
  240. pelse()
  241. { Pw=ip; ip += *Pw;}
  242.  
  243. wrd()
  244. { push(W); }
  245.  
  246. rp()
  247. { push(rptr); }
  248.  
  249. puser()
  250. { push(ram); }
  251.  
  252. exec()
  253. {    instr=stack[stkptr]; drop();
  254.     if(instr<(RESTOR+1)) (*farray[instr])();
  255.     else {rpush(ip);ip=instr;}
  256. }
  257.  
  258. exitop()
  259. {    if(lptr<3) abort();
  260.     else lstack[lptr]=lstack[lptr-1];
  261. }
  262.  
  263. lit()
  264. { Pw=ip; push(*Pw); ip +=W; }
  265.  
  266. rpop()
  267. { push(rstack[rptr]);rptr--; }
  268.  
  269. tyo()
  270. { drop(); chout(stack[stkptr+1]); }
  271.  
  272. rpsh()
  273. { rpush(stack[stkptr]);drop(); }
  274.  
  275. semicf()
  276. {    if(ram[-24].in) carret();
  277.     if((ram[-11].in<MAXLINNO)&&(ram[-11].in>0))
  278.         {ram[-11].in--;
  279.         printf("\n THROUGH LINE %d(DECIMAL) LOADED\n",
  280.             ram[-11].in);
  281.         if(ram[-12].in)
  282.         fprintf(list,
  283.             "\n THROUGH LINE %d(DECIMAL) LOADED\n",
  284.             ram[-11].in);
  285.         }
  286.     if(ram[-11].in>=MAXLINNO)
  287.         {printf("%s LOADED\n",infil1);
  288.         if(ram[-12].in)
  289.             fprintf(list,"%s LOADED\n",infil1);
  290.         }
  291.     ram[-11].in=0;
  292. }
  293.  
  294. rat()
  295. {    drop();
  296.     if(rptr<stack[1+stkptr])merr(undflo);
  297.     push(rstack[rptr-stack[stkptr+1]]);
  298. }
  299.  
  300. compme()
  301. {    Pw2=ip;Pw2 -= 4; j=*Pw2; Pw2=ip;
  302.     while(Pw2<j)    {compile(*Pw2);Pw2++;}
  303.     ip=rstack[rptr--];
  304. }
  305.  
  306. comphere()
  307. {    compile(ip);
  308.     ip=rstack[rptr--];
  309. }
  310.  
  311. dollarc()
  312. {    pushck('$');compile(PDOLLAR);
  313.     fwdref();
  314. }
  315.  
  316. colon()
  317. {    pushck(':'); compile(PCOLON);
  318.     fwdref();
  319. }
  320.  
  321. semcol()
  322. {    if(strings[1+strings[1]]==':')
  323.         {dropck();compile(PSEMICOLON);touchup();}
  324.     else synterr();
  325. }
  326.  
  327. ifop()
  328. { pushck('F');compile(PIF);fwdref(); }
  329.  
  330. elseop()
  331. {    if(strings[1+strings[1]]=='F')
  332.         {strings[1+strings[1]]='E';
  333.         compile(PELSE);fwdref();
  334.         swap();touchup();
  335.         }
  336.     else synterr(); 
  337. }
  338.  
  339. thenop()
  340. {    Pc= &strings[1]; Pc += *Pc;
  341.     if((*Pc=='F')||(*Pc=='E'))
  342.         {dropck();touchup();}
  343.     else synterr(); 
  344. }
  345.  
  346. doop()
  347. { pushck('D');compile(PDOOP);fwdref(); }
  348.  
  349. loopop()
  350. {    if(strings[1+strings[1]]=='D')
  351.         {dropck(); compile(PLOOP);
  352.         compile(stack[stkptr]-ram[-2].in+W);
  353.         touchup();
  354.         }
  355.     else synterr();
  356. }