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

Diff of /stack/stack.c

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

revision 1.132 by masse, Fri Aug 8 14:20:49 2003 UTC revision 1.133 by masse, Mon Aug 11 14:31:48 2003 UTC
# Line 50  void init_env(environment *env) Line 50  void init_env(environment *env)
50  }  }
51    
52    
53  void printerr(const char* in_string)  void printerr(environment *env, const char* in_string)
54  {  {
55    fprintf(stderr, "Err: %s\n", in_string);    fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string);
56  }  }
57    
58    
# Line 167  extern void gc_init(environment *env) Line 167  extern void gc_init(environment *env)
167          break;          break;
168        case port:        case port:
169        case empty:        case empty:
170          case unknown:
171        case integer:        case integer:
172        case tfloat:        case tfloat:
173        case func:        case func:
# Line 364  void push_sym(environment *env, const ch Line 365  void push_sym(environment *env, const ch
365    char *mangled;                /* Mangled function name */    char *mangled;                /* Mangled function name */
366    
367    new_value= new_val(env);    new_value= new_val(env);
   protect(new_value);  
368    new_fvalue= new_val(env);    new_fvalue= new_val(env);
   protect(new_fvalue);  
369    
370    /* The new value is a symbol */    /* The new value is a symbol */
371    new_value->type= symb;    new_value->type= symb;
# Line 414  void push_sym(environment *env, const ch Line 413  void push_sym(environment *env, const ch
413    }    }
414    
415    push_val(env, new_value);    push_val(env, new_value);
   unprotect(new_value); unprotect(new_fvalue);  
416  }  }
417    
418    
# Line 433  void print_val(environment *env, value * Line 431  void print_val(environment *env, value *
431        return;        return;
432      }      }
433      break;      break;
434      case unknown:
435        if(fprintf(stream, "UNKNOWN") < 0){
436          perror("print_val");
437          env->err= 5;
438          return;
439        }
440        break;
441    case integer:    case integer:
442      if(fprintf(stream, "%d", val->content.i) < 0){      if(fprintf(stream, "%d", val->content.i) < 0){
443        perror("print_val");        perror("print_val");
# Line 582  extern void swap(environment *env) Line 587  extern void swap(environment *env)
587    value *temp= env->head;    value *temp= env->head;
588        
589    if(env->head->type == empty || CDR(env->head)->type == empty) {    if(env->head->type == empty || CDR(env->head)->type == empty) {
590      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
591      env->err=1;      env->err=1;
592      return;      return;
593    }    }
# Line 599  extern void rcl(environment *env) Line 604  extern void rcl(environment *env)
604    value *val;    value *val;
605    
606    if(env->head->type==empty) {    if(env->head->type==empty) {
607      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
608      env->err= 1;      env->err= 1;
609      return;      return;
610    }    }
611    
612    if(CAR(env->head)->type!=symb) {    if(CAR(env->head)->type!=symb) {
613      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
614      env->err= 2;      env->err= 2;
615      return;      return;
616    }    }
617    
618    val= CAR(env->head)->content.sym->val;    val= CAR(env->head)->content.sym->val;
619    if(val == NULL){    if(val == NULL){
620      printerr("Unbound Variable");      printerr(env, "Unbound Variable");
621      env->err= 3;      env->err= 3;
622      return;      return;
623    }    }
# Line 637  extern void eval(environment *env) Line 642  extern void eval(environment *env)
642    gc_maybe(env);    gc_maybe(env);
643    
644    if(env->head->type==empty) {    if(env->head->type==empty) {
645      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
646      env->err= 1;      env->err= 1;
647      return;      return;
648    }    }
# Line 645  extern void eval(environment *env) Line 650  extern void eval(environment *env)
650    switch(CAR(env->head)->type) {    switch(CAR(env->head)->type) {
651      /* if it's a symbol */      /* if it's a symbol */
652    case symb:    case symb:
653        env->errsymb= CAR(env->head)->content.sym->id;
654      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
655      if(env->err) return;      if(env->err) return;
656      if(CAR(env->head)->type!=symb){ /* don't recurse symbols */      if(CAR(env->head)->type!=symb){ /* don't recurse symbols */
# Line 682  extern void eval(environment *env) Line 688  extern void eval(environment *env)
688        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)
689          iterator= CDR(iterator);          iterator= CDR(iterator);
690        else {        else {
691          printerr("Bad Argument Type"); /* Improper list */          printerr(env, "Bad Argument Type"); /* Improper list */
692          env->err= 2;          env->err= 2;
693          return;          return;
694        }        }
# Line 696  extern void eval(environment *env) Line 702  extern void eval(environment *env)
702    case tfloat:    case tfloat:
703    case string:    case string:
704    case port:    case port:
705      case unknown:
706      return;      return;
707    }    }
708  }  }
# Line 803  value *copy_val(environment *env, value Line 810  value *copy_val(environment *env, value
810    case func:    case func:
811    case symb:    case symb:
812    case empty:    case empty:
813      case unknown:
814    case port:    case port:
815      new_value->content= old_value->content;      new_value->content= old_value->content;
816      break;      break;
# Line 847  extern void rev(environment *env) Line 855  extern void rev(environment *env)
855    value *old_head, *new_head, *item;    value *old_head, *new_head, *item;
856    
857    if(env->head->type==empty) {    if(env->head->type==empty) {
858      printerr("Too Few Arguments");      printerr(env, "Too Few Arguments");
859      env->err= 1;      env->err= 1;
860      return;      return;
861    }    }
# Line 856  extern void rev(environment *env) Line 864  extern void rev(environment *env)
864      return;                     /* Don't reverse an empty list */      return;                     /* Don't reverse an empty list */
865    
866    if(CAR(env->head)->type!=tcons) {    if(CAR(env->head)->type!=tcons) {
867      printerr("Bad Argument Type");      printerr(env, "Bad Argument Type");
868      env->err= 2;      env->err= 2;
869      return;      return;
870    }    }
# Line 996  void readstream(environment *env, FILE * Line 1004  void readstream(environment *env, FILE *
1004    if(depth)    if(depth)
1005      return readstream(env, env->inputstream);      return readstream(env, env->inputstream);
1006  }  }
1007    
1008    
1009    int check_args(environment *env, ...)
1010    {
1011      va_list ap;
1012      enum type_enum mytype;
1013    
1014      value *iter= env->head;
1015      int errval= 0;
1016    
1017      va_start(ap, env);
1018      while(1) {
1019        mytype= va_arg(ap, enum type_enum);
1020        //    fprintf(stderr, "%s\n", env->errsymb);
1021    
1022        if(mytype==empty)
1023          break;
1024        
1025        if(iter->type==empty || iter==NULL) {
1026          errval= 1;
1027          break;
1028        }
1029    
1030        if(mytype==unknown) {
1031          iter=CDR(iter);
1032          continue;
1033        }
1034    
1035        if(CAR(iter)->type!=mytype) {
1036          errval= 2;
1037          break;
1038        }
1039    
1040        iter= CDR(iter);
1041      }
1042    
1043      va_end(ap);
1044    
1045      env->err= errval;
1046      return errval;
1047    }
Legend:
Removed from v.1.132  
changed lines
  Added in v.1.133
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26