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

Diff of /stack/stack.c

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

revision 1.107 by masse, Tue Mar 12 21:05:11 2002 UTC revision 1.110 by teddy, Sat Mar 16 09:12:39 2002 UTC
# Line 37  Line 37 
37  #include <unistd.h>  #include <unistd.h>
38  /* EX_NOINPUT, EX_USAGE */  /* EX_NOINPUT, EX_USAGE */
39  #include <sysexits.h>  #include <sysexits.h>
40    /* assert */
41    #include <assert.h>
42    
43  #ifdef __linux__  #ifdef __linux__
44  /* mtrace, muntrace */  /* mtrace, muntrace */
# Line 121  value* new_val(environment *env) Line 123  value* new_val(environment *env)
123    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
124    
125    nval->content.ptr= NULL;    nval->content.ptr= NULL;
126      nval->type= integer;
127    
128    nitem->item= nval;    nitem->item= nval;
129    nitem->next= env->gc_ref;    nitem->next= env->gc_ref;
# Line 185  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 200  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 220  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 258  void push_val(environment *env, value *v Line 285  void push_val(environment *env, value *v
285    value *new_value= new_val(env);    value *new_value= new_val(env);
286    
287    new_value->content.c= malloc(sizeof(cons));    new_value->content.c= malloc(sizeof(cons));
288      assert(new_value->content.c!=NULL);
289    new_value->type= tcons;    new_value->type= tcons;
290    CAR(new_value)= val;    CAR(new_value)= val;
291    CDR(new_value)= env->head;    CDR(new_value)= env->head;
# Line 603  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 668  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 883  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 909  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 979  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 998  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 1015  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]
# Line 1263  value *copy_val(environment *env, value Line 1298  value *copy_val(environment *env, value
1298    
1299    protect(old_value);    protect(old_value);
1300    new_value= new_val(env);    new_value= new_val(env);
   protect(new_value);  
1301    new_value->type= old_value->type;    new_value->type= old_value->type;
1302    
1303    switch(old_value->type){    switch(old_value->type){
# Line 1278  value *copy_val(environment *env, value Line 1312  value *copy_val(environment *env, value
1312        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1313      break;      break;
1314    case tcons:    case tcons:
     new_value= NULL;  
1315    
1316      new_value->content.c= malloc(sizeof(cons));      new_value->content.c= malloc(sizeof(cons));
1317        assert(new_value->content.c!=NULL);
1318    
1319      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
1320      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */
1321      break;      break;
1322    }    }
1323    
1324    unprotect(old_value); unprotect(new_value);    unprotect(old_value);
1325    
1326    return new_value;    return new_value;
1327  }  }
# Line 1372  extern void ifelse(environment *env) Line 1407  extern void ifelse(environment *env)
1407  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
1408  {  {
1409    if(env->head==NULL || CDR(env->head)==NULL    if(env->head==NULL || CDR(env->head)==NULL
1410       || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL) {       || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL
1411         || CDR(CDR(CDR(CDR(env->head))))==NULL) {
1412        printerr("Too Few Arguments");
1413        env->err= 1;
1414        return;
1415      }
1416    
1417      if(CAR(CDR(env->head))->type!=symb
1418         || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
1419         || CAR(CDR(CDR(CDR(env->head))))->type!=symb
1420         || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {
1421        printerr("Bad Argument Type");
1422        env->err= 2;
1423        return;
1424      }
1425    
1426      swap(env); toss(env); rot(env); toss(env);
1427      ifelse(env);
1428    }
1429    
1430    extern void then(environment *env)
1431    {
1432      if(env->head==NULL || CDR(env->head)==NULL
1433         || CDR(CDR(env->head))==NULL) {
1434      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1435      env->err= 1;      env->err= 1;
1436      return;      return;
# Line 1386  extern void sx_656c7365(environment *env Line 1444  extern void sx_656c7365(environment *env
1444    }    }
1445    
1446    swap(env); toss(env);    swap(env); toss(env);
1447    ifelse(env);    sx_6966(env);
1448  }  }
1449    
1450  /* "while" */  /* "while" */
Legend:
Removed from v.1.107  
changed lines
  Added in v.1.110
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26