291 |
} |
} |
292 |
|
|
293 |
|
|
294 |
LFD(Ltype_of)(void) |
LFD(siLtype_of_c)(void) |
295 |
{ |
{ |
296 |
int i; |
int i; |
297 |
|
|
299 |
|
|
300 |
switch (type_of(vs_base[0])) { |
switch (type_of(vs_base[0])) { |
301 |
case t_fixnum: |
case t_fixnum: |
302 |
vs_base[0] = sLfixnum; |
{ |
303 |
break; |
fixnum i=fix(vs_base[0]); |
304 |
|
vs_base[0] = !i || i==1 ? sLbit : (i>0 ? sLnon_negative_fixnum : sLfixnum); |
305 |
|
} |
306 |
|
break; |
307 |
|
|
308 |
case t_bignum: |
case t_bignum: |
309 |
vs_base[0] = sLbignum; |
vs_base[0] = big_sign(vs_base[0])<0 ? sLbignum : sLnon_negative_bignum; |
310 |
break; |
break; |
311 |
|
|
312 |
case t_ratio: |
case t_ratio: |
313 |
vs_base[0] = sLratio; |
vs_base[0] = sLratio; |
334 |
if ((' ' <= i && i < '\177') || i == '\n') |
if ((' ' <= i && i < '\177') || i == '\n') |
335 |
vs_base[0] = sLstandard_char; |
vs_base[0] = sLstandard_char; |
336 |
else |
else |
337 |
vs_base[0] = sLstring_char; |
vs_base[0] = sLbase_char; |
338 |
} |
} |
339 |
break; |
break; |
340 |
|
|
341 |
case t_symbol: |
case t_symbol: |
342 |
if (vs_base[0]->s.s_hpack == keyword_package) |
if (vs_base[0]==Cnil) |
343 |
vs_base[0] = sLkeyword; |
vs_base[0] = sLnull; |
344 |
|
else if (vs_base[0]==Ct) |
345 |
|
vs_base[0]=sLboolean; |
346 |
|
else if (vs_base[0]->s.s_hpack == keyword_package) |
347 |
|
vs_base[0] = sLkeyword; |
348 |
else |
else |
349 |
vs_base[0] = sLsymbol; |
vs_base[0] = sLsymbol; |
350 |
break; |
break; |
351 |
|
|
352 |
case t_package: |
case t_package: |
362 |
break; |
break; |
363 |
|
|
364 |
case t_array: |
case t_array: |
365 |
if (vs_base[0]->a.a_adjustable || |
/* if (vs_base[0]->a.a_adjustable || */ |
366 |
vs_base[0]->a.a_displaced->c.c_car == Cnil) |
/* vs_base[0]->a.a_displaced->c.c_car == Cnil) */ |
367 |
vs_base[0] = sLarray; |
/* vs_base[0] = sLarray; */ |
368 |
else |
/* else */ |
369 |
vs_base[0] = sLsimple_array; |
vs_base[0] = sLarray; |
370 |
break; |
break; |
371 |
|
|
372 |
case t_vector: |
case t_vector: |
373 |
if (vs_base[0]->v.v_adjustable || |
/* if (vs_base[0]->v.v_adjustable || */ |
374 |
vs_base[0]->v.v_hasfillp || |
/* vs_base[0]->v.v_hasfillp || */ |
375 |
vs_base[0]->v.v_displaced->c.c_car == Cnil || |
/* vs_base[0]->v.v_displaced->c.c_car == Cnil || */ |
376 |
(enum aelttype)vs_base[0]->v.v_elttype != aet_object) |
/* (enum aelttype)vs_base[0]->v.v_elttype != aet_object) */ |
377 |
vs_base[0] = sLvector; |
/* vs_base[0] = sLvector; */ |
378 |
else |
/* else */ |
379 |
vs_base[0] = sLsimple_vector; |
vs_base[0] = sLvector; |
380 |
break; |
break; |
381 |
|
|
382 |
case t_string: |
case t_string: |
383 |
if (vs_base[0]->st.st_adjustable || |
/* if (vs_base[0]->st.st_adjustable || */ |
384 |
vs_base[0]->st.st_hasfillp || |
/* vs_base[0]->st.st_hasfillp || */ |
385 |
vs_base[0]->st.st_displaced->c.c_car == Cnil) |
/* vs_base[0]->st.st_displaced->c.c_car == Cnil) */ |
386 |
vs_base[0] = sLstring; |
/* vs_base[0] = sLstring; */ |
387 |
else |
/* else */ |
388 |
vs_base[0] = sLsimple_string; |
vs_base[0] = sLstring; |
389 |
break; |
break; |
390 |
|
|
391 |
case t_bitvector: |
case t_bitvector: |
392 |
if (vs_base[0]->bv.bv_adjustable || |
/* if (vs_base[0]->bv.bv_adjustable || */ |
393 |
vs_base[0]->bv.bv_hasfillp || |
/* vs_base[0]->bv.bv_hasfillp || */ |
394 |
vs_base[0]->bv.bv_displaced->c.c_car == Cnil) |
/* vs_base[0]->bv.bv_displaced->c.c_car == Cnil) */ |
395 |
vs_base[0] = sLbit_vector; |
/* vs_base[0] = sLbit_vector; */ |
396 |
else |
/* else */ |
397 |
vs_base[0] = sLsimple_bit_vector; |
vs_base[0] = sLbit_vector; |
398 |
break; |
break; |
399 |
|
|
400 |
case t_structure: |
case t_structure: |
401 |
|
|
443 |
break; |
break; |
444 |
|
|
445 |
case t_pathname: |
case t_pathname: |
446 |
vs_base[0] = sLpathname; |
if (pathname_lookup(vs_base[0]->pn.pn_host,sSApathname_logicalA->s.s_dbind)!=Cnil) |
447 |
break; |
vs_base[0] = sLlogical_pathname; |
448 |
|
else |
449 |
|
vs_base[0] = sLpathname; |
450 |
|
break; |
451 |
|
|
452 |
case t_random: |
case t_random: |
453 |
vs_base[0] = sLrandom_state; |
vs_base[0] = sLrandom_state; |
463 |
vs_base[0] = sLcompiled_function; |
vs_base[0] = sLcompiled_function; |
464 |
break; |
break; |
465 |
|
|
466 |
|
case t_ifun: |
467 |
|
vs_base[0]=sLinterpreted_function; |
468 |
|
break; |
469 |
|
|
470 |
default: |
default: |
471 |
error("not a lisp data object"); |
error("not a lisp data object"); |
472 |
} |
} |
489 |
DEF_ORDINARY("FUNCTION",sLfunction,LISP,""); |
DEF_ORDINARY("FUNCTION",sLfunction,LISP,""); |
490 |
DEF_ORDINARY("FUNCTION-IDENTIFIER",sLfunction_identifier,LISP,""); |
DEF_ORDINARY("FUNCTION-IDENTIFIER",sLfunction_identifier,LISP,""); |
491 |
DEF_ORDINARY("COMPILED-FUNCTION",sLcompiled_function,LISP,""); |
DEF_ORDINARY("COMPILED-FUNCTION",sLcompiled_function,LISP,""); |
492 |
|
DEF_ORDINARY("INTERPRETED-FUNCTION",sLinterpreted_function,LISP,""); |
493 |
DEF_ORDINARY("PATHNAME",sLpathname,LISP,""); |
DEF_ORDINARY("PATHNAME",sLpathname,LISP,""); |
494 |
DEF_ORDINARY("CHARACTER",sLcharacter,LISP,""); |
DEF_ORDINARY("CHARACTER",sLcharacter,LISP,""); |
495 |
DEF_ORDINARY("NUMBER",sLnumber,LISP,""); |
DEF_ORDINARY("NUMBER",sLnumber,LISP,""); |
520 |
DEF_ORDINARY("FIXNUM",sLfixnum,LISP,""); |
DEF_ORDINARY("FIXNUM",sLfixnum,LISP,""); |
521 |
DEF_ORDINARY("NON-NEGATIVE-FIXNUM",sLnon_negative_fixnum,LISP,""); |
DEF_ORDINARY("NON-NEGATIVE-FIXNUM",sLnon_negative_fixnum,LISP,""); |
522 |
DEF_ORDINARY("NEGATIVE-FIXNUM",sLnegative_fixnum,LISP,""); |
DEF_ORDINARY("NEGATIVE-FIXNUM",sLnegative_fixnum,LISP,""); |
523 |
|
DEF_ORDINARY("NON-NEGATIVE-BIGNUM",sLnon_negative_bignum,LISP,""); |
524 |
|
DEF_ORDINARY("NEGATIVE-BIGNUM",sLnegative_bignum,LISP,""); |
525 |
DEF_ORDINARY("SIGNED-FIXNUM",sLsigned_fixnum,LISP,""); |
DEF_ORDINARY("SIGNED-FIXNUM",sLsigned_fixnum,LISP,""); |
526 |
DEF_ORDINARY("UNSIGNED-FIXNUM",sLunsigned_fixnum,LISP,""); |
DEF_ORDINARY("UNSIGNED-FIXNUM",sLunsigned_fixnum,LISP,""); |
527 |
|
|
674 |
Cnil))))); |
Cnil))))); |
675 |
enter_mark_origin(&TSor_pathname_string_symbol_stream); |
enter_mark_origin(&TSor_pathname_string_symbol_stream); |
676 |
|
|
677 |
make_function("TYPE-OF", Ltype_of); |
make_si_function("TYPE-OF-C", siLtype_of_c); |
678 |
} |
} |