89 lines
2.1 KiB
C
89 lines
2.1 KiB
C
/* Built-in and user-defined Scheme types.
|
|
*/
|
|
|
|
#include "kernel.h"
|
|
|
|
#include <string.h>
|
|
|
|
#define TYPE_GROW 10
|
|
|
|
TYPEDESCR *Types;
|
|
int Num_Types, Max_Type;
|
|
|
|
char *builtin_types[] = {
|
|
"0integer", "1integer" /* bignum */, "1real", "0null", "0boolean",
|
|
"0unbound", "0special", "0character", "1symbol", "1pair",
|
|
"1environment", "1string", "1vector", "1primitive", "1compound",
|
|
"1control-point", "1promise", "1port", "0end-of-file", "1autoload",
|
|
"1macro", "1!!broken-heart!!",
|
|
#ifdef GENERATIONAL_GC
|
|
"0align_8byte", "0freespace",
|
|
#endif
|
|
0
|
|
};
|
|
|
|
void Wrong_Type (Object x, register int t) {
|
|
Wrong_Type_Combination (x, Types[t].name);
|
|
}
|
|
|
|
void Wrong_Type_Combination (Object x, register char const *name) {
|
|
register int t = TYPE(x);
|
|
char buf[100];
|
|
|
|
if (t < 0 || t >= Num_Types)
|
|
Panic ("bad type1");
|
|
sprintf (buf, "wrong argument type %s (expected %s)",
|
|
Types[t].name, name);
|
|
Primitive_Error (buf);
|
|
}
|
|
|
|
Object P_Type (Object x) {
|
|
register int t = TYPE(x);
|
|
|
|
if (t < 0 || t >= Num_Types)
|
|
Panic ("bad type2");
|
|
return Intern (Types[t].name);
|
|
}
|
|
|
|
int Define_Type (register int t, char const *name,
|
|
int (*size)(), int const_size, int (*eqv)(), int (*equal)(),
|
|
int (*print)(), int (*visit)()) {
|
|
register TYPEDESCR *p;
|
|
|
|
Set_Error_Tag ("define-type");
|
|
if (t != 0)
|
|
Fatal_Error("first arg of Define_Type() must be 0");
|
|
if (Num_Types == Max_Type) {
|
|
Max_Type += TYPE_GROW;
|
|
Types = (TYPEDESCR *)Safe_Realloc((char *)Types,
|
|
Max_Type * sizeof(TYPEDESCR));
|
|
}
|
|
Disable_Interrupts;
|
|
p = &Types[Num_Types++];
|
|
p->haspointer = 1;
|
|
p->name = name;
|
|
p->size = size;
|
|
p->const_size = const_size;
|
|
p->eqv = eqv;
|
|
p->equal = equal;
|
|
p->print = print;
|
|
p->visit = visit;
|
|
Enable_Interrupts;
|
|
return Num_Types-1;
|
|
}
|
|
|
|
void Init_Type() {
|
|
int i, bytes;
|
|
char *p;
|
|
|
|
Num_Types = (sizeof(builtin_types) - 1) / sizeof(char *);
|
|
Max_Type = Num_Types + TYPE_GROW;
|
|
bytes = Max_Type * sizeof(TYPEDESCR);
|
|
Types = (TYPEDESCR *)Safe_Malloc(bytes);
|
|
memset(Types, 0, bytes);
|
|
for (i = 0; (p = builtin_types[i]); i++) {
|
|
Types[i].haspointer = *p != '0';
|
|
Types[i].name = ++p;
|
|
}
|
|
}
|