static void print1(ptr x, int d) {
if (TAG(x, mask_fixnum) == tag_fixnum) {
printf("%ld", (long)UNFIX(x));
} else if (TAG(x, mask_pair) == tag_pair) {
int len = 0;
ptr y;
if (d > MAXDEPTH) {
printf("(...)");
return;
}
printf("(");
print1(CAR(x), d+1);
y = CDR(x);
while (TAG(y, mask_pair) == tag_pair && (len < MAXLENGTH-1)) {
printf(" ");
print1(CAR(y), d+1);
y = CDR(y);
len++;
}
if (y != _nil)
if (len == MAXLENGTH-1)
printf(" ...");
else {
printf(" . ");
print1(y, d+1);
}
printf(")");
} else if (TAG(x, mask_vector) == tag_vector) {
long i, n;
ptr *p;
if (d > MAXDEPTH) {
printf("#(...)");
return;
}
printf("#(");
n = UNFIX(VECTORLENGTH(x));
p = VECTORDATA(x);
i = n > MAXLENGTH ? MAXLENGTH : n;
if (i != 0) {
print1(*p, d+1);
while (--i) {
printf(" ");
print1(*++p, d+1);
}
}
if (n > MAXLENGTH) printf(" ...");
printf(")");
} else if (TAG(x, mask_procedure) == tag_procedure) {
printf("#<procedure>");
} else if (x == _false) {
printf("#f");
} else if (x == _true) {
printf("#t");
} else if (x == _nil) {
printf("()");
} else if (x == _void) {
printf("#<void>");
} else {
fprintf(stderr, "print (runtime.c): invalid ptr #x%x\n", (unsigned int) x);
exit(1);
}
}
static void print(Ptr ptr)
{
switch (TAG(ptr)) {
case number_tag:
printf("%ld", ptr/(mask+1)); break;
case immed_tag:
switch (IMMTAG(ptr)) {
case bool_tag:
printf((ptr>>imm_tag_len) ? "#t" : "#f"); break;
case null_tag:
printf("()"); break;
case char_tag:
switch (ptr>>imm_tag_len) {
case '\n':
printf("#\\newline"); break;
case ' ':
printf("#\\space"); break;
case 9:
printf("#\\tab"); break;
default:
printf("#\\%c", (char)(ptr>>imm_tag_len)); break;
}
break;
}
break;
case pair_tag:
printf("(");
print(CAR(ptr));
ptr = CDR(ptr);
while (TAG(ptr) == pair_tag) {
printf(" ");
print(CAR(ptr));
ptr = CDR(ptr);
}
if (IMMTAG(ptr) != null_tag) {
printf(" . ");
print(ptr);
}
printf(")");
break;
case string_tag:
printf("\"");
print_string(ptr);
printf("\"");
break;
case symbol_tag:
print_string(SYMBOLNAME(ptr));
break;
case vector_tag:
{
int n;
Ptr *p;
printf("#(");
n = OBJLENGTH(ptr);
p = VECTORDATA(ptr);
if (n != 0) {
print(*p);
while (--n) {
printf(" ");
print(*++p);
}
}
printf(")");
break;
}
case proc_tag:
printf("<procedure>");
break;
case float_tag:
{
Ptr x = UNTAG(ptr);
printf("%f", *(float *)&x);
break;
}
default:
printf("#<garbage %x>", (unsigned int)ptr);
break;
}
}
