/[cvs]/stack/stack.c
ViewVC logotype

Diff of /stack/stack.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.109 by masse, Thu Mar 14 10:39:11 2002 UTC revision 1.110 by teddy, Sat Mar 16 09:12:39 2002 UTC
# Line 188  extern void gc_init(environment *env) Line 188  extern void gc_init(environment *env)
188    if(env->interactive)    if(env->interactive)
189      printf(".");      printf(".");
190    
   
191    env->gc_count= 0;    env->gc_count= 0;
192    
193    while(env->gc_ref!=NULL) {    /* Sweep unused values */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
# Line 203  extern void gc_init(environment *env) Line 202  extern void gc_init(environment *env)
202        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
203        env->gc_ref= titem;        env->gc_ref= titem;
204        continue;        continue;
205      }      }
206    #ifdef DEBUG
207        printf("Kept value (%p)", env->gc_ref->item);
208        if(env->gc_ref->item->gc.flag.mark)
209          printf(" (marked)");
210        if(env->gc_ref->item->gc.flag.protect)
211          printf(" (protected)");
212        switch(env->gc_ref->item->type){
213        case integer:
214          printf(" integer: %d", env->gc_ref->item->content.i);
215          break;
216        case func:
217          printf(" func: %p", env->gc_ref->item->content.ptr);
218          break;
219        case symb:
220          printf(" symb: %s", env->gc_ref->item->content.sym->id);
221          break;
222        case tcons:
223          printf(" tcons: %p\t%p", env->gc_ref->item->content.c->car,
224                 env->gc_ref->item->content.c->cdr);
225          break;
226        default:
227          printf(" <unknown %d>", (env->gc_ref->item->type));
228        }
229        printf("\n");
230    #endif /* DEBUG */
231    
232      /* Keep values */          /* Keep values */    
233      env->gc_count += sizeof(value);      env->gc_count += sizeof(value);
# Line 223  extern void gc_init(environment *env) Line 247  extern void gc_init(environment *env)
247    env->gc_ref= new_head;    env->gc_ref= new_head;
248    
249    if(env->interactive)    if(env->interactive)
250      printf("done\n");      printf("done (%d bytes still allocated)\n", env->gc_count);
251    
252  }  }
253    
# Line 607  extern void rcl(environment *env) Line 631  extern void rcl(environment *env)
631      env->err= 3;      env->err= 3;
632      return;      return;
633    }    }
634    protect(val);    push_val(env, val);           /* Return the symbol's bound value */
635    toss(env);            /* toss the symbol */    swap(env);
636      if(env->err) return;
637      toss(env);                    /* toss the symbol */
638    if(env->err) return;    if(env->err) return;
   push_val(env, val); /* Return its bound value */  
   unprotect(val);  
639  }  }
640    
641  /* If the top element is a symbol, determine if it's bound to a  /* If the top element is a symbol, determine if it's bound to a
# Line 672  extern void eval(environment *env) Line 696  extern void eval(environment *env)
696          eval(env);          eval(env);
697          if(env->err) return;          if(env->err) return;
698        }        }
699        if (CDR(iterator)->type == tcons)        if (CDR(iterator)==NULL || CDR(iterator)->type == tcons)
700          iterator= CDR(iterator);          iterator= CDR(iterator);
701        else {        else {
702          printerr("Bad Argument Type"); /* Improper list */          printerr("Bad Argument Type"); /* Improper list */
# Line 887  extern void quit(environment *env) Line 911  extern void quit(environment *env)
911    env->gc_limit= 0;    env->gc_limit= 0;
912    gc_maybe(env);    gc_maybe(env);
913    
914      words(env);
915    
916    if(env->free_string!=NULL)    if(env->free_string!=NULL)
917      free(env->free_string);      free(env->free_string);
918        
# Line 913  extern void words(environment *env) Line 939  extern void words(environment *env)
939    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
940      temp= env->symbols[i];      temp= env->symbols[i];
941      while(temp!=NULL) {      while(temp!=NULL) {
942    #ifdef DEBUG
943          if (temp->val != NULL && temp->val->gc.flag.protect)
944            printf("(protected) ");
945    #endif /* DEBUG */
946        printf("%s\n", temp->id);        printf("%s\n", temp->id);
947        temp= temp->next;        temp= temp->next;
948      }      }
# Line 983  int main(int argc, char **argv) Line 1013  int main(int argc, char **argv)
1013          break;          break;
1014        case '?':        case '?':
1015          fprintf (stderr,          fprintf (stderr,
1016                   "Unknown option character `\\x%x'.\n",                   "Unknown option character '\\x%x'.\n",
1017                   optopt);                   optopt);
1018          return EX_USAGE;          return EX_USAGE;
1019        default:        default:
# Line 1002  int main(int argc, char **argv) Line 1032  int main(int argc, char **argv)
1032    if(myenv.interactive) {    if(myenv.interactive) {
1033      printf("Stack version $Revision$\n\      printf("Stack version $Revision$\n\
1034  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
1035  Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\n\  Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
1036  This is free software, and you are welcome to redistribute it\n\  This is free software, and you are welcome to redistribute it\n\
1037  under certain conditions; type `copying;' for details.\n");  under certain conditions; type 'copying;' for details.\n");
1038    }    }
1039    
1040    while(1) {    while(1) {
# Line 1019  under certain conditions; type `copying; Line 1049  under certain conditions; type `copying;
1049        }        }
1050        myenv.err=0;        myenv.err=0;
1051      }      }
1052      sx_72656164(&myenv);      sx_72656164(&myenv);        /* "read" */
1053      if (myenv.err==4) {      if (myenv.err==4) {         /* EOF */
1054        return EXIT_SUCCESS;      /* EOF */        myenv.err=0;
1055          quit(&myenv);
1056      } else if(myenv.head!=NULL      } else if(myenv.head!=NULL
1057                && CAR(myenv.head)->type==symb                && CAR(myenv.head)->type==symb
1058                && CAR(myenv.head)->content.sym->id[0]                && CAR(myenv.head)->content.sym->id[0]
Legend:
Removed from v.1.109  
changed lines
  Added in v.1.110
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26