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

Diff of /stack/stack.c

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

revision 1.117 by teddy, Wed Mar 20 05:29:29 2002 UTC revision 1.120 by teddy, Thu Mar 21 03:19:32 2002 UTC
# Line 123  value* new_val(environment *env) Line 123  value* new_val(environment *env)
123    value *nval= malloc(sizeof(value));    value *nval= malloc(sizeof(value));
124    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
125    
126      assert(nval != NULL);
127      assert(nitem != NULL);
128    
129    nval->content.ptr= NULL;    nval->content.ptr= NULL;
130    nval->type= empty;    nval->type= empty;
131    
# Line 335  void push_cstring(environment *env, cons Line 338  void push_cstring(environment *env, cons
338    int length= strlen(in_string)+1;    int length= strlen(in_string)+1;
339    
340    new_value->content.ptr= malloc(length);    new_value->content.ptr= malloc(length);
341      assert(new_value != NULL);
342    env->gc_count += length;    env->gc_count += length;
343    strcpy(new_value->content.ptr, in_string);    strcpy(new_value->content.ptr, in_string);
344    new_value->type= string;    new_value->type= string;
# Line 349  char *mangle_str(const char *old_string) Line 353  char *mangle_str(const char *old_string)
353    char *new_string, *current;    char *new_string, *current;
354    
355    new_string= malloc((strlen(old_string)*2)+4);    new_string= malloc((strlen(old_string)*2)+4);
356      assert(new_string != NULL);
357    strcpy(new_string, "sx_");    /* Stack eXternal */    strcpy(new_string, "sx_");    /* Stack eXternal */
358    current= new_string+3;    current= new_string+3;
359    while(old_string[0] != '\0'){    while(old_string[0] != '\0'){
# Line 418  void push_sym(environment *env, const ch Line 423  void push_sym(environment *env, const ch
423    
424      /* Create a new symbol */      /* Create a new symbol */
425      (*new_symbol)= malloc(sizeof(symbol));      (*new_symbol)= malloc(sizeof(symbol));
426        assert((*new_symbol) != NULL);
427      (*new_symbol)->val= NULL;   /* undefined value */      (*new_symbol)->val= NULL;   /* undefined value */
428      (*new_symbol)->next= NULL;      (*new_symbol)->next= NULL;
429      (*new_symbol)->id= malloc(strlen(in_string)+1);      (*new_symbol)->id= malloc(strlen(in_string)+1);
430        assert((*new_symbol)->id != NULL);
431      strcpy((*new_symbol)->id, in_string);      strcpy((*new_symbol)->id, in_string);
432    
433      /* Intern the new symbol in the hash table */      /* Intern the new symbol in the hash table */
# Line 530  void print_val(value *val, int noquote, Line 537  void print_val(value *val, int noquote,
537      tstack= stack;      tstack= stack;
538      do {      do {
539        titem=malloc(sizeof(stackitem));        titem=malloc(sizeof(stackitem));
540          assert(titem != NULL);
541        titem->item=val;        titem->item=val;
542        titem->next=tstack;        titem->next=tstack;
543        tstack=titem;             /* Put it on the stack */        tstack=titem;             /* Put it on the stack */
# Line 1161  extern void sx_2b(environment *env) Line 1169  extern void sx_2b(environment *env)
1169      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1170      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;
1171      new_string= malloc(len);      new_string= malloc(len);
1172        assert(new_string != NULL);
1173      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.ptr);
1174      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.ptr);
1175      push_cstring(env, new_string);      push_cstring(env, new_string);
# Line 1760  extern void sx_72656164(environment *env Line 1769  extern void sx_72656164(environment *env
1769      }      }
1770            
1771      env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1);      env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1);
1772        assert(env->in_string != NULL);
1773      env->free_string= env->in_string; /* Save the original pointer */      env->free_string= env->in_string; /* Save the original pointer */
1774      strcpy(env->in_string, CAR(env->head)->content.ptr);      strcpy(env->in_string, CAR(env->head)->content.ptr);
1775      toss(env); if(env->err) return;      toss(env); if(env->err) return;
# Line 1767  extern void sx_72656164(environment *env Line 1777  extern void sx_72656164(environment *env
1777        
1778    inlength= strlen(env->in_string)+1;    inlength= strlen(env->in_string)+1;
1779    match= malloc(inlength);    match= malloc(inlength);
1780      assert(match != NULL);
1781    
1782    if(sscanf(env->in_string, blankform, &readlength) != EOF    if(sscanf(env->in_string, blankform, &readlength) != EOF
1783       && readlength != -1) {       && readlength != -1) {
# Line 2435  extern void cons(environment *env) Line 2446  extern void cons(environment *env)
2446    swap(env); if(env->err) return;    swap(env); if(env->err) return;
2447    toss(env); if(env->err) return;    toss(env); if(env->err) return;
2448  }  }
2449    
2450    /*  2: 3                        =>                */
2451    /*  1: [ [ 1 . 2 ] [ 3 . 4 ] ]  =>  1: [ 3 . 4 ]  */
2452    extern void assq(environment *env)
2453    {
2454      assocgen(env, eq);
2455    }
2456    
2457    
2458    /* General assoc function */
2459    void assocgen(environment *env, funcp eqfunc)
2460    {
2461      value *key, *item;
2462    
2463      /* Needs two values on the stack, the top one must be an association
2464         list */
2465      if(env->head->type==empty || CDR(env->head)->type==empty) {
2466        printerr("Too Few Arguments");
2467        env->err= 1;
2468        return;
2469      }
2470    
2471      if(CAR(env->head)->type!=tcons) {
2472        printerr("Bad Argument Type");
2473        env->err= 2;
2474        return;
2475      }
2476    
2477      key=CAR(CDR(env->head));
2478      item=CAR(env->head);
2479    
2480      while(item->type == tcons){
2481        if(CAR(item)->type != tcons){
2482          printerr("Bad Argument Type");
2483          env->err= 2;
2484          return;
2485        }
2486        push_val(env, key);
2487        push_val(env, CAR(CAR(item)));
2488        eqfunc(env); if(env->err) return;
2489    
2490        /* Check the result of 'eqfunc' */
2491        if(env->head->type==empty) {
2492          printerr("Too Few Arguments");
2493          env->err= 1;
2494        return;
2495        }
2496        if(CAR(env->head)->type!=integer) {
2497          printerr("Bad Argument Type");
2498          env->err= 2;
2499          return;
2500        }
2501    
2502        if(CAR(env->head)->content.i){
2503          toss(env); if(env->err) return;
2504          break;
2505        }
2506        toss(env); if(env->err) return;
2507    
2508        if(item->type!=tcons) {
2509          printerr("Bad Argument Type");
2510          env->err= 2;
2511          return;
2512        }
2513    
2514        item=CDR(item);
2515      }
2516    
2517      if(item->type == tcons){      /* A match was found */
2518        push_val(env, CAR(item));
2519      } else {
2520        push_int(env, 0);
2521      }
2522      swap(env); if(env->err) return;
2523      toss(env); if(env->err) return;
2524      swap(env); if(env->err) return;
2525      toss(env);
2526    }
Legend:
Removed from v.1.117  
changed lines
  Added in v.1.120
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26