home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume2 / basic / part3 / bs2 / operat.c < prev   
Encoding:
C/C++ Source or Header  |  1986-11-30  |  8.9 KB  |  410 lines
  1. /* operat.c -- operations, as opposed to actions.  FOR is an action,
  2.  *    '+' is an operation.
  3.  *
  4.  * More operators can be found in the machine generated file "operat2.c".
  5.  */
  6.  
  7. #include "bsdefs.h"
  8.  
  9.  
  10. /*    BINARY OPERATORS    */
  11.  
  12. /* Common description for the binary ops.
  13.  *  also applies to all ops in operat2.c
  14.  *
  15.  * M_COMPILE:
  16.  *    x op x   --to--   x,_op,x
  17.  * M_EXECUTE:
  18.  *    stack: ar2,ar1,x   --to--   (ar1 op ar2),x
  19.  */
  20.  
  21.  
  22. _comma(l,p) int (*l[])(),p;
  23. {
  24.     union value s1,s2,s3;
  25.     switch(status&XMODE) {
  26.     case M_COMPILE:
  27.     case M_FIXUP: return(p);
  28.     case M_READ: dtype = T_CHR;
  29.     case M_EXECUTE:
  30.         s1 = pop();
  31.         s2 = pop();
  32.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+3);
  33.         strcpy(s3.sval,s2.sval);
  34.         strcat(s3.sval,"\t");
  35.         strcat(s3.sval,s1.sval);
  36.         if(s1.sval != 0) free(s1.sval);
  37.         if(s2.sval != 0) free(s2.sval);
  38.         push(s3);
  39.         return(p);
  40.     default: STerror("comma");
  41.     }
  42. }
  43. _scolon(l,p) int(*l[])(),p;
  44. {
  45.     union value s1,s2,s3;
  46.     switch(status&XMODE) {
  47.     case M_COMPILE:
  48.     case M_FIXUP: return(p);
  49.     case M_READ: dtype = T_CHR;
  50.     case M_EXECUTE:
  51.         s1 = pop();
  52.         s2 = pop();
  53.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+2);
  54.         strcpy(s3.sval,s2.sval);
  55.         strcat(s3.sval,s1.sval);
  56.         push(s3);
  57.         if(s1.sval != 0) free(s1.sval);
  58.         if(s2.sval != 0) free(s2.sval);
  59.         return(p);
  60.     default:
  61.         STerror("scolon");
  62.     }
  63. }
  64. /* last of binary operators */
  65.  
  66. /* M_COMPILE:
  67.  *    x not x    --to--    x,_not,x
  68.  * M_EXECUTE:
  69.  *    stack: bool,x    --to--     !(bool),x
  70.  */
  71. _not(l,p) int (*l[])(),p;
  72. {
  73.     union value val;
  74.  
  75.     if((status&XMODE) == M_EXECUTE) {
  76.     val = pop();
  77.     val.ival = ! val.ival;
  78.     push(val);
  79.     }
  80.     return(p);
  81. }
  82.  
  83. /* M_COMPILE:
  84.  *    x itoa x   --to--   x,_itoa,x
  85.  * M_EXECUTE:
  86.  *    stack: int,x   --to--   string,x
  87.  */
  88. _itoa(l,p)
  89. int (*l[])(),p;
  90. {
  91.     union value val;
  92.     char s2[30];
  93.  
  94.     switch(status&XMODE) {
  95.     case M_FIXUP:
  96.     case M_COMPILE: return(p);
  97.     case M_READ:
  98.         dtype = T_CHR;
  99.     case M_EXECUTE:
  100.         val=pop();
  101.         sprintf(s2,"%D",val.ival);    /* optimize later */
  102. if(dbg) printf("_icon():M_EXECUTE:ival:%D to sval:%s\n",val.ival,s2);
  103.         val.sval=myalloc(strlen(s2)+1);
  104.         strcpy(val.sval,s2);
  105.         push(val);
  106.         return(p);
  107.     default:
  108.         STerror("itoa");
  109.     }
  110. }
  111. _rtoa(l,p)
  112. int (*l[])(),p;
  113. {
  114.     union value val;
  115.     char s2[30];
  116.  
  117.     switch(status&XMODE) {
  118.     case M_FIXUP:
  119.     case M_COMPILE: return(p);
  120.     case M_READ: dtype = T_CHR;
  121.     case M_EXECUTE:
  122.         val = pop();
  123.         sprintf(s2,"%g",val.rval);
  124. if(dbg) printf("_rtoa():M_EXECUTE:rval:%g to sval:%s\n",val.rval,s2);
  125.         val.sval = myalloc(strlen(s2)+1);
  126.         strcpy(val.sval,s2);
  127.         push(val);
  128.         return(p);
  129.     default: STerror("rtoa");
  130.     }
  131. }
  132. _itor(l,p)
  133. int (*l[])(),p;
  134. {
  135.     union value v1,v2;
  136.  
  137.     switch(status&XMODE) {
  138.     case M_READ: dtype = T_DBL;
  139.     case M_EXECUTE:
  140.         v1 = pop();
  141.         v2.rval = (double)v1.ival;
  142.         push(v2);
  143.     case M_FIXUP:
  144.     case M_COMPILE: return(p);
  145.     default: STerror("itor");
  146.     }
  147. }
  148. _rtoi(l,p)
  149. int (*l[])(),p;
  150. {
  151.     union value v1,v2;
  152.  
  153.     switch(status&XMODE) {
  154.     case M_READ: dtype = T_INT;
  155.     case M_EXECUTE:
  156.         v1 = pop();
  157.         v2.ival = (int)v1.rval;
  158.         push(v2);
  159.     case M_FIXUP:
  160.     case M_COMPILE: return(p);
  161.     default: STerror("rtoi");
  162.     }
  163. }
  164.  
  165. /* M_COMPILE:
  166.  *    x scon "quoted string" x   --to--   x,_scon,*string,x
  167.  * M_EXECUTE:
  168.  *    stack: x   --to--   string,x
  169.  *    other: pushes a COPY of the string, not the original.
  170.  */
  171. _scon(l,p)
  172. int (*l[])(),p;
  173. {
  174.     char *s,c;
  175.     union value val;
  176.     int i;
  177.  
  178.     switch(status&XMODE) {
  179.     case M_COMPILE:
  180.         l[p++] = scon_in();
  181.         return(p);
  182.     case M_READ:
  183.         dtype = T_CHR;
  184.     case M_EXECUTE:
  185.         s = l[p++];
  186.         val.sval = myalloc(strlen(s)+1);
  187.         strcpy(val.sval,s);
  188.         push(val);
  189. if(dbg) printf("_scon():M_EXECUTE:sval:%s\n",val.sval);
  190.         return(p);
  191.     case M_FIXUP: p++; return(p);
  192.     default: STerror("scon");
  193.     }
  194. }
  195.  
  196. /* M_COMPILE:
  197.  *    x icon int x   --to--   x,_icon,int,x
  198.  * M_EXECUTE:
  199.  *    stack: x   --to--   int,x
  200.  */
  201. _icon(l,p)
  202. int (*l[])(),p;
  203. {
  204.     union value val;
  205.     union loni v;
  206.     int i;
  207.  
  208.     switch(status&XMODE) {
  209.     case M_COMPILE:
  210.         v.l_in_loni = atol(int_in());
  211.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  212.         l[p++] = v.i_in_loni[i];
  213.         return(p);
  214.     case M_READ: dtype = T_INT;
  215.     case M_EXECUTE:
  216.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  217.         v.i_in_loni[i] = l[p++];
  218.         val.ival = v.l_in_loni;
  219.         push(val);
  220. if(dbg) printf("_icon():M_EXECUTE:ival:%D\n",val.ival);
  221.         return(p);
  222.     case M_FIXUP:
  223.         p += (sizeof(long)/sizeof(int));
  224.         return(p);
  225.     default: STerror("icon");
  226.     }
  227. }
  228. _rcon(l,p)
  229. int (*l[])(),p;
  230. {
  231.     union doni v;
  232.     int i;
  233.     union value val;
  234.  
  235.     switch(status&XMODE) {
  236.     case M_COMPILE:
  237.         v.d_in_doni = atof(real_in());
  238.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  239.         l[p++] = v.i_in_doni[i];
  240.         return(p);
  241.     case M_FIXUP:
  242.         p += (sizeof(double)/sizeof(int));
  243.         return(p);
  244.     case M_READ: dtype = T_DBL;
  245.     case M_EXECUTE:
  246.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  247.         v.i_in_doni[i] = l[p++];
  248.         val.rval = v.d_in_doni;
  249.         push(val);
  250.         return(p);
  251.     default: STerror("rcon");
  252.     }
  253. }
  254.  
  255. /* M_COMPILE:
  256.  *    x val type x   --to--   x,_val,type,x
  257.  * M_EXECUTE:
  258.  *    stack:    place,x   --to--   value,x
  259.  *    other: for strings, pushes a copy of the string.
  260.  */
  261. _val(l,p) int(*l[])(),p;
  262. {
  263.     union value place,val;
  264.     int ty;
  265.  
  266.     switch(status&XMODE) {
  267.     case M_COMPILE:
  268.         l[p++] = atoi(int_in());
  269.         return(p);
  270.     case M_READ:
  271.         dtype = l[p];
  272.     case M_EXECUTE:
  273.         ty = l[p];
  274.         place = pop();
  275. if(dbg) printf("_val():M_EXECUTE:var:%s",place.vpval->name);
  276.         place.plval = getplace(place.vpval);
  277.         if(ty==T_CHR && place.plval->sval!=0) {
  278.         val.sval = myalloc(strlen(place.plval->sval)+1);
  279.         strcpy(val.sval,place.plval->sval);
  280.         push(val);
  281.         }
  282.         else push(*place.plval);
  283. if(dbg) printf(":ival:%D:rval:%g:sval:%s\n",ty==T_INT?place.plval->ival:(long)0,
  284.     ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  285.     case M_FIXUP: p++; return(p);
  286.     default: STerror("val");
  287.     }
  288. }
  289.  
  290. /* M_COMPILE:
  291.  *    x store typ x   --to--    x,_store,type,x
  292.  * M_EXECUTE:
  293.  *    stack: value,location,x   --to--   value,x
  294.  *        (stores value at location).
  295.  */
  296. _store(l,p) int(*l[])(),p;
  297. {
  298.     union value place,val;
  299.     int ty;
  300.  
  301.     switch(status&XMODE) {
  302.     case M_COMPILE:
  303.         l[p++] = atoi(int_in());
  304.         return(p);
  305.     case M_READ:
  306.         dtype = l[p];
  307.     case M_EXECUTE:
  308.         val = pop();
  309.         place = pop();
  310.         ty = l[p];
  311. if(dbg) printf("_store():M_EXECUTE:var:%s:ival:%D:rval:%g:sval:%s\n",
  312.     place.vpval->name,ty==T_INT?val.ival:(long)0,ty==T_DBL?val.rval:(double)0,ty==T_CHR?val.sval:0);
  313.         place.plval = getplace(place.vpval);
  314.         if(ty==T_CHR && place.plval->sval!=0) free(place.plval->sval);
  315.         (*place.plval) = val;
  316.         push(val);
  317.     case M_FIXUP:
  318.         p++;
  319.         return(p);
  320.     default: STerror("store");
  321.     }
  322. }
  323.  
  324. /* M_COMPILE:
  325.  *    x var typ name x   --to--    x,_var,&vlist entry,x
  326.  * M_EXECUTE:
  327.  *    stack: x   --to--   &vlist entry,x
  328.  * M_INPUT:
  329.  *    (&vlist entry)->val is set to input value.
  330.  * M_READ:
  331.  *    Moves the data list pointers to the next data item.  If no next
  332.  *    data item, calls ODerror.
  333.  *    Does a "gosub" to the data item, to get its value on the stack.
  334.  *    Does T_INT to T_CHR conversion if necessary.
  335.  *    Pops value into vp->val.
  336.  */
  337. _var(l,p) int(*l[])(),p; /* same proc for any variable type */
  338. {
  339.     char *s;
  340.     struct dictnode *vp;
  341.     struct line *thislist;
  342.     union value place,val;
  343.     int ty,qual;
  344.  
  345.     switch(status&XMODE) {
  346.     case M_COMPILE:
  347.         ty = atoi(int_in());
  348.         s = gtok();
  349.         l[p++] = gvadr(s,ty);
  350.         return(p);
  351.     case M_EXECUTE:
  352.         val.vpval = l[p++];
  353. if(dbg) printf("_var():M_EXECUTE:var:(%d)%s\n",val.vpval->type_of_value,
  354.     val.vpval->name);
  355.         push(val);
  356.         return(p);
  357.     case M_INPUT:
  358.         vp = l[p++];
  359.         place.plval = getplace(vp);
  360.         ty = (vp->type_of_value) & T_TMASK;
  361.         if(ty == T_INT)
  362.         place.plval->ival = atol(int_in());
  363.         else if(ty == T_DBL)
  364.         place.plval->rval = atof(real_in());
  365.         else 
  366.         place.plval->sval = scon_in();
  367. if(dbg) printf("_var():M_INPUT:var:(%d)%s:ival:%D:rval:%g:sval:%s\n",
  368. vp->type_of_value,vp->name,ty==T_INT?place.plval->ival:(long)0,
  369. ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  370.         return(p);
  371.     case M_READ:
  372. nxdl:        if(dlist[dlp] == 0) ODerror(l,p);    /* ran off end of dlist */
  373.         thislist = dlist[dlp];
  374.         if((thislist->code)[dlindx] == 0) {
  375.         dlp++;
  376.         dlindx = 2;    /* skips <_data,0> */
  377.         goto nxdl;
  378.         }
  379.  
  380.         status = M_EXECUTE;
  381.         dlindx = interp(thislist->code,dlindx);
  382.         status = M_READ;
  383.  
  384.         val = pop();
  385.         vp = l[p];
  386.         place.plval = getplace(vp);
  387.         qual = vp->type_of_value&T_TMASK;
  388.         if(qual == T_INT)
  389.         place.plval->ival = val.ival;
  390.         else if(qual == T_DBL)
  391.         place.plval->rval = val.rval;
  392.         else if(qual == T_CHR) {
  393.         if(dtype == T_INT) {
  394.             push(val); _itoa(l,p); val = pop();
  395.         }
  396.         else if(dtype == T_DBL) {
  397.             push(val); _rtoa(l,p); val = pop();
  398.         }
  399.         if(place.plval->sval != 0) free(place.plval->sval);
  400.         place.plval->sval = myalloc(strlen(val.sval)+1);
  401.         strcpy(place.plval->sval,val.sval);
  402.         }
  403.         else VTerror(l,p);
  404.     case M_FIXUP:
  405.         p++;
  406.         return(p);
  407.     default: STerror("var");
  408.     }
  409. }
  410.