diff -ruN klic-3.003-2002-01-06b/runtime/main.c klic-3.003-2002-01-06c/runtime/main.c --- klic-3.003-2002-01-06b/runtime/main.c Thu Dec 27 19:15:57 2001 +++ klic-3.003-2002-01-06c/runtime/main.c Sun Jan 6 16:54:19 2002 @@ -7,9 +7,10 @@ extern int klic_main(); +extern int main(argc, argv) - int argc; - char **argv; + int argc; + char** argv; { return klic_main(argc, argv); } diff -ruN klic-3.003-2002-01-06b/runtime/newatom.c klic-3.003-2002-01-06c/runtime/newatom.c --- klic-3.003-2002-01-06b/runtime/newatom.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-06c/runtime/newatom.c Sun Jan 6 16:53:02 2002 @@ -4,6 +4,7 @@ % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ + #include /* fatal */ #include #include /* malloc_check */ @@ -13,13 +14,18 @@ #include /* functors, arities, FUNCTORNUMBERBASE */ #include +#ifdef SHM +#include "shm.h" +#endif + #define Hashsize 1024 #define Namesize 1024 #define YET (-1) #define DONE 0 -#define AtomError (-1) +extern unsigned long generic_string_size(); +extern unsigned char* convert_klic_string_to_c_string(); struct atomhashtable{ long atomid; @@ -39,23 +45,40 @@ static struct functorhashtable functhtable; static struct functorhashtable* functhp = &functhtable; -#ifdef SHM -#include "shm.h" +static int init_atom = YET; +static int init_functor = YET; + +static long* nextatom; +static long* nextfunctor; + + +#ifndef SHM +static unsigned char* namearea; +static unsigned char* nameareap; + +#else /* SHM */ +struct atomnamebuff { + unsigned char* namea0; + unsigned char* namep0; +}; -static char* Buff_S; -static char* Buff_E; +struct atomnamebuff* shm_namep; + +#define namearea (shm_namep->namea0) +#define nameareap (shm_namep->namep0) #define malloc_check(sz) \ ( (Buff_S += (sz)) > Buff_E ? \ (char*) abend("Atom Table overflow!") : (char*) (Buff_S - (sz)) ) extern void -init_shm_atom() { +init_shm_atom() +{ struct atomhashtable* tmpahp; struct functorhashtable* tmpfhp; - Buff_S = shm_start_addr; - Buff_E = Buff_S + ATOM_TABLE_SIZE; - shm_namep = (ShmNameBuff*) malloc_check(sizeof(ShmNameBuff)); + static char* Buff_S = shm_start_addr; + static char* Buff_E = Buff_S + ATOM_TABLE_SIZE; + shm_namep = (struct atomnamebuff*) malloc_check(sizeof(struct atomnamebuff)); tmpahp = (struct atomhashtable*) malloc_check(sizeof(struct atomhashtable)); *tmpahp = *atomhp; atomhp = tmpahp; @@ -65,68 +88,21 @@ } #endif /* SHM */ -static int init_atom = YET; -static int init_functor = YET; - -static long* nextatom; -static long* nextfunctor; - -#ifdef SHM -typedef struct atomnamebuff { - unsigned char* namea0; - unsigned char* namep0; -} ShmNameBuff; -ShmNameBuff* shm_namep; -#define namearea (shm_namep->namea0) -#define nameareap (shm_namep->namep0) -#else -static unsigned char* namearea; -static unsigned char* nameareap; -#endif - -#define numberOfAtoms initial_atoms -#define numberOfFunctors initial_functors static long hash_name(name) unsigned char* name; { long value = 0L; - while(*name != '\0'){ + while( *name != '\0' ){ value = 3L*value + *name; name++; } return value; } -static long -list2name(name,list) - unsigned char* name; - q list; -{ - int i = 0; - q x; - while (isref(list)) { list = derefone(list); } - while(list != NILATOM) { - if (i >= Namesize ) { - fatal("atom length is too long"); - } - x = car_of(list); - while (isref(x)) { - x = derefone(x); - } - name[i++] = (unsigned char) intval(x); - list = cdr_of(list); - while (isref(list)) { - list = derefone(list); - } - } - name[i] = 0; - return i; -} - static void -enter_old_atom(i,name) +enter_old_atom(i, name) unsigned int i; unsigned char* name; { @@ -136,18 +112,18 @@ hashvalue = hash_name(name) % (atomhp->hashtablesize); index = atomhp->table[hashvalue] - 1; - if (index >= 0) { - while ((strcmp((char*) atomname[index], (char*) name))) { + if( index >= 0 ){ + while( strcmp((char*) atomname[index], (char*) name) != 0 ){ long index0 = nextatom[index]; - if (index0 == -1) { - nextatom[index] = i; + if( index0 == -1 ){ + nextatom[index] = i; nextatom[i] = -1; goto finish; - } else { + }else{ index = index0; } } - } else { + }else{ atomhp->table[hashvalue] = i + 1; nextatom[i] = -1; } @@ -161,20 +137,22 @@ { long index, hashvalue; - hashvalue = ((long) (a_no - ATOMNUMBERBASE + arity)) % - functhp->hashtablesize; + hashvalue = + ((long) (a_no - ATOMNUMBERBASE + arity)) % functhp->hashtablesize; index = functhp->table[hashvalue]-1; - if (index >= 0) { - while ((functors[index] != a_no) || (arities[index] != arity)) { + if( index >= 0 ){ + while( (functors[index] != a_no) || (arities[index] != arity) ){ long index0 = nextfunctor[index]; - if (index0 == -1) { - nextfunctor[index] = i; + if( index0 == -1 ){ + nextfunctor[index] = i; nextfunctor[i] = -1; goto finish; - } else index = index0; + }else{ + index = index0; + } } - } else { + }else{ functhp->table[hashvalue] = i + 1; nextfunctor[i] = -1; } @@ -184,6 +162,7 @@ static void make_atom_table() { + const unsigned long numberOfAtoms = initial_atoms; unsigned int i; init_atom = DONE; @@ -194,24 +173,25 @@ (long*) malloc_check((unsigned) (sizeof(long) * Hashsize)); namearea = (unsigned char*) malloc_check((unsigned) Namesize); nameareap = namearea; - if (numberOfAtoms) { + if( numberOfAtoms > 0 ){ atomhp->nametablesize = numberOfAtoms; nextatom = (long*) malloc_check((unsigned) (sizeof(long) * numberOfAtoms)); - } else { + }else{ atomhp->nametablesize = 1; atomname = (unsigned char**) malloc_check(sizeof(char*)); nextatom = (long*) malloc_check(sizeof(long)); } - for (i = 0; i < Hashsize; i++) { atomhp->table[i] = 0; } - for (i = 0; i < atomhp->nametablesize; i++) { nextatom[i] = -1; } - for (i = 0; i < numberOfAtoms; i++) {enter_old_atom(i,atomname[i]);} + for( i = 0; i < Hashsize; i++ ){ atomhp->table[i] = 0; } + for( i = 0; i < atomhp->nametablesize; i++ ){ nextatom[i] = -1; } + for( i = 0; i < numberOfAtoms; i++ ){ enter_old_atom(i, atomname[i]); } } static void make_functor_table() { + const unsigned long numberOfFunctors = initial_functors; unsigned int i; init_functor = DONE; @@ -220,52 +200,50 @@ functhp->hashtablesize = Hashsize; functhp->table = (long*) malloc_check((unsigned) (sizeof(long) * Hashsize)); - if (numberOfFunctors) { + if( numberOfFunctors > 0 ){ functhp->functortablesize = numberOfFunctors; nextfunctor = (long*) malloc_check((unsigned) (sizeof(long) * numberOfFunctors)); - } else { + }else{ functhp->functortablesize = 1; functors = (unsigned long*) malloc_check(sizeof(q)); arities = (unsigned long*) malloc_check(sizeof(q)); nextfunctor = (long*) malloc_check(sizeof(q)); } - for (i = 0; i < Hashsize; i++) { functhp->table[i] = 0; } - for (i = 0; i < functhp->functortablesize; i++) {nextfunctor[i] = -1;} - for (i = 0; i < numberOfFunctors; i++) - { enter_old_functor(i,functors[i],arities[i]); } + for( i = 0; i < Hashsize; i++ ){ functhp->table[i] = 0; } + for( i = 0; i < functhp->functortablesize; i++ ){ nextfunctor[i] = -1; } + for( i = 0; i < numberOfFunctors; i++ ) + { enter_old_functor(i, functors[i], arities[i]); } } -extern unsigned char* generic_string_body(); -extern unsigned long generic_string_size(); - extern unsigned long enter_atom_body(name, namelen) - char name[]; - unsigned long namelen; + char* name; + unsigned long namelen; { declare_globals; long index, index0, hashvalue; - if (init_atom) make_atom_table(); + if( init_atom ) make_atom_table(); - if (strcmp((char*) name,"[]")==0) return 0L; - if (strcmp((char*) name,".")==0) return 1L; + if( strcmp((char*) name, "[]")==0 ) return 0L; + if( strcmp((char*) name, ".")==0 ) return 1L; hashvalue = ((unsigned long) hash_name(name)) % atomhp->hashtablesize; #ifdef SHM s_lock(a_key()); #endif + again: index = atomhp->table[hashvalue] - 1; - if (index >= 0) { - while ((strcmp((char*) atomname[index], (char*) name))) { + if( index >= 0 ){ + while( (strcmp((char*) atomname[index], (char*) name)) ){ index0 = nextatom[index]; - if (index0 == -1) { - if (atomhp->atomid +1 == atomhp->nametablesize ) goto expand; + if( index0 == -1 ){ + if( atomhp->atomid +1 == atomhp->nametablesize ) goto expand; atomhp->atomid ++; nextatom[index] = (long) atomhp->atomid; - if ((long)(nameareap-namearea) + namelen + 1 >= Namesize){ + if( (long)(nameareap-namearea) + namelen + 1 >= Namesize ){ namearea = (unsigned char*) malloc_check((unsigned) Namesize); nameareap = namearea; } @@ -278,7 +256,7 @@ s_unlock(a_key()); #endif return atomhp->atomid + ATOMNUMBERBASE; - } else { + }else{ index = index0; } } @@ -286,11 +264,11 @@ s_unlock(a_key()); #endif return index + ATOMNUMBERBASE; - } - else { - if (atomhp->atomid +1 == atomhp->nametablesize) goto expand; - else { - if ((long)(nameareap-namearea) + namelen >= Namesize) { + }else{ + if( atomhp->atomid +1 == atomhp->nametablesize ){ + goto expand; + }else{ + if( (long)(nameareap-namearea) + namelen >= Namesize ){ namearea = (unsigned char*) malloc_check((unsigned) Namesize); nameareap = namearea; } @@ -313,17 +291,17 @@ long* newnextatom; int i; #ifdef SHM - if ( is_shma(atomname) ) abend("Can't expand on this version."); + if( is_shma(atomname) ) abend("Can't expand on this version."); #endif newatomname = (unsigned char**) malloc_check((atomhp->nametablesize) * sizeof(char*)*2); - newnextatom = - (long*) malloc_check((atomhp->nametablesize) * sizeof(long)*2); - for (i = 0; i < atomhp->nametablesize; i++) { + newnextatom = (long*) + malloc_check((atomhp->nametablesize) * sizeof(long)*2); + for( i = 0; i < atomhp->nametablesize; i++ ){ newatomname[i] = atomname[i]; newnextatom[i] = nextatom[i]; } - for (i = atomhp->nametablesize; i < 2*atomhp->nametablesize; i++) { + for( i = atomhp->nametablesize; i < 2*atomhp->nametablesize; i++ ){ newnextatom[i] = -1; } atomhp->nametablesize = 2 * atomhp->nametablesize; @@ -333,24 +311,11 @@ goto again; } -/* -unsigned long intern(name0) - q name0; -{ - unsigned char name[Namesize]; - unsigned long length; - if (name0 == NILATOM) return AtomError; - length = list2name(name, name0); - return enter_atom_body(name, length); -} -*/ - extern unsigned long enter_atom_string(name0) q name0; { - extern unsigned char *convert_klic_string_to_c_string(); - unsigned char *name = convert_klic_string_to_c_string(name0); + unsigned char* name = convert_klic_string_to_c_string(name0); unsigned long retval = enter_atom_body(name, generic_string_size(functorp(name0))); free(name); @@ -358,90 +323,90 @@ } extern unsigned long -enter_functor(a_no,arity) +enter_functor(a_no, arity) unsigned long a_no, arity; { declare_globals; long index, index0, hashvalue; - if (init_functor) make_functor_table(); + if( init_functor ) make_functor_table(); + + hashvalue = + ((long)(a_no - ATOMNUMBERBASE + arity)) % functhp->hashtablesize; - hashvalue = ((long)(a_no - ATOMNUMBERBASE + arity)) % - functhp->hashtablesize; #ifdef SHM s_lock(f_key()); #endif - again: - if ((index = functhp->table[hashvalue]-1)>= 0) { - while ((functors[index] != a_no) || (arities[index] != arity)) { - if ((index0 = nextfunctor[index]) == -1) { - if (functhp->functorid +1 == functhp->functortablesize ) goto expand; - nextfunctor[index] = (long) (++(functhp->functorid)); + + again: + index = functhp->table[hashvalue] - 1; + if( index >= 0 ){ + while( (functors[index] != a_no) || (arities[index] != arity) ){ + index0 = nextfunctor[index]; + if( index0 == -1 ){ + if( functhp->functorid +1 == functhp->functortablesize ) goto expand; + ++ functhp->functorid; + nextfunctor[index] = (long) functhp->functorid; functors[functhp->functorid] = a_no; arities[functhp->functorid] = arity; nextfunctor[functhp->functorid] = -1; #ifdef SHM s_unlock(f_key()); #endif - return(functhp->functorid + FUNCTORNUMBERBASE); - } else index = index0;} + return functhp->functorid + FUNCTORNUMBERBASE; + }else{ + index = index0; + } + } + #ifdef SHM s_unlock(f_key()); #endif - return(index + FUNCTORNUMBERBASE); - } - else { - if ( functhp->functorid +1 == functhp->functortablesize) goto expand; - else { - functhp->table[hashvalue] = ++(functhp->functorid) + 1; + return index + FUNCTORNUMBERBASE; + }else{ + if( functhp->functorid +1 == functhp->functortablesize ){ + goto expand; + }else{ + ++ functhp->functorid; + functhp->table[hashvalue] = functhp->functorid + 1; functors[functhp->functorid] = a_no; arities[functhp->functorid] = arity; nextfunctor[functhp->functorid] = -1; } + #ifdef SHM s_unlock(f_key()); #endif - return(functhp->functorid + FUNCTORNUMBERBASE); + return functhp->functorid + FUNCTORNUMBERBASE; } expand: - { unsigned long *newfunctors; - unsigned long *newarities; - unsigned long *newnextfunctor; + { unsigned long* newfunctors; + unsigned long* newarities; + unsigned long* newnextfunctor; int i; #ifdef SHM - if ( is_shma(functors) ) abend("Can't expand on this version."); + if( is_shma(functors) ) abend("Can't expand on this version."); #endif - newfunctors = - (unsigned long *) - malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); - newarities = - (unsigned long *) - malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); - newnextfunctor = - (unsigned long *) - malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); - for (i = 0; i < functhp->functortablesize; i++) { + newfunctors = (unsigned long*) + malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); + newarities = (unsigned long*) + malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); + newnextfunctor = (unsigned long*) + malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); + for( i = 0; i < functhp->functortablesize; i++ ){ newfunctors[i] = functors[i]; newarities[i] = arities[i]; newnextfunctor[i] = nextfunctor[i]; } - for (i = functhp->functortablesize; - i < 2*functhp->functortablesize; i++) { + for( i = functhp->functortablesize; + i < 2*functhp->functortablesize; i++ ){ newnextfunctor[i] = -1; } - functhp->functortablesize = 2 *functhp->functortablesize; + functhp->functortablesize = 2 * functhp->functortablesize; functors = newfunctors; arities = newarities; - nextfunctor = (long *)newnextfunctor; + nextfunctor = (long*) newnextfunctor; } - goto again; -} - -/* -unsigned long new_atom() -{ - atomname[atomhp->atomid] = 0; - return (atomhp->atomid)++ + ATOMNUMBERBASE; + goto again; } -*/ diff -ruN klic-3.003-2002-01-06b/runtime/options.c klic-3.003-2002-01-06c/runtime/options.c --- klic-3.003-2002-01-06b/runtime/options.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-06c/runtime/options.c Sun Jan 6 15:53:48 2002 @@ -7,131 +7,129 @@ #include #include "options.h" -static char * + +extern double atof(); + +static char* parse_size(str, retp) -long *retp; -char *str; + char* str; + long* retp; { - long n; - char c[2]; - switch (sscanf(str, "%ld%1s", &n, c)) { - case 1: - *retp = n; - return 0; - case 2: - switch (tolower(c[0])) { - case 'k': - *retp = n << 10; - return 0; - case 'm': - *retp = n << 20; - return 0; - case 'g': - *retp = n << 30; - return 0; - } + long n; + char c[2]; + switch( sscanf(str, "%ld%1s", &n, c) ){ + case 1: + *retp = n; + return NULL; + case 2: + switch( tolower(c[0]) ){ + case 'k': + *retp = n << 10; + return NULL; + case 'm': + *retp = n << 20; + return NULL; + case 'g': + *retp = n << 30; + return NULL; } - return str; + } + return str; } -char * + +extern char* parse_opts(opttbl, acp, avp) -const struct opttable* opttbl; -int *acp; -char ***avp; + const struct opttable* opttbl; + int* acp; + char*** avp; { - char **argv = *avp; - char *errp; - int argc = *acp; - const struct opttable* tblp; - int argc_adv; - int no_set = 0; /* -$ option suppress setting variables */ - double atof(); - - for (argc_adv = 1; argc_adv < argc; ++argc_adv) { - char *opttop; - if (argv[argc_adv][0] != '-') - break; - opttop = &argv[argc_adv][1]; - if (opttop[0] == '-' && opttop[1] == '\0') { /* options after -- */ - ++argc_adv; - break; - } else if (opttop[0] == '$' && opttop[1] == '\0') { /* -$ */ - no_set = 1; - continue; - } - parse_succesive_arg: - if (opttop[0] == '\0') + char** argv = *avp; + char* errp; + int argc = *acp; + const struct opttable* tblp; + int argc_adv; + int no_set = 0; /* -$ option suppress setting variables */ + + for( argc_adv = 1; argc_adv < argc; ++argc_adv ){ + char* opttop; + if( argv[argc_adv][0] != '-' ) + break; + opttop = &argv[argc_adv][1]; + if( opttop[0] == '-' && opttop[1] == '\0' ){ /* options after -- */ + ++argc_adv; + break; + }else if( opttop[0] == '$' && opttop[1] == '\0' ){ /* -$ */ + no_set = 1; + continue; + } + parse_succesive_arg: + if( opttop[0] == '\0' ) + goto proc_next_arg; + + for( tblp = opttbl; tblp->opt_str != NULL; tblp++ ){ + char* candid_ptr = tblp->opt_str; + int optind; + + if( candid_ptr[0] != opttop[0] ) + continue; + optind = strlen(candid_ptr); + if( strncmp(opttop+1, candid_ptr+1, optind-1) ){ + goto try_next_candidate; + }else{ + /* We think a option found. + * Check the descriptor for the argument */ + enum argtype type = ARG_ORIGINAL_TYPE(tblp->opt_type); + + if( type == ARG_RESET || type == ARG_SET ){ /* on/off */ + if( !no_set ) + tblp->opt_dest->i = (type==ARG_SET); + opttop += optind; + goto parse_succesive_arg; + }else if( type == ARG_STRING ){ /* string output */ + /* string option must be mached exactly */ + if( opttop[optind] != '\0' ){ + goto try_next_candidate; + }else if( argc_adv + 1 >= argc ){ + /* no argument followed? */ + goto try_next_candidate; + } + argc_adv++; + if( !no_set ) + tblp->opt_dest->s = argv[argc_adv]; goto proc_next_arg; - - for (tblp = opttbl; tblp->opt_str; tblp++) { - char *candid_ptr = tblp->opt_str; - int optind; - - if (candid_ptr[0] != opttop[0]) - continue; - optind = strlen(candid_ptr); - if (strncmp(opttop+1, candid_ptr+1, optind-1)) - goto try_next_candidate; - - else { - /* We think a option found. - Check the descriptor for the argument */ - enum argtype type = ARG_ORIGINAL_TYPE(tblp->opt_type); - - if (type == ARG_RESET || type == ARG_SET) { /* on/off */ - if (!no_set) - tblp->opt_dest->i = (type==ARG_SET); - opttop += optind; - goto parse_succesive_arg; - - } else if (type == ARG_STRING) { /* string output */ - /* string option must be mached exactly */ - if (opttop[optind] != '\0') - goto try_next_candidate; - else if (argc_adv + 1 >= argc) - /* no argument followed? */ - goto try_next_candidate; - argc_adv++; - if (!no_set) - tblp->opt_dest->s = argv[argc_adv]; - goto proc_next_arg; - - } else { /* float or int case */ - char *opts_arg; - if (opttop[optind] != '\0') /* param follows */ - opts_arg = &opttop[optind]; - else if (argc_adv + 1 >= argc) /*no param followed?*/ - goto try_next_candidate; - else { /* parm is the next arg */ - argc_adv++; - opts_arg = argv[argc_adv]; - } - - if (!no_set) { - if (type == ARG_SIZE) { /* size_spec */ - errp = parse_size(opts_arg, &(tblp->opt_dest->l)); - if (errp) - return errp; - } else if (type == ARG_DOUBLE) { /* floating */ - if (sscanf(opts_arg, - "%le", &(tblp->opt_dest->d)) != 1) - return opts_arg; - } else { /* this must not happen!! */ -#if 0 - fprintf(stderr, "argtab spec internal error\n"); - abort(); -#endif - } - } - goto proc_next_arg; - } + }else{ /* float or int case */ + char* opts_arg; + if( opttop[optind] != '\0' ){ /* param follows */ + opts_arg = &opttop[optind]; + }else if( argc_adv + 1 >= argc ){ /* no param followed? */ + goto try_next_candidate; + }else{ /* parm is the next arg */ + argc_adv++; + opts_arg = argv[argc_adv]; + } + + if( !no_set ){ + if( type == ARG_SIZE ){ /* size_spec */ + errp = parse_size(opts_arg, &(tblp->opt_dest->l)); + if( errp ) + return errp; + }else if( type == ARG_DOUBLE ){ /* floating */ + if( sscanf(opts_arg, "%le", &(tblp->opt_dest->d)) != 1 ) + return opts_arg; + }else{ /* this must not happen!! */ + fprintf(stderr, "argtab spec internal error\n"); + abort(); } - try_next_candidate:; + } + goto proc_next_arg; } - return opttop; - proc_next_arg:; + } + try_next_candidate: ; } - *avp = argv+argc_adv; - *acp = argc-argc_adv; - return 0; + return opttop; + proc_next_arg: ; + } + *avp = argv+argc_adv; + *acp = argc-argc_adv; + return NULL; }