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