2004-07-16 02:26:21 -04:00
|
|
|
#include "factor.h"
|
|
|
|
|
|
|
|
CELL object_size(CELL pointer)
|
|
|
|
{
|
2004-08-05 20:29:52 -04:00
|
|
|
CELL size;
|
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
switch(TAG(pointer))
|
|
|
|
{
|
2004-08-06 02:51:32 -04:00
|
|
|
case FIXNUM_TYPE:
|
|
|
|
size = 0;
|
|
|
|
break;
|
2005-01-16 17:58:28 -05:00
|
|
|
case BIGNUM_TYPE:
|
|
|
|
size = ASIZE(UNTAG(pointer));
|
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
case CONS_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_CONS);
|
2004-08-05 20:29:52 -04:00
|
|
|
break;
|
2004-08-04 22:43:58 -04:00
|
|
|
case RATIO_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_RATIO);
|
2004-08-05 20:29:52 -04:00
|
|
|
break;
|
2005-01-16 17:58:28 -05:00
|
|
|
case FLOAT_TYPE:
|
|
|
|
size = sizeof(F_FLOAT);
|
|
|
|
break;
|
2004-08-05 20:29:52 -04:00
|
|
|
case COMPLEX_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_COMPLEX);
|
2004-08-05 20:29:52 -04:00
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
case OBJECT_TYPE:
|
2004-08-05 20:29:52 -04:00
|
|
|
size = untagged_object_size(UNTAG(pointer));
|
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
default:
|
2004-07-20 02:59:32 -04:00
|
|
|
critical_error("Cannot determine size",pointer);
|
2004-08-05 20:29:52 -04:00
|
|
|
size = 0; /* Can't happen */
|
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
2004-08-05 20:29:52 -04:00
|
|
|
|
|
|
|
return align8(size);
|
2004-07-16 02:26:21 -04:00
|
|
|
}
|
|
|
|
|
|
|
|
CELL untagged_object_size(CELL pointer)
|
|
|
|
{
|
|
|
|
CELL size;
|
2004-09-08 02:31:03 -04:00
|
|
|
|
|
|
|
if(pointer == F)
|
|
|
|
return 0;
|
|
|
|
|
2004-07-16 02:26:21 -04:00
|
|
|
switch(untag_header(get(pointer)))
|
|
|
|
{
|
2004-07-27 23:29:37 -04:00
|
|
|
case WORD_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_WORD);
|
2004-08-27 02:09:24 -04:00
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
case T_TYPE:
|
|
|
|
size = CELLS * 2;
|
|
|
|
break;
|
|
|
|
case ARRAY_TYPE:
|
2004-08-24 23:46:55 -04:00
|
|
|
case BIGNUM_TYPE:
|
2005-01-29 16:39:30 -05:00
|
|
|
case TUPLE_TYPE:
|
2004-07-16 02:26:21 -04:00
|
|
|
size = ASIZE(pointer);
|
|
|
|
break;
|
2005-01-27 20:06:10 -05:00
|
|
|
case HASHTABLE_TYPE:
|
|
|
|
size = sizeof(F_HASHTABLE);
|
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
case VECTOR_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_VECTOR);
|
2004-07-16 02:26:21 -04:00
|
|
|
break;
|
|
|
|
case STRING_TYPE:
|
|
|
|
size = SSIZE(pointer);
|
|
|
|
break;
|
|
|
|
case SBUF_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_SBUF);
|
2004-07-16 02:26:21 -04:00
|
|
|
break;
|
2004-08-05 17:33:02 -04:00
|
|
|
case FLOAT_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_FLOAT);
|
2004-08-05 17:33:02 -04:00
|
|
|
break;
|
2004-08-12 17:36:36 -04:00
|
|
|
case PORT_TYPE:
|
2004-12-10 21:46:42 -05:00
|
|
|
size = sizeof(F_PORT);
|
2004-07-24 00:54:57 -04:00
|
|
|
break;
|
2004-09-18 18:15:01 -04:00
|
|
|
case DLL_TYPE:
|
|
|
|
size = sizeof(DLL);
|
|
|
|
break;
|
2004-09-19 17:39:28 -04:00
|
|
|
case ALIEN_TYPE:
|
|
|
|
size = sizeof(ALIEN);
|
|
|
|
break;
|
2004-07-16 02:26:21 -04:00
|
|
|
default:
|
2004-12-25 02:55:03 -05:00
|
|
|
critical_error("Cannot determine size",pointer);
|
2004-07-16 02:26:21 -04:00
|
|
|
size = -1;/* can't happen */
|
|
|
|
break;
|
|
|
|
}
|
|
|
|
|
|
|
|
return align8(size);
|
|
|
|
}
|
2004-08-06 02:51:32 -04:00
|
|
|
|
2004-09-18 22:29:29 -04:00
|
|
|
void primitive_type(void)
|
2004-08-06 02:51:32 -04:00
|
|
|
{
|
2004-08-12 17:36:36 -04:00
|
|
|
drepl(tag_fixnum(type_of(dpeek())));
|
2004-08-06 02:51:32 -04:00
|
|
|
}
|
2004-12-24 02:52:02 -05:00
|
|
|
|
|
|
|
#define SLOT(obj,slot) UNTAG(obj) + slot * CELLS
|
|
|
|
|
|
|
|
void primitive_slot(void)
|
|
|
|
{
|
|
|
|
F_FIXNUM slot = untag_fixnum_fast(dpop());
|
|
|
|
CELL obj = dpop();
|
|
|
|
dpush(get(SLOT(obj,slot)));
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_set_slot(void)
|
|
|
|
{
|
|
|
|
F_FIXNUM slot = untag_fixnum_fast(dpop());
|
|
|
|
CELL obj = dpop();
|
|
|
|
CELL value = dpop();
|
|
|
|
put(SLOT(obj,slot),value);
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_integer_slot(void)
|
|
|
|
{
|
|
|
|
F_FIXNUM slot = untag_fixnum_fast(dpop());
|
|
|
|
CELL obj = dpop();
|
|
|
|
dpush(tag_integer(get(SLOT(obj,slot))));
|
|
|
|
}
|
|
|
|
|
|
|
|
void primitive_set_integer_slot(void)
|
|
|
|
{
|
|
|
|
F_FIXNUM slot = untag_fixnum_fast(dpop());
|
|
|
|
CELL obj = dpop();
|
2005-01-18 21:42:29 -05:00
|
|
|
F_FIXNUM value = to_fixnum(dpop());
|
2004-12-24 02:52:02 -05:00
|
|
|
put(SLOT(obj,slot),value);
|
|
|
|
}
|