home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / XLISP / XLISP12.ARK / XLMATH.C < prev    next >
Text File  |  1985-02-19  |  7KB  |  369 lines
  1. /* xlmath - xlisp builtin arithmetic functions */
  2.  
  3. #ifdef AZTEC
  4. #include "stdio.h"
  5. #else
  6. #include <stdio.h>
  7. #endif
  8.  
  9. #include "xlisp.h"
  10.  
  11. /* external variables */
  12. extern struct node *xlstack;
  13. extern struct node *true;
  14.  
  15. /* forward declarations */
  16. FORWARD struct node *unary();
  17. FORWARD struct node *binary();
  18. FORWARD struct node *compare();
  19.  
  20. /* xadd - builtin function for addition */
  21. LOCAL int add(val,arg)
  22.   int val,arg;
  23. {
  24.     return (val + arg);
  25. }
  26. struct node *xadd(args)
  27.   struct node *args;
  28. {
  29.     return (binary(args,add));
  30. }
  31.  
  32. /* xsub - builtin function for subtraction */
  33. LOCAL int sub(val,arg)
  34.   int val,arg;
  35. {
  36.     return (val - arg);
  37. }
  38. struct node *xsub(args)
  39.   struct node *args;
  40. {
  41.     return (binary(args,sub));
  42. }
  43.  
  44. /* xmul - builtin function for multiplication */
  45. LOCAL int mul(val,arg)
  46.   int val,arg;
  47. {
  48.     return (val * arg);
  49. }
  50. struct node *xmul(args)
  51.   struct node *args;
  52. {
  53.     return (binary(args,mul));
  54. }
  55.  
  56. /* xdiv - builtin function for division */
  57. LOCAL int div(val,arg)
  58.   int val,arg;
  59. {
  60.     return (val / arg);
  61. }
  62. struct node *xdiv(args)
  63.   struct node *args;
  64. {
  65.     return (binary(args,div));
  66. }
  67.  
  68. /* xrem - builtin function for remainder */
  69. LOCAL int rem(val,arg)
  70.   int val,arg;
  71. {
  72.     return (val % arg);
  73. }
  74. struct node *xrem(args)
  75.   struct node *args;
  76. {
  77.     return (binary(args,rem));
  78. }
  79.  
  80. /* xmin - builtin function for minimum */
  81. LOCAL int min(val,arg)
  82.   int val,arg;
  83. {
  84.     return (val < arg ? val : arg);
  85. }
  86. struct node *xmin(args)
  87.   struct node *args;
  88. {
  89.     return (binary(args,min));
  90. }
  91.  
  92. /* xmax - builtin function for maximum */
  93. LOCAL int max(val,arg)
  94.   int val,arg;
  95. {
  96.     return (val > arg ? val : arg);
  97. }
  98. struct node *xmax(args)
  99.   struct node *args;
  100. {
  101.     return (binary(args,max));
  102. }
  103.  
  104. /* xbitand - builtin function for bitwise and */
  105. LOCAL int bitand(val,arg)
  106.   int val,arg;
  107. {
  108.     return (val & arg);
  109. }
  110. struct node *xbitand(args)
  111.   struct node *args;
  112. {
  113.     return (binary(args,bitand));
  114. }
  115.  
  116. /* xbitior - builtin function for bitwise inclusive or */
  117. LOCAL int bitior(val,arg)
  118.   int val,arg;
  119. {
  120.     return (val | arg);
  121. }
  122. struct node *xbitior(args)
  123.   struct node *args;
  124. {
  125.     return (binary(args,bitior));
  126. }
  127.  
  128. /* xbitxor - builtin function for bitwise exclusive or */
  129. LOCAL int bitxor(val,arg)
  130.   int val,arg;
  131. {
  132.     return (val ^ arg);
  133. }
  134. struct node *xbitxor(args)
  135.   struct node *args;
  136. {
  137.     return (binary(args,bitxor));
  138. }
  139.  
  140. /* xbitnot - bitwise not */
  141. LOCAL int bitnot(arg)
  142.   int arg;
  143. {
  144.     return (~arg);
  145. }
  146. struct node *xbitnot(args)
  147.   struct node *args;
  148. {
  149.     return (unary(args,bitnot));
  150. }
  151.  
  152. /* xabs - builtin function for absolute value */
  153. LOCAL int abs(arg)
  154.   int arg;
  155. {
  156.     return (arg >= 0 ? arg : -arg);
  157. }
  158. struct node *xabs(args)
  159.   struct node *args;
  160. {
  161.     return (unary(args,abs));
  162. }
  163.  
  164. /* xadd1 - builtin function for adding one */
  165. LOCAL int add1(arg)
  166.   int arg;
  167. {
  168.     return (arg + 1);
  169. }
  170. struct node *xadd1(args)
  171.   struct node *args;
  172. {
  173.     return (unary(args,add1));
  174. }
  175.  
  176. /* xsub1 - builtin function for subtracting one */
  177. LOCAL int sub1(arg)
  178.   int arg;
  179. {
  180.     return (arg - 1);
  181. }
  182. struct node *xsub1(args)
  183.   struct node *args;
  184. {
  185.     return (unary(args,sub1));
  186. }
  187.  
  188. /* xminus - negate a value */
  189. LOCAL int minus(arg)
  190.   int arg;
  191. {
  192.     return (-arg);
  193. }
  194. struct node *xminus(args)
  195.   struct node *args;
  196. {
  197.     return (unary(args,minus));
  198. }
  199.  
  200. /* unary - handle unary operations */
  201. LOCAL struct node *unary(args,fcn)
  202.   struct node *args; int (*fcn)();
  203. {
  204.     struct node *rval;
  205.     int val;
  206.  
  207.     /* evaluate the argument */
  208.     val = xlmatch(INT,&args)->n_int;
  209.  
  210.     /* make sure there aren't any more arguments */
  211.     xllastarg(args);
  212.  
  213.     /* convert and check the value  */
  214.     rval = newnode(INT);
  215.     rval->n_int = (*fcn)(val);
  216.  
  217.     /* return the result value */
  218.     return (rval);
  219. }
  220.  
  221. /* binary - handle binary operations */
  222. LOCAL struct node *binary(args,funct)
  223.   struct node *args; int (*funct)();
  224. {
  225.     int first,ival,iarg;
  226.     struct node *val;
  227.  
  228.     /* initialize */
  229.     first = TRUE;
  230.     ival = 0;
  231.  
  232.     /* evaluate and sum each argument */
  233.     while (args != NULL) {
  234.  
  235.     /* get the next argument */
  236.     iarg = xlmatch(INT,&args)->n_int;
  237.  
  238.     /* accumulate the result value */
  239.     if (first) {
  240.         ival = iarg;
  241.         first = FALSE;
  242.     }
  243.     else
  244.         ival = (*funct)(ival,iarg);
  245.     }
  246.  
  247.     /* initialize value */
  248.     val = newnode(INT);
  249.     val->n_int = ival;
  250.  
  251.     /* return the result value */
  252.     return (val);
  253. }
  254.  
  255. /* xlss - builtin function for < */
  256. LOCAL int lss(cmp)
  257.   int cmp;
  258. {
  259.     return (cmp < 0);
  260. }
  261. struct node *xlss(args)
  262.   struct node *args;
  263. {
  264.     return (compare(args,lss));
  265. }
  266.  
  267. /* xleq - builtin function for <= */
  268. LOCAL int leq(cmp)
  269.   int cmp;
  270. {
  271.     return (cmp <= 0);
  272. }
  273. struct node *xleq(args)
  274.   struct node *args;
  275. {
  276.     return (compare(args,leq));
  277. }
  278.  
  279. /* eql - builtin function for = */
  280. LOCAL int eql(cmp)
  281.   int cmp;
  282. {
  283.     return (cmp == 0);
  284. }
  285. struct node *xeql(args)
  286.   struct node *args;
  287. {
  288.     return (compare(args,eql));
  289. }
  290.  
  291. /* xneq - builtin function for /= */
  292. LOCAL int neq(cmp)
  293.   int cmp;
  294. {
  295.     return (cmp != 0);
  296. }
  297. struct node *xneq(args)
  298.   struct node *args;
  299. {
  300.     return (compare(args,neq));
  301. }
  302.  
  303. /* xgeq - builtin function for >= */
  304. LOCAL int geq(cmp)
  305.   int cmp;
  306. {
  307.     return (cmp >= 0);
  308. }
  309. struct node *xgeq(args)
  310.   struct node *args;
  311. {
  312.     return (compare(args,geq));
  313. }
  314.  
  315. /* xgtr - builtin function for > */
  316. LOCAL int gtr(cmp)
  317.   int cmp;
  318. {
  319.     return (cmp > 0);
  320. }
  321. struct node *xgtr(args)
  322.   struct node *args;
  323. {
  324.     return (compare(args,gtr));
  325. }
  326.  
  327. /* compare - common compare function */
  328. LOCAL struct node *compare(args,funct)
  329.   struct node *args; int (*funct)();
  330. {
  331.     struct node *arg1,*arg2;
  332.     int type1,type2,cmp;
  333.  
  334.     /* get argument 1 */
  335.     arg1 = xlarg(&args);
  336.     type1 = gettype(arg1);
  337.  
  338.     /* get argument 2 */
  339.     arg2 = xlarg(&args);
  340.     type2 = gettype(arg2);
  341.  
  342.     /* make sure there aren't any more arguments */
  343.     xllastarg(args);
  344.  
  345.     /* do the compare */
  346.     if (type1 == STR && type2 == STR)
  347.     cmp = strcmp(arg1->n_str,arg2->n_str);
  348.     else if (type1 == INT && type2 == INT)
  349.     cmp = arg1->n_int - arg2->n_int;
  350.     else
  351.     cmp = arg1 - arg2;
  352.  
  353.     /* return result of the compare */
  354.     if ((*funct)(cmp))
  355.     return (true);
  356.     else
  357.     return (NULL);
  358. }
  359.  
  360. /* gettype - return the type of an argument */
  361. LOCAL int gettype(arg)
  362.   struct node *arg;
  363. {
  364.     if (arg == NULL)
  365.     return (LIST);
  366.     else
  367.     return (arg->n_type);
  368. }
  369.