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

Diff of /stack/stack.c

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

revision 1.28 by teddy, Mon Feb 4 21:47:26 2002 UTC revision 1.31 by teddy, Tue Feb 5 22:25:04 2002 UTC
# Line 110  int push(stackitem** stack_head, stackit Line 110  int push(stackitem** stack_head, stackit
110    return 1;    return 1;
111  }  }
112    
113    /* Push a value onto the stack */
114    void push_val(stackitem **stack_head, value *val)
115    {
116      stackitem *new_item= malloc(sizeof(stackitem));
117      new_item->item= val;
118      val->refcount++;
119      push(stack_head, new_item);
120    }
121    
122  /* Push an integer onto the stack. */  /* Push an integer onto the stack. */
123  int push_val(stackitem **stack_head, int in_val)  int push_int(stackitem **stack_head, int in_val)
124  {  {
125    value *new_value= malloc(sizeof(value));    value *new_value= malloc(sizeof(value));
126    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *new_item= malloc(sizeof(stackitem));
# Line 148  int push_sym(environment *env, const cha Line 157  int push_sym(environment *env, const cha
157    /* ...which will contain... */    /* ...which will contain... */
158    value *new_value;             /* A new symbol value */    value *new_value;             /* A new symbol value */
159    /* ...which might point to... */    /* ...which might point to... */
160    symbol *new_symbol;           /* (if needed) A new actual symbol */    symbol **new_symbol;          /* (if needed) A new actual symbol */
161    /* ...which, if possible, will be bound to... */    /* ...which, if possible, will be bound to... */
162    value *new_fvalue;            /* (if needed) A new function value */    value *new_fvalue;            /* (if needed) A new function value */
163    /* ...which will point to... */    /* ...which will point to... */
# Line 166  int push_sym(environment *env, const cha Line 175  int push_sym(environment *env, const cha
175    new_value->refcount= 1;    new_value->refcount= 1;
176    
177    /* Look up the symbol name in the hash table */    /* Look up the symbol name in the hash table */
178    new_value->content.ptr= *hash(env->symbols, in_string);    new_symbol= hash(env->symbols, in_string);
179      new_value->content.ptr= *new_symbol;
180    
181    if(new_value->content.ptr==NULL) { /* If symbol was undefined */    if(*new_symbol==NULL) { /* If symbol was undefined */
182    
183      /* Create a new symbol */      /* Create a new symbol */
184      new_symbol= malloc(sizeof(symbol));      (*new_symbol)= malloc(sizeof(symbol));
185      new_symbol->val= NULL;      /* undefined value */      (*new_symbol)->val= NULL;   /* undefined value */
186      new_symbol->next= NULL;      (*new_symbol)->next= NULL;
187      new_symbol->id= malloc(strlen(in_string)+1);      (*new_symbol)->id= malloc(strlen(in_string)+1);
188      strcpy(new_symbol->id, in_string);      strcpy((*new_symbol)->id, in_string);
189    
190      /* Intern the new symbol in the hash table */      /* Intern the new symbol in the hash table */
191      new_value->content.ptr= new_symbol;      new_value->content.ptr= *new_symbol;
192    
193      /* Try to load the symbol name as an external function, to see if      /* Try to load the symbol name as an external function, to see if
194         we should bind the symbol to a new function pointer value */         we should bind the symbol to a new function pointer value */
# Line 190  int push_sym(environment *env, const cha Line 200  int push_sym(environment *env, const cha
200        new_fvalue= malloc(sizeof(value)); /* Create a new value */        new_fvalue= malloc(sizeof(value)); /* Create a new value */
201        new_fvalue->type=func;    /* The new value is a function pointer */        new_fvalue->type=func;    /* The new value is a function pointer */
202        new_fvalue->content.ptr=funcptr; /* Store function pointer */        new_fvalue->content.ptr=funcptr; /* Store function pointer */
203        new_symbol->val= new_fvalue;      /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
204                                             function value */                                           function value */
205        new_fvalue->refcount= 1;        new_fvalue->refcount= 1;
206      }      }
207    }    }
# Line 338  stackitem* copy(stackitem* in_item) Line 348  stackitem* copy(stackitem* in_item)
348    return out_item;    return out_item;
349  }  }
350    
351    extern void rcl(environment *env)
 /* If the top element is a reference, determine if it's a reference to a  
    function, and if it is, toss the reference and execute the function. */  
 extern void eval(environment *env)  
352  {  {
353    funcp in_func;    value *val;
   stackitem* temp= env->head;  
354    
355    if(temp==NULL) {    if(env->head == NULL) {
356      printerr("Stack empty");      printerr("Stack empty");
357      return;      return;
358    }    }
359    
360    if(temp->item->type==symb    if(env->head->item->type!=symb) {
361       && ((symbol *)(temp->item->content.ptr))->val != NULL      printerr("Not a symbol");
362       && ((symbol *)(temp->item->content.ptr))->val->type == func) {      return;
363      in_func= (funcp)(((symbol *)(temp->item->content.ptr))->val->content.ptr);    }
364      toss(env);    val=((symbol *)(env->head->item->content.ptr))->val;
365      (*in_func)(env);    toss(env);            /* toss the symbol */
366      push_val(&(env->head), val); /* Return its bound value */
367    }
368    
369    /* If the top element is a symbol, determine if it's bound to a
370       function value, and if it is, toss the symbol and execute the
371       function. */
372    extern void eval(environment *env)
373    {
374      funcp in_func;
375      value* val;
376      if(env->head==NULL) {
377        printerr("Stack empty");
378      return;      return;
379    }    }
380    
381      /* if it's a symbol */
382      if(env->head->item->type==symb) {
383    
384        /* If it's not bound to anything */
385        if (((symbol *)(env->head->item->content.ptr))->val == NULL) {
386          printerr("Unbound variable");
387          return;
388        }
389            
390        /* If it contains a function */
391        if (((symbol *)(env->head->item->content.ptr))->val->type == func) {
392          in_func=
393            (funcp)(((symbol *)(env->head->item->content.ptr))->val->content.ptr);
394          toss(env);
395          (*in_func)(env);          /* Run the function */
396          return;
397        } else {                    /* If it's not a function */
398          val=((symbol *)(env->head->item->content.ptr))->val;
399          toss(env);                /* toss the symbol */
400          push_val(&(env->head), val); /* Return its bound value */
401        }
402      }
403    
404    if(temp->item->type==func) {    /* If it's a lone function value, run it */
405      in_func= (funcp)(temp->item->content.ptr);    if(env->head->item->type==func) {
406        in_func= (funcp)(env->head->item->content.ptr);
407      toss(env);      toss(env);
408      (*in_func)(env);      (*in_func)(env);
409      return;      return;
410    }    }
411    
   push(&(env->head), copy(temp));  
   swap(env);  
   toss(env);  
412  }  }
413    
414  /* Make a list. */  /* Make a list. */
# Line 435  int stack_read(environment *env, char *i Line 473  int stack_read(environment *env, char *i
473      }      }
474      /* If integer */      /* If integer */
475      if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest))) {      if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest))) {
476        push_val(&(env->head), itemp);        push_int(&(env->head), itemp);
477        break;        break;
478      }      }
479      /* Escape ';' with '\' */      /* Escape ';' with '\' */
# Line 535  extern void eq(environment *env) Line 573  extern void eq(environment *env)
573    result= (left==right);    result= (left==right);
574        
575    toss(env); toss(env);    toss(env); toss(env);
576    push_val(&(env->head), result);    push_int(&(env->head), result);
577  }  }
578    
579  /* Negates the top element on the stack. */  /* Negates the top element on the stack. */
# Line 550  extern void not(environment *env) Line 588  extern void not(environment *env)
588    
589    val= env->head->item->content.val;    val= env->head->item->content.val;
590    toss(env);    toss(env);
591    push_val(&(env->head), !val);    push_int(&(env->head), !val);
592  }  }
593    
594  /* Compares the two top elements on the stack and return 0 if they're the  /* Compares the two top elements on the stack and return 0 if they're the

Legend:
Removed from v.1.28  
changed lines
  Added in v.1.31

root@recompile.se
ViewVC Help
Powered by ViewVC 1.1.26