src/c/utils2.c

   1 /* utilities2 - basic utility functions                                */
   2 /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
   3 /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
   4 /* You may give out copies of this software; for conditions see the    */
   5 /* file COPYING included with this distribution.                       */
   6
   7 #include "xlisp.h"
   8 #include "xlstat.h"
   9
  10 /* external variables */
  11 extern LVAL s_in_callback;
  12
  13 /**************************************************************************/
  14 /**                                                                      **/
  15 /**                          Utility Functions                           **/
  16 /**                                                                      **/
  17 /**************************************************************************/
  18
  19 LVAL integer_list_2 P2C(int, a, int, b)
  20 {
  21   LVAL list, temp;
  22
  23   xlstkcheck(2);
  24   xlsave(temp);
  25   xlsave(list);
  26   temp = cvfixnum((FIXTYPE) b); list = consa(temp);
  27   temp = cvfixnum((FIXTYPE) a); list = cons(temp, list);
  28   xlpopn(2);
  29   return(list);
  30 }
  31
  32 LVAL integer_list_3 P3C(int, a, int, b, int, c)
  33 {
  34   LVAL list, temp;
  35
  36   xlstkcheck(2);
  37   xlsave(temp);
  38   xlsave(list);
  39   temp = cvfixnum((FIXTYPE) c); list = consa(temp);
  40   temp = cvfixnum((FIXTYPE) b); list = cons(temp, list);
  41   temp = cvfixnum((FIXTYPE) a); list = cons(temp, list);
  42   xlpopn(2);
  43   return(list);
  44 }
  45
  46 LVAL integer_list_4 P4C(int, a, int, b, int, c, int, d)
  47 {
  48   LVAL list, temp;
  49
  50   xlstkcheck(2);
  51   xlsave(temp);
  52   xlsave(list);
  53   temp = cvfixnum((FIXTYPE) d); list = consa(temp);
  54   temp = cvfixnum((FIXTYPE) c); list = cons(temp, list);
  55   temp = cvfixnum((FIXTYPE) b); list = cons(temp, list);
  56   temp = cvfixnum((FIXTYPE) a); list = cons(temp, list);
  57   xlpopn(2);
  58   return(list);
  59 }
  60
  61 LVAL send_message P2C(LVAL, object, LVAL, msg)
  62 {
  63   LVAL argv[2];
  64
  65   argv[0] = object;
  66   argv[1] = msg;
  67   return(xscallsubrvec(xmsend, 2, argv));
  68 }
  69
  70 LVAL send_callback_message P2C(LVAL, object, LVAL, msg)
  71 {
  72   LVAL val, olddenv;
  73
  74   olddenv = xldenv;
  75   xldbind(s_in_callback, s_true);
  76   val = send_message(object, msg);
  77   xlunbind(olddenv);
  78   return val;
  79 }
  80
  81 LVAL send_message1 P3C(LVAL, object, LVAL, msg, int, a)
  82 {
  83   LVAL La, result, argv[3];
  84
  85   xlsave(La);
  86   La = cvfixnum((FIXTYPE) a);
  87   argv[0] = object;
  88   argv[1] = msg;
  89   argv[2] = La;
  90   result = xscallsubrvec(xmsend, 3, argv);
  91   xlpop();
  92   return(result);
  93 }
  94
  95 LVAL send_callback_message1 P3C(LVAL, object, LVAL, msg, int, a)
  96 {
  97   LVAL val, olddenv;
  98
  99   olddenv = xldenv;
 100   xldbind(s_in_callback, s_true);
 101   val = send_message1(object, msg, a);
 102   xlunbind(olddenv);
 103   return val;
 104 }
 105
 106 LVAL send_message_1L P3C(LVAL, object, LVAL, symbol, LVAL, value)
 107 {
 108   LVAL argv[3];
 109
 110   argv[0] = object;
 111   argv[1] = symbol;
 112   argv[2] = value;
 113   return(xscallsubrvec(xmsend, 3, argv));
 114 }
 115
 116 LVAL send_callback_message_1L P3C(LVAL, object, LVAL, msg, LVAL, value)
 117 {
 118   LVAL val, olddenv;
 119
 120   olddenv = xldenv;
 121   xldbind(s_in_callback, s_true);
 122   val = send_message_1L(object, msg, value);
 123   xlunbind(olddenv);
 124   return val;
 125 }
 126
 127 LVAL apply_send P3C(LVAL, object, LVAL, symbol, LVAL, args)
 128 {
 129   LVAL result;
 130
 131   xlprot1(args);
 132   args = cons(symbol, args);
 133   args = cons(object, args);
 134   result = xsapplysubr(xmsend, args);
 135   xlpop();
 136   return(result);
 137 }
 138
 139 LVAL double_list_2 P2C(double, a, double, b)
 140 {
 141   LVAL list, temp;
 142
 143   xlstkcheck(2);
 144   xlsave(temp);
 145   xlsave(list);
 146   temp = cvflonum((FLOTYPE) b); list = consa(temp);
 147   temp = cvflonum((FLOTYPE) a); list = cons(temp, list);
 148   xlpopn(2);
 149   return(list);
 150 }
 151
 152 LVAL xssysbeep(V)
 153 {
 154   int count = 10;
 155   if (moreargs()) count = getfixnum(xlgafixnum());
 156   xllastarg();
 157
 158   SysBeep(count);
 159   return(NIL);
 160 }
 161