--- stack/stack.c 2002/03/17 11:26:35 1.115 +++ stack/stack.c 2002/03/20 05:29:29 1.117 @@ -1,3 +1,4 @@ +/* -*- coding: utf-8; -*- */ /* stack - an interactive interpreter for a stack-based language Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn @@ -20,8 +21,8 @@ Teddy Hogeborn */ -#define CAR(X) (X->content.c->car) -#define CDR(X) (X->content.c->cdr) +#define CAR(X) ((X)->content.c->car) +#define CDR(X) ((X)->content.c->cdr) /* printf, sscanf, fgets, fprintf, fopen, perror */ #include @@ -61,7 +62,6 @@ env->gc_ref= NULL; env->head= new_val(env); - env->head->type= empty; for(i= 0; isymbols[i]= NULL; env->err= 0; @@ -124,7 +124,7 @@ stackitem *nitem= malloc(sizeof(stackitem)); nval->content.ptr= NULL; - nval->type= integer; + nval->type= empty; nitem->item= nval; nitem->next= env->gc_ref; @@ -165,7 +165,6 @@ extern void gc_init(environment *env) { stackitem *new_head= NULL, *titem; - pair *iterator; symbol *tsymb; int i; @@ -195,8 +194,21 @@ if(!(env->gc_ref->item->gc.no_gc)){ /* neither mark nor protect */ - if(env->gc_ref->item->type==string) /* Remove content */ + /* Remove content */ + switch(env->gc_ref->item->type){ + case string: free(env->gc_ref->item->content.ptr); + break; + case tcons: + free(env->gc_ref->item->content.c); + break; + case empty: + case integer: + case tfloat: + case func: + case symb: + /* Symbol strings are freed when walking the hash table */ + } free(env->gc_ref->item); /* Remove from gc_ref */ titem= env->gc_ref->next; @@ -287,6 +299,7 @@ new_value->content.c= malloc(sizeof(pair)); assert(new_value->content.c!=NULL); + env->gc_count += sizeof(pair); new_value->type= tcons; CAR(new_value)= val; CDR(new_value)= env->head; @@ -485,8 +498,11 @@ } /* Print a value */ -void print_val(value *val, int noquote) +void print_val(value *val, int noquote, stackitem *stack) { + stackitem *titem, *tstack; + int depth; + switch(val->type) { case empty: printf("[]"); @@ -511,20 +527,55 @@ break; case tcons: printf("[ "); + tstack= stack; do { - print_val(CAR(val), noquote); + titem=malloc(sizeof(stackitem)); + titem->item=val; + titem->next=tstack; + tstack=titem; /* Put it on the stack */ + /* Search a stack of values being printed to see if we are already + printing this value */ + titem=tstack; + depth=0; + while(titem != NULL && titem->item != CAR(val)){ + titem=titem->next; + depth++; + } + if(titem != NULL){ /* If we found it on the stack, */ + printf("#%d#", depth); /* print a depth reference */ + } else { + print_val(CAR(val), noquote, tstack); + } val= CDR(val); switch(val->type){ case empty: break; case tcons: - printf(" "); + /* Search a stack of values being printed to see if we are already + printing this value */ + titem=tstack; + depth=0; + while(titem != NULL && titem->item != val){ + titem=titem->next; + depth++; + } + if(titem != NULL){ /* If we found it on the stack, */ + printf(" . #%d#", depth); /* print a depth reference */ + } else { + printf(" "); + } break; default: printf(" . "); /* Improper list */ - print_val(val, noquote); + print_val(val, noquote, tstack); } - } while(val->type == tcons); + } while(val->type == tcons && titem == NULL); + titem=tstack; + while(titem != stack){ + tstack=titem->next; + free(titem); + titem=tstack; + } printf(" ]"); break; } @@ -537,7 +588,7 @@ env->err= 1; return; } - print_val(CAR(env->head), 0); + print_val(CAR(env->head), 0, NULL); nl(); } @@ -556,7 +607,7 @@ env->err= 1; return; } - print_val(CAR(env->head), 1); + print_val(CAR(env->head), 1, NULL); } /* Prints the top element of the stack and then discards it. */ @@ -573,7 +624,7 @@ if(CDR(stack_head)->type != empty) print_st(CDR(stack_head), counter+1); printf("%ld: ", counter); - print_val(CAR(stack_head), 0); + print_val(CAR(stack_head), 0, NULL); nl(); } @@ -720,7 +771,10 @@ unprotect(temp_val); return; - default: + case empty: + case integer: + case tfloat: + case string: return; } } @@ -747,7 +801,6 @@ old_head= CAR(env->head); new_head= new_val(env); - new_head->type= empty; while(old_head->type != empty) { item= old_head; old_head= CDR(old_head); @@ -763,7 +816,6 @@ value *iterator, *temp, *ending; ending=new_val(env); - ending->type=empty; iterator= env->head; if(iterator->type == empty @@ -1049,7 +1101,7 @@ } if(myenv.interactive) { - printf("Stack version $Revision: 1.115 $\n\ + printf("Stack version $Revision: 1.117 $\n\ Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn\n\ Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\ This is free software, and you are welcome to redistribute it\n\ @@ -1324,6 +1376,7 @@ case integer: case func: case symb: + case empty: new_value->content= old_value->content; break; case string: @@ -1334,6 +1387,7 @@ new_value->content.c= malloc(sizeof(pair)); assert(new_value->content.c!=NULL); + env->gc_count += sizeof(pair); CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */ CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */ @@ -1691,7 +1745,7 @@ int count= -1; float ftemp; static int depth= 0; - char *match, *ctemp; + char *match; size_t inlength; if(env->in_string==NULL) { @@ -2367,6 +2421,8 @@ val=new_val(env); val->content.c= malloc(sizeof(pair)); assert(val->content.c!=NULL); + + env->gc_count += sizeof(pair); val->type=tcons; CAR(val)= CAR(CDR(env->head));