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

Diff of /stack/stack.c

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

revision 1.127 by masse, Mon Aug 4 11:57:33 2003 UTC revision 1.128 by masse, Mon Aug 4 13:50:53 2003 UTC
# Line 185  extern void gc_init(environment *env) Line 185  extern void gc_init(environment *env)
185        printf(" integer: %d", env->gc_ref->item->content.i);        printf(" integer: %d", env->gc_ref->item->content.i);
186        break;        break;
187      case func:      case func:
188        printf(" func: %p", env->gc_ref->item->content.ptr);        printf(" func: %p", env->gc_ref->item->content.func);
189        break;        break;
190      case symb:      case symb:
191        printf(" symb: %s", env->gc_ref->item->content.sym->id);        printf(" symb: %s", env->gc_ref->item->content.sym->id);
# Line 203  extern void gc_init(environment *env) Line 203  extern void gc_init(environment *env)
203      /* Keep values */          /* Keep values */    
204      env->gc_count += sizeof(value);      env->gc_count += sizeof(value);
205      if(env->gc_ref->item->type==string)      if(env->gc_ref->item->type==string)
206        env->gc_count += strlen(env->gc_ref->item->content.ptr)+1;        env->gc_count += strlen(env->gc_ref->item->content.string)+1;
207            
208      titem= env->gc_ref->next;      titem= env->gc_ref->next;
209      env->gc_ref->next= new_head;      env->gc_ref->next= new_head;
# Line 300  void push_cstring(environment *env, cons Line 300  void push_cstring(environment *env, cons
300    value *new_value= new_val(env);    value *new_value= new_val(env);
301    int length= strlen(in_string)+1;    int length= strlen(in_string)+1;
302    
303    new_value->content.ptr= malloc(length);    new_value->content.string= malloc(length);
304    assert(new_value != NULL);    assert(new_value != NULL);
305    env->gc_count += length;    env->gc_count += length;
306    strcpy(new_value->content.ptr, in_string);    strcpy(new_value->content.string, in_string);
307    new_value->type= string;    new_value->type= string;
308    
309    push_val(env, new_value);    push_val(env, new_value);
# Line 346  extern void mangle(environment *env) Line 346  extern void mangle(environment *env)
346      return;      return;
347    }    }
348    
349    new_string=    new_string= mangle_str(CAR(env->head)->content.string);
     mangle_str((const char *)(CAR(env->head)->content.ptr));  
350    
351    toss(env);    toss(env);
352    if(env->err) return;    if(env->err) return;
# Line 412  void push_sym(environment *env, const ch Line 411  void push_sym(environment *env, const ch
411    
412      if(dlerr==NULL) {           /* If a function was found */      if(dlerr==NULL) {           /* If a function was found */
413        new_fvalue->type= func;   /* The new value is a function pointer */        new_fvalue->type= func;   /* The new value is a function pointer */
414        new_fvalue->content.ptr= funcptr; /* Store function pointer */        new_fvalue->content.func= funcptr; /* Store function pointer */
415        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
416                                           function value */                                           function value */
417      }      }
# Line 454  void print_val(environment *env, value * Line 453  void print_val(environment *env, value *
453      break;      break;
454    case string:    case string:
455      if(noquote){      if(noquote){
456        if(fprintf(stream, "%s", (char*)(val->content.ptr)) < 0){        if(fprintf(stream, "%s", val->content.string) < 0){
457          perror("print_val");          perror("print_val");
458          env->err= 5;          env->err= 5;
459          return;          return;
460        }        }
461      } else {                    /* quote */      } else {                    /* quote */
462        if(fprintf(stream, "\"%s\"", (char*)(val->content.ptr)) < 0){        if(fprintf(stream, "\"%s\"", val->content.string) < 0){
463          perror("print_val");          perror("print_val");
464          env->err= 5;          env->err= 5;
465          return;          return;
# Line 475  void print_val(environment *env, value * Line 474  void print_val(environment *env, value *
474      }      }
475      break;      break;
476    case func:    case func:
477      if(fprintf(stream, "#<function %p>", (funcp)(val->content.ptr)) < 0){      if(fprintf(stream, "#<function %p>", val->content.func) < 0){
478        perror("print_val");        perror("print_val");
479        env->err= 5;        env->err= 5;
480        return;        return;
481      }      }
482      break;      break;
483    case port:    case port:
484      if(fprintf(stream, "#<port %p>", (funcp)(val->content.p)) < 0){      if(fprintf(stream, "#<port %p>", val->content.p) < 0){
485        perror("print_val");        perror("print_val");
486        env->err= 5;        env->err= 5;
487        return;        return;
# Line 653  extern void eval(environment *env) Line 652  extern void eval(environment *env)
652    
653      /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
654    case func:    case func:
655      in_func= (funcp)(CAR(env->head)->content.ptr);      in_func= CAR(env->head)->content.func;
656      toss(env);      toss(env);
657      if(env->err) return;      if(env->err) return;
658      return in_func(env);      return in_func(env);
# Line 881  value *copy_val(environment *env, value Line 880  value *copy_val(environment *env, value
880      new_value->content= old_value->content;      new_value->content= old_value->content;
881      break;      break;
882    case string:    case string:
883      (char *)(new_value->content.ptr)=      new_value->content.string= strdup(old_value->content.string);
       strdup((char *)(old_value->content.ptr));  
884      break;      break;
885    case tcons:    case tcons:
886    
# Line 1006  void readstream(environment *env, FILE * Line 1004  void readstream(environment *env, FILE *
1004      readlinestream(env, env->inputstream);      readlinestream(env, env->inputstream);
1005      if(env->err) return;      if(env->err) return;
1006    
1007      if(((char *)(CAR(env->head)->content.ptr))[0]=='\0'){      if((CAR(env->head)->content.string)[0]=='\0'){
1008        env->err= 4;              /* "" means EOF */        env->err= 4;              /* "" means EOF */
1009        return;        return;
1010      }      }
1011            
1012      env->in_string= malloc(strlen(CAR(env->head)->content.ptr)+1);      env->in_string= malloc(strlen(CAR(env->head)->content.string)+1);
1013      assert(env->in_string != NULL);      assert(env->in_string != NULL);
1014      env->free_string= env->in_string; /* Save the original pointer */      env->free_string= env->in_string; /* Save the original pointer */
1015      strcpy(env->in_string, CAR(env->head)->content.ptr);      strcpy(env->in_string, CAR(env->head)->content.string);
1016      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1017    }    }
1018        
Legend:
Removed from v.1.127  
changed lines
  Added in v.1.128
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26