--- stack/stack.c 2003/08/13 11:58:00 1.135 +++ 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.135 $\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 */ @@ -66,6 +66,8 @@ case 3: in_string= "Unbound Variable"; break; + case 5: + return perror(env->errsymb); default: in_string= "Unknown error"; break; @@ -444,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; @@ -533,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); @@ -558,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); @@ -591,12 +564,14 @@ if(! (env->err)){ if(fprintf(stream, " ]") < 0){ - perror("print_val"); env->err= 5; } } break; } + + if(env->err) + return printerr(env); } @@ -605,7 +580,7 @@ { value *temp= env->head; - if(check_args(env, unknown, unknown, empty)) + if(check_args(env, 2, unknown, unknown)) return printerr(env); env->head= CDR(env->head); @@ -619,7 +594,7 @@ { value *val; - if(check_args(env, symb, empty)) + if(check_args(env, 1, symb)) return printerr(env); val= CAR(env->head)->content.sym->val; @@ -648,7 +623,7 @@ gc_maybe(env); - if(check_args(env, unknown, empty)) + if(check_args(env, 1, unknown)) return printerr(env); switch(CAR(env->head)->type) { @@ -843,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); @@ -860,7 +835,7 @@ if(CAR(env->head)->type==empty) return; /* Don't reverse an empty list */ - if(check_args(env, tcons, empty)) + if(check_args(env, 1, tcons)) return printerr(env); old_head= CAR(env->head); @@ -1000,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; }