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

Diff of /stack/stack.c

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

revision 1.39 by teddy, Wed Feb 6 11:39:20 2002 UTC revision 1.46 by masse, Thu Feb 7 03:56:39 2002 UTC
# Line 57  typedef struct { Line 57  typedef struct {
57    stackitem *head;              /* Head of the stack */    stackitem *head;              /* Head of the stack */
58    hashtbl symbols;              /* Hash table of all variable bindings */    hashtbl symbols;              /* Hash table of all variable bindings */
59    int err;                      /* Error flag */    int err;                      /* Error flag */
60      int non_eval_flag;
61  } environment;  } environment;
62    
63  /* A type for pointers to external functions */  /* A type for pointers to external functions */
# Line 66  typedef void (*funcp)(environment *); /* Line 67  typedef void (*funcp)(environment *); /*
67  /* Initialize a newly created environment */  /* Initialize a newly created environment */
68  void init_env(environment *env)  void init_env(environment *env)
69  {  {
70    long i;    int i;
71    
72    env->err=0;    env->err= 0;
73      env->non_eval_flag= 0;
74    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
75      env->symbols[i]= NULL;      env->symbols[i]= NULL;
76  }  }
# Line 76  void init_env(environment *env) Line 78  void init_env(environment *env)
78  /* Returns a pointer to a pointer to an element in the hash table. */  /* Returns a pointer to a pointer to an element in the hash table. */
79  symbol **hash(hashtbl in_hashtbl, const char *in_string)  symbol **hash(hashtbl in_hashtbl, const char *in_string)
80  {  {
81    long i= 0;    int i= 0;
82    unsigned long out_hash= 0;    unsigned int out_hash= 0;
83    char key= '\0';    char key= '\0';
84    symbol **position;    symbol **position;
85        
# Line 301  void print_h(stackitem *stack_head) Line 303  void print_h(stackitem *stack_head)
303      printf("\"%s\"", (char*)stack_head->item->content.ptr);      printf("\"%s\"", (char*)stack_head->item->content.ptr);
304      break;      break;
305    case symb:    case symb:
306      printf("'%s'", ((symbol *)(stack_head->item->content.ptr))->id);      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);
307      break;      break;
308    case func:    case func:
309      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));      printf("#<function %p>", (funcp)(stack_head->item->content.ptr));
# Line 350  void print_st(stackitem *stack_head, lon Line 352  void print_st(stackitem *stack_head, lon
352    nl();    nl();
353  }  }
354    
   
   
355  /* Prints the stack. */  /* Prints the stack. */
356  extern void printstack(environment *env)  extern void printstack(environment *env)
357  {  {
# Line 367  extern void swap(environment *env) Line 367  extern void swap(environment *env)
367  {  {
368    stackitem *temp= env->head;    stackitem *temp= env->head;
369        
370    if((env->head)==NULL) {    if(env->head==NULL || env->head->next==NULL) {
     printerr("Too Few Arguments");  
     env->err=1;  
     return;  
   }  
   
   if(env->head->next==NULL) {  
371      printerr("Too Few Arguments");      printerr("Too Few Arguments");
372      env->err=1;      env->err=1;
373      return;      return;
# Line 384  extern void swap(environment *env) Line 378  extern void swap(environment *env)
378    env->head->next= temp;    env->head->next= temp;
379  }  }
380    
 stackitem* copy(stackitem* in_item)  
 {  
   stackitem *out_item= malloc(sizeof(stackitem));  
   
   memcpy(out_item, in_item, sizeof(stackitem));  
   out_item->next= NULL;  
   
   return out_item;  
 }  
   
381  /* Recall a value from a symbol, if bound */  /* Recall a value from a symbol, if bound */
382  extern void rcl(environment *env)  extern void rcl(environment *env)
383  {  {
# Line 422  extern void rcl(environment *env) Line 406  extern void rcl(environment *env)
406    push_val(&(env->head), val); /* Return its bound value */    push_val(&(env->head), val); /* Return its bound value */
407  }  }
408    
409    extern void pack(environment*);
410    void stack_read(environment*, char*);
411    
412    
413  /* 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
414     function value, and if it is, toss the symbol and execute the     function value, and if it is, toss the symbol and execute the
415     function. */     function. */
416  extern void eval(environment *env)  extern void eval(environment *env)
417  {  {
418    funcp in_func;    funcp in_func;
419      value* temp_val;
420      stackitem* iterator;
421    
422    if(env->head==NULL) {    if(env->head==NULL) {
423      printerr("Too Few Arguments");      printerr("Too Few Arguments");
424      env->err=1;      env->err=1;
425      return;      return;
426    }    }
427    
428    /* if it's a symbol */    switch(env->head->item->type) {
429    if(env->head->item->type==symb) {      /* if it's a symbol */
430      case symb:
431      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
432      if(env->err) return;      if(env->err) return;
433      if(env->head->item->type!=symb){ /* don't recurse symbols */      if(env->head->item->type!=symb){ /* don't recurse symbols */
434        eval(env);                        /* evaluate the value */        eval(env);                        /* evaluate the value */
435        return;        return;
436      }      }
437    }      break;
438    
439    /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
440    if(env->head->item->type==func) {    case func:
441      in_func= (funcp)(env->head->item->content.ptr);      in_func= (funcp)(env->head->item->content.ptr);
442      toss(env);      toss(env);
443      if(env->err) return;      if(env->err) return;
444      (*in_func)(env);      (*in_func)(env);
445        break;
446    
447        /* If it's a list */
448      case list:
449        temp_val= env->head->item;
450        env->head->item->refcount++;
451        toss(env);
452        if(env->err) return;
453        iterator= (stackitem*)temp_val->content.ptr;
454        while(iterator!=NULL && iterator->item!=NULL) {
455          push_val(&(env->head), iterator->item);
456          if(env->head->item->type==symb
457            && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {
458            toss(env);
459            if(env->err) return;
460            eval(env);
461            if(env->err) return;
462          }
463          iterator= iterator->next;
464        }
465        free_val(temp_val);
466        break;
467    
468        /* If it's a string */
469      case string:
470        temp_val= env->head->item;
471        env->head->item->refcount++;
472        toss(env);
473        if(env->err) return;
474        push_sym(env, "[");
475        env->non_eval_flag++;
476        stack_read(env, (char*)temp_val->content.ptr);
477        env->non_eval_flag--;
478        push_sym(env, "["); pack(env);
479        if(env->err) return;
480        eval(env);
481        if(env->err) return;
482        free_val(temp_val);
483        break;
484    
485      default:
486    }    }
487  }  }
488    
489    /* Reverse (flip) a list */
490    extern void rev(environment *env){
491      stackitem *old_head, *new_head, *item;
492    
493      if((env->head)==NULL) {
494        printerr("Too Few Arguments");
495        env->err=1;
496        return;
497      }
498    
499      if(env->head->item->type!=list) {
500        printerr("Bad Argument Type");
501        env->err=2;
502        return;
503      }
504    
505      old_head=(stackitem *)(env->head->item->content.ptr);
506      new_head=NULL;
507      while(old_head != NULL){
508        item=old_head;
509        old_head=old_head->next;
510        item->next=new_head;
511        new_head=item;
512      }
513      env->head->item->content.ptr=new_head;
514    }
515    
516  /* Make a list. */  /* Make a list. */
517  extern void pack(environment *env)  extern void pack(environment *env)
518  {  {
# Line 494  extern void pack(environment *env) Line 553  extern void pack(environment *env)
553    temp->item= pack;    temp->item= pack;
554    
555    push(&(env->head), temp);    push(&(env->head), temp);
556      rev(env);
557  }  }
558    
559  /* Parse input. */  /* Parse input. */
# Line 503  void stack_read(environment *env, char * Line 563  void stack_read(environment *env, char *
563    int itemp;    int itemp;
564    size_t inlength= strlen(in_line)+1;    size_t inlength= strlen(in_line)+1;
565    int convert= 0;    int convert= 0;
   static int non_eval_flag= 0;  
566    
567    temp= malloc(inlength);    temp= malloc(inlength);
568    rest= malloc(inlength);    rest= malloc(inlength);
569    
570    do {    do {
571        /* If comment */
572        if((convert= sscanf(in_line, "#%[^\n\r]", rest))) {
573          free(temp); free(rest);
574          return;
575        }
576    
577      /* If string */      /* If string */
578      if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest))) {      if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest))) {
579        push_cstring(&(env->head), temp);        push_cstring(&(env->head), temp);
# Line 533  void stack_read(environment *env, char * Line 598  void stack_read(environment *env, char *
598      /* If single char */      /* If single char */
599      if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest))) {      if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest))) {
600        if(*temp==';') {        if(*temp==';') {
601          if(!non_eval_flag) {          if(!env->non_eval_flag) {
602            eval(env);            /* Evaluate top element */            eval(env);            /* Evaluate top element */
603            break;            break;
604          }          }
# Line 545  void stack_read(environment *env, char * Line 610  void stack_read(environment *env, char *
610        if(*temp==']') {        if(*temp==']') {
611          push_sym(env, "[");          push_sym(env, "[");
612          pack(env);          pack(env);
613          if(non_eval_flag!=0)          if(env->non_eval_flag)
614            non_eval_flag--;            env->non_eval_flag--;
615          break;          break;
616        }        }
617    
618        if(*temp=='[') {        if(*temp=='[') {
619          push_sym(env, "[");          push_sym(env, "[");
620          non_eval_flag++;          env->non_eval_flag++;
621          break;          break;
622        }        }
623      }      }
# Line 587  extern void expand(environment *env) Line 652  extern void expand(environment *env)
652      return;      return;
653    }    }
654    
655      rev(env);
656    
657      if(env->err)
658        return;
659    
660    /* The first list element is the new stack head */    /* The first list element is the new stack head */
661    new_head= temp= env->head->item->content.ptr;    new_head= temp= env->head->item->content.ptr;
662    
# Line 603  extern void expand(environment *env) Line 673  extern void expand(environment *env)
673    
674  }  }
675    
 /* Reverse a list */  
 extern void rev(environment *env){  
   stackitem *old_head, *new_head, *item;  
   
   if((env->head)==NULL) {  
     printerr("Too Few Arguments");  
     env->err=1;  
     return;  
   }  
   
   if(env->head->item->type!=list) {  
     printerr("Bad Argument Type");  
     env->err=2;  
     return;  
   }  
   
   old_head=(stackitem *)(env->head->item->content.ptr);  
   new_head=NULL;  
   while(old_head != NULL){  
     item=old_head;  
     old_head=old_head->next;  
     item->next=new_head;  
     new_head=item;  
   }  
   env->head->item->content.ptr=new_head;  
 }  
   
676  /* Compares two elements by reference. */  /* Compares two elements by reference. */
677  extern void eq(environment *env)  extern void eq(environment *env)
678  {  {
# Line 796  int main() Line 839  int main()
839      }      }
840      printf("okidok\n ");      printf("okidok\n ");
841    }    }
842      quit(&myenv);
843    exit(EXIT_SUCCESS);    return EXIT_FAILURE;
844  }  }
Legend:
Removed from v.1.39  
changed lines
  Added in v.1.46
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26