34 |
object sLkeyword; |
object sLkeyword; |
35 |
|
|
36 |
|
|
37 |
check_type_integer(p) |
void |
38 |
object *p; |
check_type_integer(object *p) |
39 |
{ |
{ |
40 |
enum type t; |
enum type t; |
41 |
|
|
43 |
*p = wrong_type_argument(sLinteger, *p); |
*p = wrong_type_argument(sLinteger, *p); |
44 |
} |
} |
45 |
|
|
46 |
check_type_non_negative_integer(p) |
void |
47 |
object *p; |
check_type_non_negative_integer(object *p) |
48 |
{ |
{ |
49 |
enum type t; |
enum type t; |
50 |
|
|
61 |
} |
} |
62 |
} |
} |
63 |
|
|
64 |
check_type_rational(p) |
void |
65 |
object *p; |
check_type_rational(object *p) |
66 |
{ |
{ |
67 |
enum type t; |
enum type t; |
68 |
|
|
71 |
*p = wrong_type_argument(sLrational, *p); |
*p = wrong_type_argument(sLrational, *p); |
72 |
} |
} |
73 |
|
|
74 |
check_type_float(p) |
void |
75 |
object *p; |
check_type_float(object *p) |
76 |
{ |
{ |
77 |
enum type t; |
enum type t; |
78 |
|
|
80 |
*p = wrong_type_argument(sLfloat, *p); |
*p = wrong_type_argument(sLfloat, *p); |
81 |
} |
} |
82 |
|
|
83 |
check_type_or_integer_float(p) |
void |
84 |
object *p; |
check_type_or_integer_float(object *p) |
85 |
{ |
{ |
86 |
enum type t; |
enum type t; |
87 |
|
|
90 |
*p = wrong_type_argument(TSor_integer_float, *p); |
*p = wrong_type_argument(TSor_integer_float, *p); |
91 |
} |
} |
92 |
|
|
93 |
check_type_or_rational_float(p) |
void |
94 |
object *p; |
check_type_or_rational_float(object *p) |
95 |
{ |
{ |
96 |
enum type t; |
enum type t; |
97 |
|
|
100 |
*p = wrong_type_argument(TSor_rational_float, *p); |
*p = wrong_type_argument(TSor_rational_float, *p); |
101 |
} |
} |
102 |
|
|
103 |
check_type_number(p) |
void |
104 |
object *p; |
check_type_number(object *p) |
105 |
{ |
{ |
106 |
enum type t; |
enum type t; |
107 |
|
|
111 |
*p = wrong_type_argument(sLnumber, *p); |
*p = wrong_type_argument(sLnumber, *p); |
112 |
} |
} |
113 |
|
|
114 |
check_type_bit(p) |
void |
115 |
object *p; |
check_type_bit(object *p) |
116 |
{ |
{ |
117 |
while (type_of(*p) != t_fixnum || |
while (type_of(*p) != t_fixnum || |
118 |
fix((*p)) != 0 && fix((*p)) != 1) |
(fix((*p)) != 0 && fix((*p)) != 1)) |
119 |
*p = wrong_type_argument(sLbit, *p); |
*p = wrong_type_argument(sLbit, *p); |
120 |
} |
} |
121 |
|
|
122 |
check_type_character(p) |
void |
123 |
object *p; |
check_type_character(object *p) |
124 |
{ |
{ |
125 |
while (type_of(*p) != t_character) |
while (type_of(*p) != t_character) |
126 |
*p = wrong_type_argument(sLcharacter, *p); |
*p = wrong_type_argument(sLcharacter, *p); |
127 |
} |
} |
128 |
|
|
129 |
check_type_string_char(p) |
void |
130 |
object *p; |
check_type_string_char(object *p) |
131 |
{ |
{ |
132 |
while (type_of(*p) != t_character || |
while (type_of(*p) != t_character || |
133 |
char_font((*p)) != 0 || |
char_font((*p)) != 0 || |
135 |
*p = wrong_type_argument(sLcharacter, *p); |
*p = wrong_type_argument(sLcharacter, *p); |
136 |
} |
} |
137 |
|
|
138 |
check_type_symbol(p) |
void |
139 |
object *p; |
check_type_symbol(object *p) |
140 |
{ |
{ |
141 |
while (type_of(*p) != t_symbol) |
while (type_of(*p) != t_symbol) |
142 |
*p = wrong_type_argument(sLsymbol, *p); |
*p = wrong_type_argument(sLsymbol, *p); |
143 |
} |
} |
144 |
|
|
145 |
check_type_or_symbol_string(p) |
void |
146 |
object *p; |
check_type_or_symbol_string(object *p) |
147 |
{ |
{ |
148 |
while (type_of(*p) != t_symbol && type_of(*p) != t_string) |
while (type_of(*p) != t_symbol && type_of(*p) != t_string) |
149 |
*p = wrong_type_argument(TSor_symbol_string, *p); |
*p = wrong_type_argument(TSor_symbol_string, *p); |
150 |
} |
} |
151 |
|
|
152 |
check_type_or_string_symbol(p) |
void |
153 |
object *p; |
check_type_or_string_symbol(object *p) |
154 |
{ |
{ |
155 |
while (type_of(*p) != t_symbol && type_of(*p) != t_string) |
while (type_of(*p) != t_symbol && type_of(*p) != t_string) |
156 |
*p = wrong_type_argument(TSor_string_symbol, *p); |
*p = wrong_type_argument(TSor_string_symbol, *p); |
157 |
} |
} |
158 |
|
|
159 |
check_type_or_symbol_string_package(p) |
void |
160 |
object *p; |
check_type_or_symbol_string_package(object *p) |
161 |
{ |
{ |
162 |
while (type_of(*p) != t_symbol && |
while (type_of(*p) != t_symbol && |
163 |
type_of(*p) != t_string && |
type_of(*p) != t_string && |
166 |
*p); |
*p); |
167 |
} |
} |
168 |
|
|
169 |
check_type_package(p) |
void |
170 |
object *p; |
check_type_package(object *p) |
171 |
{ |
{ |
172 |
while (type_of(*p) != t_package) |
while (type_of(*p) != t_package) |
173 |
*p = wrong_type_argument(sLpackage, *p); |
*p = wrong_type_argument(sLpackage, *p); |
174 |
} |
} |
175 |
|
|
176 |
check_type_string(p) |
void |
177 |
object *p; |
check_type_string(object *p) |
178 |
{ |
{ |
179 |
while (type_of(*p) != t_string) |
while (type_of(*p) != t_string) |
180 |
*p = wrong_type_argument(sLstring, *p); |
*p = wrong_type_argument(sLstring, *p); |
181 |
} |
} |
182 |
|
|
183 |
check_type_bit_vector(p) |
void |
184 |
object *p; |
check_type_bit_vector(object *p) |
185 |
{ |
{ |
186 |
while (type_of(*p) != t_bitvector) |
while (type_of(*p) != t_bitvector) |
187 |
*p = wrong_type_argument(sLbit_vector, *p); |
*p = wrong_type_argument(sLbit_vector, *p); |
188 |
} |
} |
189 |
|
|
190 |
check_type_cons(p) |
void |
191 |
object *p; |
check_type_cons(object *p) |
192 |
{ |
{ |
193 |
while (type_of(*p) != t_cons) |
while (type_of(*p) != t_cons) |
194 |
*p = wrong_type_argument(sLcons, *p); |
*p = wrong_type_argument(sLcons, *p); |
195 |
} |
} |
196 |
|
|
197 |
check_type_stream(p) |
void |
198 |
object *p; |
check_type_stream(object *p) |
199 |
{ |
{ |
200 |
while (type_of(*p) != t_stream) |
while (type_of(*p) != t_stream) |
201 |
*p = wrong_type_argument(sLstream, *p); |
*p = wrong_type_argument(sLstream, *p); |
202 |
} |
} |
203 |
|
|
204 |
check_type_readtable(p) |
void |
205 |
object *p; |
check_type_readtable(object *p) |
206 |
{ |
{ |
207 |
while (type_of(*p) != t_readtable) |
while (type_of(*p) != t_readtable) |
208 |
*p = wrong_type_argument(sLreadtable, *p); |
*p = wrong_type_argument(sLreadtable, *p); |
209 |
} |
} |
210 |
|
|
211 |
#ifdef UNIX |
#ifdef UNIX |
212 |
check_type_or_Pathname_string_symbol(p) |
void |
213 |
object *p; |
check_type_or_Pathname_string_symbol(object *p) |
214 |
{ |
{ |
215 |
enum type t; |
enum type t; |
216 |
|
|
221 |
} |
} |
222 |
#endif |
#endif |
223 |
|
|
224 |
check_type_or_pathname_string_symbol_stream(p) |
void |
225 |
object *p; |
check_type_or_pathname_string_symbol_stream(object *p) |
226 |
{ |
{ |
227 |
enum type t; |
enum type t; |
228 |
|
|
232 |
TSor_pathname_string_symbol_stream, *p); |
TSor_pathname_string_symbol_stream, *p); |
233 |
} |
} |
234 |
|
|
235 |
check_type_random_state(p) |
void |
236 |
object *p; |
check_type_random_state(object *p) |
237 |
{ |
{ |
238 |
while (type_of(*p) != t_random) |
while (type_of(*p) != t_random) |
239 |
*p = wrong_type_argument(sLrandom_state, *p); |
*p = wrong_type_argument(sLrandom_state, *p); |
240 |
} |
} |
241 |
|
|
242 |
check_type_hash_table(p) |
void |
243 |
object *p; |
check_type_hash_table(object *p) |
244 |
{ |
{ |
245 |
while (type_of(*p) != t_hashtable) |
while (type_of(*p) != t_hashtable) |
246 |
*p = wrong_type_argument(sLhash_table, *p); |
*p = wrong_type_argument(sLhash_table, *p); |
247 |
} |
} |
248 |
|
|
249 |
check_type_array(p) |
void |
250 |
object *p; |
check_type_array(object *p) |
251 |
{ |
{ |
252 |
BEGIN: |
BEGIN: |
253 |
switch (type_of(*p)) { |
switch (type_of(*p)) { |
263 |
} |
} |
264 |
} |
} |
265 |
|
|
266 |
check_type_vector(p) |
void |
267 |
object *p; |
check_type_vector(object *p) |
268 |
{ |
{ |
269 |
BEGIN: |
BEGIN: |
270 |
switch (type_of(*p)) { |
switch (type_of(*p)) { |
280 |
} |
} |
281 |
|
|
282 |
void |
void |
283 |
check_type(x,t) |
check_type(object x, int t) |
|
object x; |
|
|
int t; |
|
284 |
{if (type_of(x) !=t) |
{if (type_of(x) !=t) |
285 |
FEerror("~s is not a ~a",2, |
FEerror("~s is not a ~a",2, |
286 |
x,make_simple_string(tm_table[t].tm_name +1)); |
x,make_simple_string(tm_table[t].tm_name +1)); |
287 |
} |
} |
288 |
|
|
289 |
|
|
290 |
|
void |
291 |
Ltype_of() |
Ltype_of(void) |
292 |
{ |
{ |
293 |
int i; |
int i; |
294 |
|
|
325 |
vs_base[0] = sLcharacter; |
vs_base[0] = sLcharacter; |
326 |
else { |
else { |
327 |
i = char_code(vs_base[0]); |
i = char_code(vs_base[0]); |
328 |
if (' ' <= i && i < '\177' || i == '\n') |
if ((' ' <= i && i < '\177') || i == '\n') |
329 |
vs_base[0] = sLstandard_char; |
vs_base[0] = sLstandard_char; |
330 |
else |
else |
331 |
vs_base[0] = sLstring_char; |
vs_base[0] = sLstring_char; |
486 |
DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character"); |
DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character"); |
487 |
DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer"); |
DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer"); |
488 |
|
|
489 |
|
void |
490 |
init_typespec() |
init_typespec(void) |
491 |
{ |
{ |
492 |
} |
} |
493 |
|
|
494 |
init_typespec_function() |
void |
495 |
|
init_typespec_function(void) |
496 |
{ |
{ |
497 |
TSor_symbol_string |
TSor_symbol_string |
498 |
= make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil))); |
= make_cons(sLor, make_cons(sLsymbol, make_cons(sLstring, Cnil))); |