--- stack/stack.c 2002/01/08 14:31:23 1.9 +++ stack/stack.c 2004/02/19 15:35:38 1.137 @@ -1,46 +1,91 @@ -/* printf */ -#include -/* EXIT_SUCCESS */ -#include -/* NULL */ -#include -/* dlopen, dlsym, dlerror */ -#include +/* -*- coding: utf-8; -*- */ +/* + stack - an interactive interpreter for a stack-based language + Copyright (C) 2002 Mats Alritzson and Teddy Hogeborn -#define HASHTBLSIZE 65536 + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. -typedef struct stack_item -{ - enum {value, string, ref, func, symbol, list} type; - union { - void* ptr; - int val; - } content; + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - char* id; - struct stack_item* next; -} stackitem; + Authors: Mats Alritzson + Teddy Hogeborn +*/ +#include "stack.h" -typedef stackitem* hashtbl[HASHTBLSIZE]; -typedef void (*funcp)(stackitem**); +const char* start_message= "Stack version $Revision: 1.137 $\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."; -void init_hashtbl(hashtbl out_hash) + +/* Initialize a newly created environment */ +void init_env(environment *env) { - long i; + int i; + + env->gc_limit= 400000; + env->gc_count= 0; + env->gc_ref= NULL; + env->head= new_val(env); for(i= 0; isymbols[i]= NULL; + env->err= 0; + env->in_string= NULL; + env->free_string= NULL; + env->inputstream= stdin; + env->interactive= 1; +} + + +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); } -stackitem** hash(hashtbl in_hashtbl, const char* in_string) + +/* Returns a pointer to a pointer to an element in the hash table. */ +symbol **hash(hashtbl in_hashtbl, const char *in_string) { - long i= 0; - unsigned long out_hash= 0; - char key= 0; - stackitem** position; + int i= 0; + unsigned int out_hash= 0; + char key= '\0'; + symbol **position; - while(1){ + while(1){ /* Hash in_string */ key= in_string[i++]; if(key=='\0') break; @@ -51,287 +96,754 @@ position= &(in_hashtbl[out_hash]); while(1){ - if(*position==NULL) + if(*position==NULL) /* If empty */ return position; - if(strcmp(in_string, (*position)->id)==0) + if(strcmp(in_string, (*position)->id)==0) /* If match */ return position; - position= &((*position)->next); + position= &((*position)->next); /* Try next */ } } -int push(stackitem** stack_head, stackitem* in_item) +/* Create new value */ +value* new_val(environment *env) { - in_item->next= *stack_head; - *stack_head= in_item; - return 1; + value *nval= malloc(sizeof(value)); + stackitem *nitem= malloc(sizeof(stackitem)); + + assert(nval != NULL); + assert(nitem != NULL); + + nval->content.ptr= NULL; + nval->type= empty; + + nitem->item= nval; + nitem->next= env->gc_ref; + + env->gc_ref= nitem; + + env->gc_count += sizeof(value); + nval->gc.flag.mark= 0; + nval->gc.flag.protect= 0; + + return nval; } -int push_val(stackitem** stack_head, int in_val) + +/* Push a value onto the stack */ +void push_val(environment *env, value *val) { - stackitem* new_item= malloc(sizeof(stackitem)); - new_item->content.val= in_val; - new_item->type= value; + value *new_value= new_val(env); - push(stack_head, new_item); - return 1; + new_value->content.c= malloc(sizeof(pair)); + assert(new_value->content.c!=NULL); + env->gc_count += sizeof(pair); + new_value->type= tcons; + CAR(new_value)= val; + CDR(new_value)= env->head; + env->head= new_value; } -int push_cstring(stackitem** stack_head, const char* in_string) + +/* Push an integer onto the stack */ +void push_int(environment *env, int in_val) { - stackitem* new_item= malloc(sizeof(stackitem)); - new_item->content.ptr= malloc(strlen(in_string)+1); - strcpy(new_item->content.ptr, in_string); - new_item->type= string; + value *new_value= new_val(env); + + new_value->content.i= in_val; + new_value->type= integer; - push(stack_head, new_item); - return 1; + push_val(env, new_value); } -int mk_hashentry(hashtbl in_hashtbl, stackitem* in_item, const char* id) + +/* Push a floating point number onto the stack */ +void push_float(environment *env, float in_val) { - in_item->id= malloc(strlen(id)+1); + value *new_value= new_val(env); - strcpy(in_item->id, id); - push(hash(in_hashtbl, id), in_item); + new_value->content.f= in_val; + new_value->type= tfloat; - return 1; + push_val(env, new_value); } -void def_func(hashtbl in_hashtbl, funcp in_func, const char* id) + +/* Copy a string onto the stack. */ +void push_cstring(environment *env, const char *in_string) { - stackitem* temp= malloc(sizeof(stackitem)); + value *new_value= new_val(env); + int length= strlen(in_string)+1; - temp->type= func; - temp->content.ptr= in_func; + new_value->content.string= malloc(length); + assert(new_value != NULL); + env->gc_count += length; + strcpy(new_value->content.string, in_string); + new_value->type= string; - mk_hashentry(in_hashtbl, temp, id); + push_val(env, new_value); } -void def_sym(hashtbl in_hashtbl, const char* id) + +/* Mangle a symbol name to a valid C identifier name */ +char *mangle_str(const char *old_string) { - stackitem* temp= malloc(sizeof(stackitem)); - - temp->type= symbol; + char validchars[]= "0123456789abcdef"; + char *new_string, *current; - mk_hashentry(in_hashtbl, temp, id); + new_string= malloc((strlen(old_string)*2)+4); + assert(new_string != NULL); + strcpy(new_string, "sx_"); /* Stack eXternal */ + current= new_string+3; + + while(old_string[0] != '\0'){ + current[0]= validchars[(unsigned char)(old_string[0])/16]; + current[1]= validchars[(unsigned char)(old_string[0])%16]; + current+= 2; + old_string++; + } + current[0]= '\0'; + + return new_string; /* The caller must free() it */ } -int push_ref(stackitem** stack_head, hashtbl in_hash, const char* in_string) + +/* Push a symbol onto the stack. */ +void push_sym(environment *env, const char *in_string) { - static void* handle= NULL; - void* symbol; + value *new_value; /* A new symbol value */ + /* ...which might point to... */ + symbol **new_symbol; /* (if needed) A new actual symbol */ + /* ...which, if possible, will be bound to... */ + value *new_fvalue; /* (if needed) A new function value */ + /* ...which will point to... */ + void *funcptr; /* A function pointer */ - stackitem* new_item= malloc(sizeof(stackitem)); - new_item->content.ptr= *hash(in_hash, in_string); - new_item->type= ref; + static void *handle= NULL; /* Dynamic linker handle */ + const char *dlerr; /* Dynamic linker error */ + char *mangled; /* Mangled function name */ - if(new_item->content.ptr==NULL) { - if(handle==NULL) - handle= dlopen(NULL, RTLD_LAZY); + new_value= new_val(env); + new_fvalue= new_val(env); - symbol= dlsym(handle, in_string); - if(dlerror()==NULL) - def_func(in_hash, symbol, in_string); - else - def_sym(in_hash, in_string); - - new_item->content.ptr= *hash(in_hash, in_string); - new_item->type= ref; - } + /* The new value is a symbol */ + new_value->type= symb; - push(stack_head, new_item); - return 1; -} + /* Look up the symbol name in the hash table */ + new_symbol= hash(env->symbols, in_string); + new_value->content.sym= *new_symbol; -extern void toss(stackitem** stack_head) -{ - stackitem* temp= *stack_head; + if(*new_symbol==NULL) { /* If symbol was undefined */ - if((*stack_head)==NULL) - return; - - if((*stack_head)->type==string) - free((*stack_head)->content.ptr); + /* Create a new symbol */ + (*new_symbol)= malloc(sizeof(symbol)); + assert((*new_symbol) != NULL); + (*new_symbol)->val= NULL; /* undefined value */ + (*new_symbol)->next= NULL; + (*new_symbol)->id= malloc(strlen(in_string)+1); + assert((*new_symbol)->id != NULL); + strcpy((*new_symbol)->id, in_string); - *stack_head= (*stack_head)->next; - free(temp); -} + /* Intern the new symbol in the hash table */ + new_value->content.sym= *new_symbol; -extern void nl() -{ - printf("\n"); + /* Try to load the symbol name as an external function, to see if + we should bind the symbol to a new function pointer value */ + if(handle==NULL) /* If no handle */ + handle= dlopen(NULL, RTLD_LAZY); + + mangled= mangle_str(in_string); /* mangle the name */ + funcptr= dlsym(handle, mangled); /* and try to find it */ + + dlerr= dlerror(); + if(dlerr != NULL) { /* If no function was found */ + funcptr= dlsym(handle, in_string); /* Get function pointer */ + dlerr= dlerror(); + } + + if(dlerr==NULL) { /* If a function was found */ + new_fvalue->type= func; /* The new value is a function pointer */ + new_fvalue->content.func= funcptr; /* Store function pointer */ + (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new + function value */ + } + + free(mangled); + } + + push_val(env, new_value); } -void prin(stackitem** stack_head) + +/* Print a value */ +void print_val(environment *env, value *val, int noquote, stackitem *stack, + FILE *stream) { - if((*stack_head)==NULL) - return; + stackitem *titem, *tstack; + int depth; - switch((*stack_head)->type) { - case value: - printf("%d", (*stack_head)->content.val); + switch(val->type) { + case empty: + if(fprintf(stream, "[]") < 0) + env->err= 5; + break; + case unknown: + if(fprintf(stream, "UNKNOWN") < 0) + env->err= 5; + break; + case integer: + if(fprintf(stream, "%d", val->content.i) < 0) + env->err= 5; + break; + case tfloat: + if(fprintf(stream, "%f", val->content.f) < 0) + env->err= 5; break; case string: - printf("%s", (char*)(*stack_head)->content.ptr); + if(noquote){ + if(fprintf(stream, "%s", val->content.string) < 0) + env->err= 5; + } else { /* quote */ + if(fprintf(stream, "\"%s\"", val->content.string) < 0) + env->err= 5; + } break; - case ref: - printf("%s", ((stackitem*)(*stack_head)->content.ptr)->id); + case symb: + if(fprintf(stream, "%s", val->content.sym->id) < 0) + env->err= 5; break; - case symbol: - default: - printf("%p", (*stack_head)->content.ptr); + case func: + if(fprintf(stream, "#", val->content.func) < 0) + env->err= 5; + break; + case port: + if(fprintf(stream, "#", val->content.p) < 0) + env->err= 5; + break; + case tcons: + if(fprintf(stream, "[ ") < 0) { + env->err= 5; + return printerr(env); + } + tstack= stack; + + do { + titem=malloc(sizeof(stackitem)); + assert(titem != NULL); + titem->item=val; + titem->next=tstack; + tstack=titem; /* Put it on the stack */ + /* Search a stack of values being printed to see if we are already + printing this value */ + titem=tstack; + depth=0; + + while(titem != NULL && titem->item != CAR(val)){ + titem=titem->next; + depth++; + } + + if(titem != NULL){ /* If we found it on the stack, */ + if(fprintf(stream, "#%d#", depth) < 0){ /* print a depth reference */ + env->err= 5; + free(titem); + return printerr(env); + } + } else { + print_val(env, CAR(val), noquote, tstack, stream); + } + + val= CDR(val); + switch(val->type){ + case empty: + break; + case tcons: + /* Search a stack of values being printed to see if we are already + printing this value */ + titem=tstack; + depth=0; + + while(titem != NULL && titem->item != val){ + titem=titem->next; + depth++; + } + if(titem != NULL){ /* If we found it on the stack, */ + if(fprintf(stream, " . #%d#", depth) < 0){ /* print a depth reference */ + env->err= 5; + printerr(env); + goto printval_end; + } + } else { + if(fprintf(stream, " ") < 0){ + env->err= 5; + printerr(env); + goto printval_end; + } + } + break; + default: + if(fprintf(stream, " . ") < 0){ /* Improper list */ + env->err= 5; + printerr(env); + goto printval_end; + } + print_val(env, val, noquote, tstack, stream); + } + } while(val->type == tcons && titem == NULL); + + printval_end: + + titem=tstack; + while(titem != stack){ + tstack=titem->next; + free(titem); + titem=tstack; + } + + if(! (env->err)){ + if(fprintf(stream, " ]") < 0){ + env->err= 5; + } + } break; } + + if(env->err) + return printerr(env); } -extern void print(stackitem** stack_head) + +/* Swap the two top elements on the stack. */ +extern void swap(environment *env) { - prin(stack_head); - toss(stack_head); -} + value *temp= env->head; -/* print_stack(stack); */ -void print_st(stackitem* stack_head, long counter) -{ - if(stack_head->next != NULL) - print_st(stack_head->next, counter+1); + if(check_args(env, 2, unknown, unknown)) + return printerr(env); + + env->head= CDR(env->head); + CDR(temp)= CDR(env->head); + CDR(env->head)= temp; +} - printf("%ld: ", counter); - prin(&stack_head); - nl(); -} -extern void printstack(stackitem** stack_head) +/* Recall a value from a symbol, if bound */ +extern void rcl(environment *env) { - if(*stack_head != NULL) { - print_st(*stack_head, 1); - printf("\n"); + value *val; + + if(check_args(env, 1, symb)) + return printerr(env); + + val= CAR(env->head)->content.sym->val; + if(val == NULL){ + env->err= 3; + return printerr(env); } + + push_val(env, val); /* Return the symbol's bound value */ + swap(env); + if(env->err) return; + env->head= CDR(env->head); } -extern void eval(stackitem** stack_head) +/* If the top element is a symbol, determine if it's bound to a + function value, and if it is, toss the symbol and execute the + function. */ +extern void eval(environment *env) { funcp in_func; + value* temp_val; + value* iterator; + + eval_start: + + gc_maybe(env); + + if(check_args(env, 1, unknown)) + return printerr(env); + + switch(CAR(env->head)->type) { + /* if it's a symbol */ + case symb: + env->errsymb= CAR(env->head)->content.sym->id; + rcl(env); /* get its contents */ + if(env->err) return; + if(CAR(env->head)->type!=symb){ /* don't recurse symbols */ + goto eval_start; + } + return; - if((*stack_head)==NULL || (*stack_head)->type!=ref) + /* If it's a lone function value, run it */ + case func: + in_func= CAR(env->head)->content.func; + env->head= CDR(env->head); + return in_func((void*)env); + + /* If it's a list */ + case tcons: + temp_val= CAR(env->head); + protect(temp_val); + + env->head= CDR(env->head); + iterator= temp_val; + + while(iterator->type != empty) { + push_val(env, CAR(iterator)); + + if(CAR(env->head)->type==symb + && CAR(env->head)->content.sym->id[0]==';') { + env->head= CDR(env->head); + + if(CDR(iterator)->type == empty){ + goto eval_start; + } + eval(env); + if(env->err) return; + } + if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons) + iterator= CDR(iterator); + else { + env->err= 2; /* Improper list */ + return printerr(env); + } + } + unprotect(temp_val); return; - if(((stackitem*)(*stack_head)->content.ptr)->type==func) { - in_func= (funcp)((stackitem*)(*stack_head)->content.ptr)->content.ptr; - toss(stack_head); - (*in_func)(stack_head); + case empty: + env->head= CDR(env->head); + case integer: + case tfloat: + case string: + case port: + case unknown: return; } } -int stack_read(stackitem** stack_head, hashtbl in_hash, char* in_line) + +/* Internal forget function */ +void forget_sym(symbol **hash_entry) { - char *temp, *rest; - int itemp; - size_t inlength= strlen(in_line)+1; - int convert= 0; - - temp= malloc(inlength); - rest= malloc(inlength); - - if((convert= sscanf(in_line, "\"%[^\"\n\r]\" %[^\n\r]", temp, rest)) >= 1) - push_cstring(stack_head, temp); - else if((convert= sscanf(in_line, "%d %[^\n\r]", &itemp, rest)) >= 1) - push_val(stack_head, itemp); - else if((convert= sscanf(in_line, "%[^ ;\n\r]%[^\n\r]", temp, rest)) >= 1) - push_ref(stack_head, in_hash, temp); - else if((convert= sscanf(in_line, "%c%[^\n\r]", temp, rest)) >= 1) - if(*temp==';') - eval(stack_head); + symbol *temp; + temp= *hash_entry; + *hash_entry= (*hash_entry)->next; + + free(temp->id); free(temp); +} - if(convert<2) { - free(rest); - return 0; - } - - stack_read(stack_head, in_hash, rest); + +int main(int argc, char **argv) +{ + environment myenv; + int c; /* getopt option character */ + +#ifdef __linux__ + mtrace(); +#endif + + init_env(&myenv); + + myenv.interactive = isatty(STDIN_FILENO) && isatty(STDOUT_FILENO); + + while ((c = getopt (argc, argv, "i")) != -1) + switch (c) + { + case 'i': + myenv.interactive = 1; + break; + case '?': + fprintf (stderr, + "Unknown option character '\\x%x'.\n", + optopt); + return EX_USAGE; + default: + abort (); + } - free(rest); - return 1; + if (optind < argc) { + myenv.interactive = 0; + myenv.inputstream= fopen(argv[optind], "r"); + if(myenv.inputstream== NULL) { + perror(argv[0]); + exit (EX_NOINPUT); + } + } + + if(myenv.interactive) + puts(start_message); + + while(1) { + if(myenv.in_string==NULL) { + if (myenv.interactive) { + if(myenv.err) { + printf("(error %d)\n", myenv.err); + myenv.err= 0; + } + printf("\n"); + printstack(&myenv); + printf("> "); + } + myenv.err=0; + } + readstream(&myenv, myenv.inputstream); + if (myenv.err) { /* EOF or other error */ + myenv.err=0; + quit(&myenv); + } else if(myenv.head->type!=empty + && CAR(myenv.head)->type==symb + && CAR(myenv.head)->content.sym->id[0] == ';') { + if(myenv.head->type != empty) + myenv.head= CDR(myenv.head); + eval(&myenv); + } else { + gc_maybe(&myenv); + } + } + quit(&myenv); + return EXIT_FAILURE; } -extern void pack(stackitem** stack_head) -{ - void* delimiter; - stackitem *iterator, *temp, *pack; - if((*stack_head)==NULL) - return; +/* Return copy of a value */ +value *copy_val(environment *env, value *old_value) +{ + value *new_value; - delimiter= (*stack_head)->content.ptr; - toss(stack_head); + if(old_value==NULL) + return NULL; - iterator= *stack_head; + new_value= new_val(env); + new_value->type= old_value->type; - while(iterator->next!=NULL && iterator->next->content.ptr!=delimiter) - iterator= iterator->next; + switch(old_value->type){ + case tfloat: + case integer: + case func: + case symb: + case empty: + case unknown: + case port: + new_value->content= old_value->content; + break; + case string: + new_value->content.string= strdup(old_value->content.string); + break; + case tcons: - temp= *stack_head; - *stack_head= iterator->next; - iterator->next= NULL; - - if(*stack_head!=NULL && (*stack_head)->content.ptr==delimiter) - toss(stack_head); + new_value->content.c= malloc(sizeof(pair)); + assert(new_value->content.c!=NULL); + env->gc_count += sizeof(pair); - pack= malloc(sizeof(stackitem)); - pack->type= list; - pack->content.ptr= temp; + CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */ + CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */ + break; + } - push(stack_head, pack); + return new_value; } -extern void expand(stackitem** stack_head) + +/* read a line from a stream; used by readline */ +void readlinestream(environment *env, FILE *stream) { - stackitem *temp, *new_head; + char in_string[101]; + + if(fgets(in_string, 100, stream)==NULL) { + push_cstring(env, ""); + if (! feof(stream)){ + env->err= 5; + return printerr(env); + } + } else { + push_cstring(env, in_string); + } +} - if((*stack_head)==NULL || (*stack_head)->type!=list) - return; - new_head= temp= (*stack_head)->content.ptr; - toss(stack_head); +/* Reverse (flip) a list */ +extern void rev(environment *env) +{ + value *old_head, *new_head, *item; - while(temp->next!=NULL) - temp= temp->next; + if(CAR(env->head)->type==empty) + return; /* Don't reverse an empty list */ - temp->next= *stack_head; - *stack_head= new_head; + if(check_args(env, 1, tcons)) + return printerr(env); + + old_head= CAR(env->head); + new_head= new_val(env); + while(old_head->type != empty) { + item= old_head; + old_head= CDR(old_head); + CDR(item)= new_head; + new_head= item; + } + CAR(env->head)= new_head; } -extern void quit() + +/* Make a list. */ +extern void pack(environment *env) { - exit(EXIT_SUCCESS); + value *iterator, *temp, *ending; + + ending=new_val(env); + + iterator= env->head; + if(iterator->type == empty + || (CAR(iterator)->type==symb + && CAR(iterator)->content.sym->id[0]=='[')) { + temp= ending; + if(env->head->type != empty) + env->head= CDR(env->head); + } else { + /* Search for first delimiter */ + while(CDR(iterator)->type != empty + && (CAR(CDR(iterator))->type!=symb + || CAR(CDR(iterator))->content.sym->id[0]!='[')) + iterator= CDR(iterator); + + /* Extract list */ + temp= env->head; + env->head= CDR(iterator); + CDR(iterator)= ending; + + if(env->head->type != empty) + env->head= CDR(env->head); + } + + /* Push list */ + + push_val(env, temp); + rev(env); } -int main() + +/* read from a stream; used by "read" and "readport" */ +void readstream(environment *env, FILE *stream) +{ + const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n"; + const char strform[]= "\"%[^\"]\"%n"; + const char intform[]= "%i%n"; + const char fltform[]= "%f%n"; + const char blankform[]= "%*[ \t]%n"; + const char ebrackform[]= "]%n"; + const char semicform[]= ";%n"; + const char bbrackform[]= "[%n"; + + int itemp, readlength= -1; + int count= -1; + float ftemp; + static int depth= 0; + char *match; + size_t inlength; + + if(env->in_string==NULL) { + if(depth > 0 && env->interactive) { + printf("]> "); + } + readlinestream(env, env->inputstream); + if(env->err) return; + + if((CAR(env->head)->content.string)[0]=='\0'){ + env->err= 4; /* "" means EOF */ + return; + } + + env->in_string= malloc(strlen(CAR(env->head)->content.string)+1); + assert(env->in_string != NULL); + env->free_string= env->in_string; /* Save the original pointer */ + strcpy(env->in_string, CAR(env->head)->content.string); + env->head= CDR(env->head); + } + + inlength= strlen(env->in_string)+1; + match= malloc(inlength); + assert(match != NULL); + + if(sscanf(env->in_string, blankform, &readlength) != EOF + && readlength != -1) { + ; + } else if(sscanf(env->in_string, fltform, &ftemp, &readlength) != EOF + && readlength != -1) { + if(sscanf(env->in_string, intform, &itemp, &count) != EOF + && count==readlength) { + push_int(env, itemp); + } else { + push_float(env, ftemp); + } + } else if(sscanf(env->in_string, "\"\"%n", &readlength) != EOF + && readlength != -1) { + push_cstring(env, ""); + } else if(sscanf(env->in_string, strform, match, &readlength) != EOF + && readlength != -1) { + push_cstring(env, match); + } else if(sscanf(env->in_string, symbform, match, &readlength) != EOF + && readlength != -1) { + push_sym(env, match); + } else if(sscanf(env->in_string, ebrackform, &readlength) != EOF + && readlength != -1) { + pack(env); if(env->err) return; + if(depth != 0) depth--; + } else if(sscanf(env->in_string, semicform, &readlength) != EOF + && readlength != -1) { + push_sym(env, ";"); + } else if(sscanf(env->in_string, bbrackform, &readlength) != EOF + && readlength != -1) { + push_sym(env, "["); + depth++; + } else { + free(env->free_string); + env->in_string = env->free_string = NULL; + } + if (env->in_string != NULL) { + env->in_string += readlength; + } + + free(match); + + if(depth) + return readstream(env, env->inputstream); +} + + +int check_args(environment *env, int num_args, ...) { - stackitem* s= NULL; - hashtbl myhash; - char in_string[100]; + va_list ap; + enum type_enum mytype; + int i; - init_hashtbl(myhash); + value *iter= env->head; + int errval= 0; - printf("okidok\n "); + 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(iter->type==empty || iter==NULL) { + errval= 1; + break; + } - while(fgets(in_string, 100, stdin) != NULL) { - stack_read(&s, myhash, in_string); - printf("okidok\n "); + if(mytype!=unknown && CAR(iter)->type!=mytype) { + errval= 2; + break; + } + + iter= CDR(iter); } + va_end(ap); - return EXIT_SUCCESS; + env->err= errval; + return errval; } - -/* Local Variables: */ -/* compile-command:"make CFLAGS=\"-Wall -g -rdynamic -ldl\" stack" */ -/* End: */