--- stack/stack.c 2003/08/13 06:12:26 1.134 +++ stack/stack.c 2003/08/18 14:39:16 1.136 @@ -23,11 +23,11 @@ #include "stack.h" -const char* start_message= "Stack version $Revision: 1.134 $\n\ +const char* start_message= "Stack version $Revision: 1.136 $\n\ Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn\n\ Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\ This is free software, and you are welcome to redistribute it\n\ -under certain conditions; type 'copying;' for details.\n"; +under certain conditions; type 'copying;' for details."; /* Initialize a newly created environment */ @@ -50,8 +50,29 @@ } -void printerr(environment *env, const char* in_string) +void printerr(environment *env) { + char *in_string; + + switch(env->err) { + case 0: + return; + case 1: + in_string= "Too Few Arguments"; + break; + case 2: + in_string= "Bad Argument Type"; + break; + case 3: + in_string= "Unbound Variable"; + break; + case 5: + return perror(env->errsymb); + default: + in_string= "Unknown error"; + break; + } + fprintf(stderr, "\"%s\":\nErr: %s\n", env->errsymb, in_string); } @@ -425,74 +446,46 @@ switch(val->type) { case empty: - if(fprintf(stream, "[]") < 0){ - perror("print_val"); + if(fprintf(stream, "[]") < 0) env->err= 5; - return; - } break; case unknown: - if(fprintf(stream, "UNKNOWN") < 0){ - perror("print_val"); + if(fprintf(stream, "UNKNOWN") < 0) env->err= 5; - return; - } break; case integer: - if(fprintf(stream, "%d", val->content.i) < 0){ - perror("print_val"); + if(fprintf(stream, "%d", val->content.i) < 0) env->err= 5; - return; - } break; case tfloat: - if(fprintf(stream, "%f", val->content.f) < 0){ - perror("print_val"); + if(fprintf(stream, "%f", val->content.f) < 0) env->err= 5; - return; - } break; case string: if(noquote){ - if(fprintf(stream, "%s", val->content.string) < 0){ - perror("print_val"); + if(fprintf(stream, "%s", val->content.string) < 0) env->err= 5; - return; - } } else { /* quote */ - if(fprintf(stream, "\"%s\"", val->content.string) < 0){ - perror("print_val"); + if(fprintf(stream, "\"%s\"", val->content.string) < 0) env->err= 5; - return; - } } break; case symb: - if(fprintf(stream, "%s", val->content.sym->id) < 0){ - perror("print_val"); + if(fprintf(stream, "%s", val->content.sym->id) < 0) env->err= 5; - return; - } break; case func: - if(fprintf(stream, "#", val->content.func) < 0){ - perror("print_val"); + if(fprintf(stream, "#", val->content.func) < 0) env->err= 5; - return; - } break; case port: - if(fprintf(stream, "#", val->content.p) < 0){ - perror("print_val"); + if(fprintf(stream, "#", val->content.p) < 0) env->err= 5; - return; - } break; case tcons: - if(fprintf(stream, "[ ") < 0){ - perror("print_val"); + if(fprintf(stream, "[ ") < 0) { env->err= 5; - return; + return printerr(env); } tstack= stack; @@ -514,10 +507,9 @@ if(titem != NULL){ /* If we found it on the stack, */ if(fprintf(stream, "#%d#", depth) < 0){ /* print a depth reference */ - perror("print_val"); env->err= 5; free(titem); - return; + return printerr(env); } } else { print_val(env, CAR(val), noquote, tstack, stream); @@ -539,22 +531,22 @@ } if(titem != NULL){ /* If we found it on the stack, */ if(fprintf(stream, " . #%d#", depth) < 0){ /* print a depth reference */ - perror("print_val"); env->err= 5; + printerr(env); goto printval_end; } } else { if(fprintf(stream, " ") < 0){ - perror("print_val"); env->err= 5; + printerr(env); goto printval_end; } } break; default: if(fprintf(stream, " . ") < 0){ /* Improper list */ - perror("print_val"); env->err= 5; + printerr(env); goto printval_end; } print_val(env, val, noquote, tstack, stream); @@ -572,12 +564,14 @@ if(! (env->err)){ if(fprintf(stream, " ]") < 0){ - perror("print_val"); env->err= 5; } } break; } + + if(env->err) + return printerr(env); } @@ -586,16 +580,8 @@ { value *temp= env->head; - switch(check_args(env, unknown, unknown, empty)) { - case 1: - printerr(env, "Too Few Arguments"); - return; - case 2: - printerr(env, "Bad Argument Type"); - return; - default: - break; - } + if(check_args(env, 2, unknown, unknown)) + return printerr(env); env->head= CDR(env->head); CDR(temp)= CDR(env->head); @@ -608,23 +594,15 @@ { value *val; - switch(check_args(env, symb, empty)) { - case 1: - printerr(env, "Too Few Arguments"); - return; - case 2: - printerr(env, "Bad Argument Type"); - return; - default: - break; - } + if(check_args(env, 1, symb)) + return printerr(env); val= CAR(env->head)->content.sym->val; if(val == NULL){ - printerr(env, "Unbound Variable"); env->err= 3; - return; + return printerr(env); } + push_val(env, val); /* Return the symbol's bound value */ swap(env); if(env->err) return; @@ -645,16 +623,8 @@ gc_maybe(env); - switch(check_args(env, unknown, empty)) { - case 1: - printerr(env, "Too Few Arguments"); - return; - case 2: - printerr(env, "Bad Argument Type"); - return; - default: - break; - } + if(check_args(env, 1, unknown)) + return printerr(env); switch(CAR(env->head)->type) { /* if it's a symbol */ @@ -671,7 +641,7 @@ case func: in_func= CAR(env->head)->content.func; env->head= CDR(env->head); - return in_func(env); + return in_func((void*)env); /* If it's a list */ case tcons: @@ -697,9 +667,8 @@ if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) iterator= CDR(iterator); else { - printerr(env, "Bad Argument Type"); /* Improper list */ - env->err= 2; - return; + env->err= 2; /* Improper list */ + return printerr(env); } } unprotect(temp_val); @@ -849,8 +818,8 @@ if(fgets(in_string, 100, stream)==NULL) { push_cstring(env, ""); if (! feof(stream)){ - perror("readline"); env->err= 5; + return printerr(env); } } else { push_cstring(env, in_string); @@ -866,16 +835,8 @@ if(CAR(env->head)->type==empty) return; /* Don't reverse an empty list */ - switch(check_args(env, tcons, empty)) { - case 1: - printerr(env, "Too Few Arguments"); - return; - case 2: - printerr(env, "Bad Argument Type"); - return; - default: - break; - } + if(check_args(env, 1, tcons)) + return printerr(env); old_head= CAR(env->head); new_head= new_val(env); @@ -1014,33 +975,26 @@ } -int check_args(environment *env, ...) +int check_args(environment *env, int num_args, ...) { va_list ap; enum type_enum mytype; + int i; value *iter= env->head; int errval= 0; - va_start(ap, env); - while(1) { + va_start(ap, num_args); + for(i=1; i<=num_args; i++) { mytype= va_arg(ap, enum type_enum); // fprintf(stderr, "%s\n", env->errsymb); - if(mytype==empty) - break; - if(iter->type==empty || iter==NULL) { errval= 1; break; } - if(mytype==unknown) { - iter=CDR(iter); - continue; - } - - if(CAR(iter)->type!=mytype) { + if(mytype!=unknown && CAR(iter)->type!=mytype) { errval= 2; break; }