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 / XLISP11.ARK / XLMATH.C < prev    next >
Text File  |  1986-10-12  |  8KB  |  437 lines
  1. /* xlmath - xlisp builtin arithmetic functions */
  2.  
  3. #ifdef AZTEC
  4. #include "a: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.  
  14. /* local variables */
  15. static struct node *true;
  16.  
  17. /* forward declarations (the extern hack is for decusc) */
  18. extern struct node *arith();
  19. extern struct node *compare();
  20.  
  21. /* add - builtin function for addition */
  22. static int xadd(val,arg)
  23.   int val,arg;
  24. {
  25.     return (val + arg);
  26. }
  27. static struct node *add(args)
  28.   struct node *args;
  29. {
  30.     return (arith(args,xadd));
  31. }
  32.  
  33. /* sub - builtin function for subtraction */
  34. static int xsub(val,arg)
  35.   int val,arg;
  36. {
  37.     return (val - arg);
  38. }
  39. static struct node *sub(args)
  40.   struct node *args;
  41. {
  42.     return (arith(args,xsub));
  43. }
  44.  
  45. /* mul - builtin function for multiplication */
  46. static int xmul(val,arg)
  47.   int val,arg;
  48. {
  49.     return (val * arg);
  50. }
  51. static struct node *mul(args)
  52.   struct node *args;
  53. {
  54.     return (arith(args,xmul));
  55. }
  56.  
  57. /* div - builtin function for division */
  58. static int xdiv(val,arg)
  59.   int val,arg;
  60. {
  61.     return (val / arg);
  62. }
  63. static struct node *div(args)
  64.   struct node *args;
  65. {
  66.     return (arith(args,xdiv));
  67. }
  68.  
  69. /* mod - builtin function for modulus */
  70. static int xmod(val,arg)
  71.   int val,arg;
  72. {
  73.     return (val % arg);
  74. }
  75. static struct node *mod(args)
  76.   struct node *args;
  77. {
  78.     return (arith(args,xmod));
  79. }
  80.  
  81. /* and - builtin function for modulus */
  82. static int xand(val,arg)
  83.   int val,arg;
  84. {
  85.     return (val & arg);
  86. }
  87. static struct node *and(args)
  88.   struct node *args;
  89. {
  90.     return (arith(args,xand));
  91. }
  92.  
  93. /* or - builtin function for modulus */
  94. static int xor(val,arg)
  95.   int val,arg;
  96. {
  97.     return (val | arg);
  98. }
  99. static struct node *or(args)
  100.   struct node *args;
  101. {
  102.     return (arith(args,xor));
  103. }
  104.  
  105. /* not - bitwise not */
  106. static struct node *not(args)
  107.   struct node *args;
  108. {
  109.     struct node *rval;
  110.     int val;
  111.  
  112.     /* evaluate the argument */
  113.     val = xlevmatch(INT,&args)->n_int;
  114.  
  115.     /* make sure there aren't any more arguments */
  116.     xllastarg(args);
  117.  
  118.     /* convert and check the value  */
  119.     rval = newnode(INT);
  120.     rval->n_int = ~val;
  121.  
  122.     /* return the result value */
  123.     return (rval);
  124. }
  125.  
  126. /* abs - absolute value */
  127. static struct node *abs(args)
  128.   struct node *args;
  129. {
  130.     struct node *rval;
  131.     int val;
  132.  
  133.     /* evaluate the argument */
  134.     val = xlevmatch(INT,&args)->n_int;
  135.  
  136.     /* make sure there aren't any more arguments */
  137.     xllastarg(args);
  138.  
  139.     /* convert and check the value  */
  140.     rval = newnode(INT);
  141.     rval->n_int = val >= 0 ? val : -val ;
  142.  
  143.     /* return the result value */
  144.     return (rval);
  145. }
  146.  
  147. /* min - builtin function for minimum */
  148. static int xmin(val,arg)
  149.   int val,arg;
  150. {
  151.     return (val < arg ? val : arg);
  152. }
  153. static struct node *min(args)
  154.   struct node *args;
  155. {
  156.     return (arith(args,xmin));
  157. }
  158.  
  159. /* max - builtin function for maximum */
  160. static int xmax(val,arg)
  161.   int val,arg;
  162. {
  163.     return (val > arg ? val : arg);
  164. }
  165. static struct node *max(args)
  166.   struct node *args;
  167. {
  168.     return (arith(args,xmax));
  169. }
  170.  
  171. /* arith - common arithmetic function */
  172. static struct node *arith(args,funct)
  173.   struct node *args; int (*funct)();
  174. {
  175.     struct node *oldstk,arg,*val;
  176.     int first,ival,iarg;
  177.  
  178.     /* create a new stack frame */
  179.     oldstk = xlsave(&arg,NULL);
  180.  
  181.     /* initialize */
  182.     arg.n_ptr = args;
  183.     first = TRUE;
  184.     ival = 0;
  185.  
  186.     /* evaluate and sum each argument */
  187.     while (arg.n_ptr != NULL) {
  188.  
  189.     /* get the next argument */
  190.     iarg = xlevmatch(INT,&arg.n_ptr)->n_int;
  191.  
  192.     /* accumulate the result value */
  193.     if (first) {
  194.         ival = iarg;
  195.         first = FALSE;
  196.     }
  197.     else
  198.         ival = (*funct)(ival,iarg);
  199.     }
  200.  
  201.     /* initialize value */
  202.     val = newnode(INT);
  203.     val->n_int = ival;
  204.  
  205.     /* restore the previous stack frame */
  206.     xlstack = oldstk;
  207.  
  208.     /* return the result value */
  209.     return (val);
  210. }
  211.  
  212. /* land - logical and */
  213. static struct node *land(args)
  214.   struct node *args;
  215. {
  216.     struct node *oldstk,arg,*val;
  217.  
  218.     /* create a new stack frame */
  219.     oldstk = xlsave(&arg,NULL);
  220.  
  221.     /* initialize */
  222.     arg.n_ptr = args;
  223.     val = true;
  224.  
  225.     /* evaluate each argument */
  226.     while (arg.n_ptr != NULL)
  227.  
  228.     /* get the next argument */
  229.     if (xlevarg(&arg.n_ptr) == NULL) {
  230.         val = NULL;
  231.         break;
  232.     }
  233.  
  234.     /* restore the previous stack frame */
  235.     xlstack = oldstk;
  236.  
  237.     /* return the result value */
  238.     return (val);
  239. }
  240.  
  241. /* lor - logical or */
  242. static struct node *lor(args)
  243.   struct node *args;
  244. {
  245.     struct node *oldstk,arg,*val;
  246.  
  247.     /* create a new stack frame */
  248.     oldstk = xlsave(&arg,NULL);
  249.  
  250.     /* initialize */
  251.     arg.n_ptr = args;
  252.     val = NULL;
  253.  
  254.     /* evaluate each argument */
  255.     while (arg.n_ptr != NULL)
  256.     if (xlevarg(&arg.n_ptr) != NULL) {
  257.         val = true;
  258.         break;
  259.     }
  260.  
  261.     /* restore the previous stack frame */
  262.     xlstack = oldstk;
  263.  
  264.     /* return the result value */
  265.     return (val);
  266. }
  267.  
  268. /* lnot - logical not */
  269. static struct node *lnot(args)
  270.   struct node *args;
  271. {
  272.     struct node *val;
  273.  
  274.     /* evaluate the argument */
  275.     val = xlevarg(&args);
  276.  
  277.     /* make sure there aren't any more arguments */
  278.     xllastarg(args);
  279.  
  280.     /* convert and check the value  */
  281.     if (val == NULL)
  282.     return (true);
  283.     else
  284.     return (NULL);
  285. }
  286.  
  287. /* lss - builtin function for < */
  288. static int xlss(cmp)
  289.   int cmp;
  290. {
  291.     return (cmp < 0);
  292. }
  293. static struct node *lss(args)
  294.   struct node *args;
  295. {
  296.     return (compare(args,xlss));
  297. }
  298.  
  299. /* leq - builtin function for <= */
  300. static int xleq(cmp)
  301.   int cmp;
  302. {
  303.     return (cmp <= 0);
  304. }
  305. static struct node *leq(args)
  306.   struct node *args;
  307. {
  308.     return (compare(args,xleq));
  309. }
  310.  
  311. /* eql - builtin function for == */
  312. static int xeql(cmp)
  313.   int cmp;
  314. {
  315.     return (cmp == 0);
  316. }
  317. static struct node *eql(args)
  318.   struct node *args;
  319. {
  320.     return (compare(args,xeql));
  321. }
  322.  
  323. /* neq - builtin function for != */
  324. static int xneq(cmp)
  325.   int cmp;
  326. {
  327.     return (cmp != 0);
  328. }
  329. static struct node *neq(args)
  330.   struct node *args;
  331. {
  332.     return (compare(args,xneq));
  333. }
  334.  
  335. /* geq - builtin function for >= */
  336. static int xgeq(cmp)
  337.   int cmp;
  338. {
  339.     return (cmp >= 0);
  340. }
  341. static struct node *geq(args)
  342.   struct node *args;
  343. {
  344.     return (compare(args,xgeq));
  345. }
  346.  
  347. /* gtr - builtin function for > */
  348. static int xgtr(cmp)
  349.   int cmp;
  350. {
  351.     return (cmp > 0);
  352. }
  353. static struct node *gtr(args)
  354.   struct node *args;
  355. {
  356.     return (compare(args,xgtr));
  357. }
  358.  
  359. /* compare - common compare function */
  360. static struct node *compare(args,funct)
  361.   struct node *args; int (*funct)();
  362. {
  363.     struct node *oldstk,arg,arg1,arg2;
  364.     int type1,type2,cmp;
  365.  
  366.     /* create a new stack frame */
  367.     oldstk = xlsave(&arg,&arg1,&arg2,NULL);
  368.  
  369.     /* initialize */
  370.     arg.n_ptr = args;
  371.  
  372.     /* get argument 1 */
  373.     arg1.n_ptr = xlevarg(&arg.n_ptr);
  374.     type1 = gettype(arg1.n_ptr);
  375.  
  376.     /* get argument 2 */
  377.     arg2.n_ptr = xlevarg(&arg.n_ptr);
  378.     type2 = gettype(arg2.n_ptr);
  379.  
  380.     /* make sure there aren't any more arguments */
  381.     xllastarg(arg.n_ptr);
  382.  
  383.     /* do the compare */
  384.     if (type1 == STR && type2 == STR)
  385.     cmp = strcmp(arg1.n_ptr->n_str,arg2.n_ptr->n_str);
  386.     else if (type1 == INT && type2 == INT)
  387.     cmp = arg1.n_ptr->n_int - arg2.n_ptr->n_int;
  388.     else
  389.     cmp = arg1.n_ptr - arg2.n_ptr;
  390.  
  391.     /* restore the previous stack frame */
  392.     xlstack = oldstk;
  393.  
  394.     /* return result of the compare */
  395.     if ((*funct)(cmp))
  396.     return (true);
  397.     else
  398.     return (NULL);
  399. }
  400.  
  401. /* gettype - return the type of an argument */
  402. static int gettype(arg)
  403.   struct node *arg;
  404. {
  405.     if (arg == NULL)
  406.     return (LIST);
  407.     else
  408.     return (arg->n_type);
  409. }
  410.  
  411. /* xlminit - xlisp math initialization routine */
  412. xlminit()
  413. {
  414.     xlsubr("+",add);
  415.     xlsubr("-",sub);
  416.     xlsubr("*",mul);
  417.     xlsubr("/",div);
  418.     xlsubr("%",mod);
  419.     xlsubr("&",and);
  420.     xlsubr("|",or);
  421.     xlsubr("~",not);
  422.     xlsubr("<",lss);
  423.     xlsubr("<=",leq);
  424.     xlsubr("==",eql);
  425.     xlsubr("!=",neq);
  426.     xlsubr(">=",geq);
  427.     xlsubr(">",gtr);
  428.     xlsubr("&&",land);
  429.     xlsubr("||",lor);
  430.     xlsubr("!",lnot);
  431.     xlsubr("min",min);
  432.     xlsubr("max",max);
  433.     xlsubr("abs",abs);
  434.     true = xlenter("t");
  435.     true->n_symvalue = true;
  436. }
  437.