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