diff -ruN klic-3.003-2002-01-07b/runtime/datamsg.c klic-3.003-2002-01-11/runtime/datamsg.c --- klic-3.003-2002-01-07b/runtime/datamsg.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-11/runtime/datamsg.c Fri Jan 11 10:02:56 2002 @@ -26,6 +26,10 @@ #include +/*** for Distributed KLIC system ***/ +#define generic_encode(obj, pe, depth) \ + (method_table_of(obj)->encode((obj), (pe), (depth))) + extern const long initial_atoms; extern const long initial_functors; q search_exptbl(); diff -ruN klic-3.003-2002-01-07b/runtime/faisus.c klic-3.003-2002-01-11/runtime/faisus.c --- klic-3.003-2002-01-07b/runtime/faisus.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-11/runtime/faisus.c Fri Jan 11 10:02:05 2002 @@ -21,6 +21,9 @@ extern int count_suspension; #endif +#define generic_suspend(obj, ref, goal) \ + (method_table_of(obj)->suspend((ref), (goal))) + static void do_fail(goal, reasonp) struct goalrec *goal; q *reasonp; diff -ruN klic-3.003-2002-01-07b/runtime/gc.c klic-3.003-2002-01-11/runtime/gc.c --- klic-3.003-2002-01-07b/runtime/gc.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-11/runtime/gc.c Fri Jan 11 10:00:01 2002 @@ -37,6 +37,9 @@ } #endif /* SHM */ +#define generic_gc(obj, allocp, sp) \ + (method_table_of(obj)->gc((obj), (allocp), (sp))) + extern struct goalrec goal_queue_tail; static Inline void flip_spaces() diff -ruN klic-3.003-2002-01-07b/runtime/gio.c klic-3.003-2002-01-11/runtime/gio.c --- klic-3.003-2002-01-07b/runtime/gio.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-11/runtime/gio.c Fri Jan 11 11:48:04 2002 @@ -20,48 +20,54 @@ #include "atom.h" #include "funct.h" +#define GC_CLASS_NAME() file__io +#define GC_OBJ_TYPE struct file_io_object +#define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) + +#include + +#define CheckInput() \ +do{ \ + if( GC_SELF->infile == NULL ) goto message_error; \ + if( GC_SELF->outfile != NULL ) do_flush(GC_SELF); \ +}while(0) + +#define CheckOutput() \ +do{ \ + if( GC_SELF->outfile == NULL ) goto message_error; \ +}while(0) + +extern size_t strlen(); +extern unsigned char* generic_string_body(); +extern q convert_binary_c_string_to_klic_string(); + struct file_io_object { - struct consumer_object_method_table *method_table; + struct consumer_object_method_table* method_table; int linecount; q inname, outname; q stream; /* saved input stream for suspension by some other reasons */ - FILE *infile, *outfile; + FILE* infile; + FILE* outfile; }; -#define GC_CLASS_NAME() file__io -#define GC_OBJ_TYPE struct file_io_object -#define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) - GD_USE_CLASS(byte__string); GD_USE_CLASS(pointer); -#include - /* basic method definitions */ -static long do_flush(obj) - struct file_io_object *obj; +static long +do_flush(obj) + struct file_io_object* obj; { #ifdef DIST - if (obj->infile == stdin || - (obj->outfile == stdout || obj->outfile == stderr)) { + if( obj->infile == stdin || + obj->outfile == stdout || obj->outfile == stderr ){ return UserFflush(); - } else + }else #endif - { - return klic_fflush(obj->outfile); - } -} - -#define CheckInput() \ -{ \ - if (GC_SELF->infile == 0) goto message_error; \ - if (GC_SELF->outfile != 0) do_flush(GC_SELF); \ -} - -#define CheckOutput() \ -{ \ - if (GC_SELF->outfile == 0) goto message_error; \ + { + return klic_fflush(obj->outfile); + } } GCDEF_UNIFY() @@ -70,264 +76,273 @@ q newvar; q reason; - if (GC_SELF->stream != 0) { + if( GC_SELF->stream != 0 ){ GC_TERM = GC_SELF->stream; GC_SELF->stream = 0; } top: - if (G_ISCONS(GC_TERM)) { + if( G_ISCONS(GC_TERM) ){ q message; GCSET_MESSAGE(message); - if (G_ISINT(message)) { + if( G_ISINT(message) ){ long c = G_INTVAL(message); #ifdef DIST - if (GC_SELF->outfile == stdout) { - UserPutc(c); - } else if (GC_SELF->outfile == stderr) { - UserEPutc(c); - } else + if( GC_SELF->outfile == stdout ){ + UserPutc(c); + }else if( GC_SELF->outfile == stderr ){ + UserEPutc(c); + }else #endif - { - if (klic_putc(c, GC_SELF->outfile) == EOF) { - GC_FAIL("putc failed"); - } - } - } else if (G_ISFUNCTOR(message)) { - switch (G_SYMVAL(G_FUNCTOR_OF(message))) { + if( klic_putc(c, GC_SELF->outfile) == EOF ){ + GC_FAIL("putc failed"); + } + }else if( G_ISFUNCTOR(message) ){ + switch( G_SYMVAL(G_FUNCTOR_OF(message)) ){ + /*** Input Messages ***/ + case functor_getc_1: { long c; CheckInput(); #ifdef DIST - if (GC_SELF->infile == stdin) { + if( GC_SELF->infile == stdin ){ c = UserGetc(); - } else + }else #endif - { - c = klic_getc(GC_SELF->infile); - } - if (c=='\n') { GC_SELF->linecount++; } - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(c)); + { + c = klic_getc(GC_SELF->infile); + } + if( c=='\n' ){ GC_SELF->linecount++; } + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(c)); break; } + case functor_ungetc_1: { long c; CheckInput(); GCSET_MESSAGE_INT_ARG(c, message, 0); - if (c=='\n') { GC_SELF->linecount--; } + if( c=='\n' ){ GC_SELF->linecount--; } #ifdef DIST - if (GC_SELF->infile == stdin) { + if( GC_SELF->infile == stdin ){ UserUngetc(c); - } else + }else #endif - { - ungetc(c, GC_SELF->infile); - } + { + ungetc(c, GC_SELF->infile); + } break; } + case functor_fread_2: { - extern q convert_binary_c_string_to_klic_string(); long n, k; - char *buf; + char* buf; q string; long space_needed; CheckInput(); GCSET_MESSAGE_INT_ARG(n, message, 0); - if (n<0) goto message_error; - space_needed = sizeof(struct byte_string_object)+n+sizeof(q); - if ((char *)g_allocp+space_needed >= (char *)real_heaplimit) { + if( n<0 ) goto message_error; + space_needed = sizeof(struct byte_string_object) + n + sizeof(q); + if( (char*) g_allocp+space_needed >= (char*) real_heaplimit ){ this_more_space += (space_needed+sizeof(q)-1)/sizeof(q); goto gc_request; } - buf = (char *)malloc_check(n); + buf = (char*) malloc_check(n); #ifdef DIST - if (GC_SELF->infile == stdin) { - size_t strlen(); - Read(buf); + if( GC_SELF->infile == stdin ){ + Read(buf); n = strlen(buf); - } else + }else #endif - { - n = klic_fread(buf, 1, n, GC_SELF->infile); - } + { + n = klic_fread(buf, 1, n, GC_SELF->infile); + } - for (k=0; klinecount++; } + for( k=0; klinecount++; } } string = convert_binary_c_string_to_klic_string(buf, n, g_allocp); - if (G_ISREF(string)) { + if( G_ISREF(string) ){ GC_FAIL("internal error: string allocation for fread"); } g_allocp = heapp; free(buf); - GC_UNIFY_VALUE(G_ARG(message,1), string); + GC_UNIFY_VALUE(G_ARG(message, 1), string); break; } + case functor_linecount_1: { CheckInput(); - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(GC_SELF->linecount)); + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(GC_SELF->linecount)); break; } + /*** Output Messages ***/ + case functor_putc_1: { long c; CheckOutput(); GCSET_MESSAGE_INT_ARG(c, message, 0); #ifdef DIST - if (GC_SELF->outfile == stdout) { UserPutc((int)c); } - else if (GC_SELF->outfile == stderr) { UserEPutc((int)c); } - else -#endif - { - if (klic_putc(c, GC_SELF->outfile) == EOF) { - GC_FAIL("putc failed"); - } - } + if( GC_SELF->outfile == stdout ){ UserPutc((int) c); } + else if( GC_SELF->outfile == stderr ){ UserEPutc((int) c); } + else +#endif + if( klic_putc(c, GC_SELF->outfile) == EOF ){ + GC_FAIL("putc failed"); + } break; } + case functor_fwrite_2: { - extern unsigned char *generic_string_body(); - struct byte_string_object *str; + struct byte_string_object* str; int size; int written; CheckOutput(); GCSET_MESSAGE_STR_ARG(str, message, 0); size = generic_string_size(str); #ifdef DIST - if (GC_SELF->outfile == stdout) { + if( GC_SELF->outfile == stdout ){ UserWrite(generic_string_body(str), size); written = size; - } else if (GC_SELF->outfile == stderr) { + }else if( GC_SELF->outfile == stderr ){ UserEWrite(generic_string_body(str), size); written = size; - } else + }else #endif { - written = klic_fwrite(generic_string_body(str), - 1, size, GC_SELF->outfile); + written = klic_fwrite(generic_string_body(str), + 1, size, GC_SELF->outfile); } - GC_UNIFY_VALUE(G_ARG(message,1), G_MAKEINT(written)); + GC_UNIFY_VALUE(G_ARG(message, 1), G_MAKEINT(written)); break; } + case functor_fwrite_1: { - extern unsigned char *generic_string_body(); - struct byte_string_object *str; - char *strbody; + struct byte_string_object* str; + char* strbody; int size; int written = 0; CheckOutput(); GCSET_MESSAGE_STR_ARG(str, message, 0); - strbody = (char *)generic_string_body(str); + strbody = (char*) generic_string_body(str); size = generic_string_size(str); #ifdef DIST - if (GC_SELF->outfile == stdout) { - UserWrite(strbody, size); - } else if (GC_SELF->outfile == stderr) { - UserEWrite(strbody, size); - } else -#endif - { - while (size > 0) { - written = klic_fwrite(strbody+written, 1, - size, GC_SELF->outfile); - size -= written; - } + if( GC_SELF->outfile == stdout ){ + UserWrite(strbody, size); + }else if( GC_SELF->outfile == stderr ){ + UserEWrite(strbody, size); + }else +#endif + { + while( size > 0 ){ + written = + klic_fwrite(strbody+written, 1, size, GC_SELF->outfile); + size -= written; } + } break; } + /*** Common Messages ***/ + case functor_feof_1: { long iseof; #ifdef DIST - if (GC_SELF->infile == stdin || + if( GC_SELF->infile == stdin || GC_SELF->outfile == stdout || - GC_SELF->outfile == stderr) { iseof = 0; } - else + GC_SELF->outfile == stderr ){ iseof = 0; } + else #endif - { - if (GC_SELF->infile != 0) { - iseof = feof(GC_SELF->infile); - } else { - iseof = feof(GC_SELF->outfile); - } + { + if( GC_SELF->infile != NULL ){ + iseof = feof(GC_SELF->infile); + }else{ + iseof = feof(GC_SELF->outfile); } - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(iseof)); + } + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(iseof)); break; } + case functor_fseek_3: { long offset, whence, result; GCSET_MESSAGE_INT_ARG(offset, message, 0); GCSET_MESSAGE_INT_ARG(whence, message, 1); #ifdef DIST - if (GC_SELF->infile == stdin || - (GC_SELF->outfile == stdout || GC_SELF->outfile == stderr)) { - result = 0; - } else + if( GC_SELF->infile == stdin || + GC_SELF->outfile == stdout || GC_SELF->outfile == stderr ){ + result = 0; + }else #endif { - FILE *file = - (GC_SELF->infile == 0 ? GC_SELF->outfile : GC_SELF->infile); + FILE* file = + (GC_SELF->infile == NULL ? GC_SELF->outfile : GC_SELF->infile); result = fseek(file, offset, whence); } - GC_UNIFY_VALUE(G_ARG(message,2), G_MAKEINT(result)); + GC_UNIFY_VALUE(G_ARG(message, 2), G_MAKEINT(result)); break; } + case functor_ftell_1: { long result; #ifdef DIST - if (GC_SELF->infile == stdin || - (GC_SELF->outfile == stdout || GC_SELF->outfile == stderr)) { - result = 0; - } else + if( GC_SELF->infile == stdin || + GC_SELF->outfile == stdout || GC_SELF->outfile == stderr ){ + result = 0; + }else #endif - { - FILE *file = - (GC_SELF->infile == 0 ? GC_SELF->outfile : GC_SELF->infile); - result = ftell(file); - } - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(result)); + { + FILE* file = + (GC_SELF->infile == NULL ? GC_SELF->outfile : GC_SELF->infile); + result = ftell(file); + } + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(result)); break; } + case functor_fflush_1: { long result = do_flush(GC_SELF); - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(result)); + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(result)); break; } + case functor_fclose_1: { long result; #ifdef DIST - if (GC_SELF->infile == stdin || - GC_SELF->outfile == stdout || GC_SELF->outfile == stderr) - result = 0; - else + if( GC_SELF->infile == stdin || + GC_SELF->outfile == stdout || GC_SELF->outfile == stderr ){ + result = 0; + }else #endif { - if (GC_SELF->outfile != 0 && + if( GC_SELF->outfile != NULL && GC_SELF->outfile != stdout && - GC_SELF->outfile != stderr) { + GC_SELF->outfile != stderr ){ result = fclose(GC_SELF->outfile); - GC_SELF->outfile = 0; - } else { + GC_SELF->outfile = NULL; + }else{ result = 0; } - if (result == 0) { - if (GC_SELF->infile != 0 && - GC_SELF->infile != stdin) { + if( result == 0 ){ + if( GC_SELF->infile != NULL && + GC_SELF->infile != stdin ){ result = fclose(GC_SELF->infile); - GC_SELF->infile = 0; + GC_SELF->infile = NULL; } } - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(result)); - break; } + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(result)); + break; } + case functor_sync_1: { - GC_UNIFY_VALUE(G_ARG(message,0), G_MAKEINT(0)); + GC_UNIFY_VALUE(G_ARG(message, 0), G_MAKEINT(0)); break; } + default: goto message_error; } - } else { + }else{ goto message_error; } GC_TERM = G_CDR_OF(GC_TERM); @@ -335,48 +350,45 @@ message_error: { - extern unsigned char *generic_string_body(); - char *inname, *outname; - inname = (char *)generic_string_body(G_FUNCTORP(GC_SELF->inname)); - if (inname == 0) inname = ""; - outname = (char *)generic_string_body(G_FUNCTORP(GC_SELF->outname)); - if (outname == 0) outname = ""; + char* inname = (char*) generic_string_body(G_FUNCTORP(GC_SELF->inname)); + char* outname = (char*) generic_string_body(G_FUNCTORP(GC_SELF->outname)); + if( inname == NULL ) inname = ""; + if( outname == NULL ) outname = ""; debug_printf("Invalid message %k to I/O stream for %s%s%s\n", message, inname, - ((*inname !=0 && *outname !=0 && - strcmp(inname,outname) != 0) ? "/" : ""), + ((*inname != '\0' && *outname !='\0') ? "/" : ""), outname); GC_FAIL("message error"); } - } else if (GC_TERM==NILATOM) { + }else if( GC_TERM==NILATOM ){ #ifdef DIST - if (GC_SELF->outfile == stdout) { + if( GC_SELF->outfile == stdout ){ UserFflush(); - } else if (GC_SELF->outfile == stderr) { + }else if( GC_SELF->outfile == stderr ){ UserEFflush(); - } else if (GC_SELF->infile == stdin) { - } else + }else if( GC_SELF->infile == stdin ){ + }else #endif - { - if (GC_SELF->infile != 0 && GC_SELF->infile != stdin) { - fclose(GC_SELF->infile); - } - if (GC_SELF->outfile != 0 && - GC_SELF->outfile != stdout && - GC_SELF->outfile != stderr) { - fclose(GC_SELF->outfile); - } + { + if( GC_SELF->infile != NULL && GC_SELF->infile != stdin ){ + fclose(GC_SELF->infile); } + if( GC_SELF->outfile != NULL && + GC_SELF->outfile != stdout && + GC_SELF->outfile != stderr ){ + fclose(GC_SELF->outfile); + } + } GC_TERMINATE; - } else if (G_ISREF(GC_TERM)) { + }else if( G_ISREF(GC_TERM) ){ q temp = G_DEREFONE(GC_TERM); - if (G_ISREF(temp) && - (temp == GC_TERM || G_DEREFONE(temp) == GC_TERM)) { + if( G_ISREF(temp) && + (temp == GC_TERM || G_DEREFONE(temp) == GC_TERM) ){ reason = GC_TERM; GC_SELF->stream = 0; goto suspend; - } else { + }else{ GC_TERM = temp; goto top; } @@ -384,7 +396,7 @@ gc_request: G_MAKE_VAR(newvar); - GC_KL1_UNIFY(GC_TERM,newvar); + GC_KL1_UNIFY(GC_TERM, newvar); GC_RETURN_WITH_HOOK(newvar); suspend: @@ -394,13 +406,13 @@ GCDEF_GC() { G_STD_DECL; - GC_OBJ_TYPE *newself; + GC_OBJ_TYPE* newself; GCSET_NEWOBJ_IN_NEWGEN(newself); *newself = *GC_SELF; - if (GC_SELF->stream != 0) { - G_COPY_KL1_TERM_TO_NEWGEN(GC_SELF->stream,newself->stream); - } else { + if( GC_SELF->stream != 0 ){ + G_COPY_KL1_TERM_TO_NEWGEN(GC_SELF->stream, newself->stream); + }else{ newself->stream = 0; } G_COPY_KL1_TERM_TO_NEWGEN(GC_SELF->inname, newself->inname); @@ -425,26 +437,27 @@ GCDEF_NEW() { GC_STD_DECL_FOR_NEW; - GC_OBJ_TYPE *newobj; + GC_OBJ_TYPE* newobj; q infile, outfile, inpath, outpath; q var; - struct pointer_object *inptr, *outptr; + struct pointer_object* inptr; + struct pointer_object* outptr; /* - Arguments are: - 0: Input file object - 1: Its name - 2: Output file object - 3: Its name - */ - if (GC_ARGC != 4) GC_ERROR_IN_NEW("Arity mismatch"); + * Arguments are: + * 0: Input file object + * 1: Its name + * 2: Output file object + * 3: Its name + */ + if( GC_ARGC != 4 ) GC_ERROR_IN_NEW("Arity mismatch"); infile = GC_ARGV[0]; GC_DEREF_FOR_NEW(infile); - if (infile != NILATOM && + if( infile != NILATOM && (!G_ISGOBJ(infile) || - (struct data_object_method_table *)G_FUNCTOR_OF(infile) != - &pointer_g_data_method_table)) { + (struct data_object_method_table*) G_FUNCTOR_OF(infile) != + &pointer_g_data_method_table) ){ GC_FAIL("First argument for file creation is not a pointer object"); } inpath = GC_ARGV[1]; @@ -452,27 +465,27 @@ outfile = GC_ARGV[2]; GC_DEREF_FOR_NEW(outfile); - if (outfile != NILATOM && + if( outfile != NILATOM && (!G_ISGOBJ(outfile) || - (struct data_object_method_table *)G_FUNCTOR_OF(outfile) != - &pointer_g_data_method_table)) { + (struct data_object_method_table*) G_FUNCTOR_OF(outfile) != + &pointer_g_data_method_table) ){ GC_FAIL("Third argument for file creation is not a pointer object"); } outpath = GC_ARGV[3]; GC_DEREF_FOR_NEW(outpath); - GCSET_NEWOBJ_FOR_NEW(newobj,GC_OBJ_SIZE(newobj)); - if (infile == NILATOM) { - newobj->infile = 0; - } else { - newobj->infile = (FILE *) - ((struct pointer_object *)G_FUNCTORP(infile))->pointer; + GCSET_NEWOBJ_FOR_NEW(newobj, GC_OBJ_SIZE(newobj)); + if( infile == NILATOM ){ + newobj->infile = NULL; + }else{ + newobj->infile = (FILE*) + ((struct pointer_object*) G_FUNCTORP(infile))->pointer; } - if (outfile == NILATOM) { - newobj->outfile = 0; - } else { - newobj->outfile = (FILE *) - ((struct pointer_object *)G_FUNCTORP(outfile))->pointer; + if( outfile == NILATOM ){ + newobj->outfile = NULL; + }else{ + newobj->outfile = (FILE*) + ((struct pointer_object*) G_FUNCTORP(outfile))->pointer; } newobj->linecount = 0; newobj->inname = inpath; diff -ruN klic-3.003-2002-01-07b/runtime/gmerge.c klic-3.003-2002-01-11/runtime/gmerge.c --- klic-3.003-2002-01-07b/runtime/gmerge.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-11/runtime/gmerge.c Fri Jan 11 10:42:18 2002 @@ -22,13 +22,11 @@ #include #include -extern const struct goalrec* module_gcmerger(); -G_USE_PREDICATE(predicate_gcmerge_xin_4); #define GC_MERGE_IN_GOAL &predicate_gcmerge_xin_4 #define GC_MAKE_MERGE_IN_GOAL(newvar,vec,index,size) \ -{ \ +do{ \ struct goalrec *goalp1; \ G_HEAPALLOC(goalp1,G_SIZE_IN_Q(struct goalrec)-2,(struct goalrec *)); \ goalp1->pred = GC_MERGE_IN_GOAL; \ @@ -37,7 +35,9 @@ goalp1->args[2] = G_MAKEINT(index); \ goalp1->args[3] = G_MAKEINT(size); \ G_PUSH_GOAL(goalp1); \ -} +}while(0) + +G_USE_PREDICATE(predicate_gcmerge_xin_4); GD_USE_CLASS(vector); @@ -57,12 +57,7 @@ GC_TRY_TO_ALLOC(newout,(struct cons *),2,gc_request); newout->car = G_CAR_OF(GC_TERM); GCSET_VAR(newout->cdr); -/**/ GC_UNIFY(GC_SELF->outstream,G_MAKECONS(newout)); -/**/ -/* - GC_KL1_UNIFY(GC_SELF->outstream,G_MAKECONS(newout)); -*/ GC_SELF->outstream = newout->cdr; GC_TERM = G_CDR_OF(GC_TERM); goto top; @@ -71,9 +66,6 @@ if (GC_TERM == NILATOM) { if (--(GC_SELF->count) == 0) { GC_UNIFY(GC_SELF->outstream,NILATOM); -/* - GC_KL1_UNIFY(GC_SELF->outstream,NILATOM); -*/ } GC_TERMINATE; } else goto invalid_data; @@ -91,9 +83,6 @@ GC_SELF->count += size - 1; if (GC_SELF->count == 0) { GC_UNIFY(GC_SELF->outstream,NILATOM); -/* - GC_KL1_UNIFY(GC_SELF->outstream,NILATOM); -*/ } else { q argv[2]; q hook_var; diff -ruN klic-3.003-2002-01-07b/runtime/gmodule.c klic-3.003-2002-01-11/runtime/gmodule.c --- klic-3.003-2002-01-07b/runtime/gmodule.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-11/runtime/gmodule.c Fri Jan 11 10:35:20 2002 @@ -23,11 +23,14 @@ #define GD_CLASS_NAME() module #define GD_OBJ_TYPE struct module_object -#define GD_OBJ_SIZE(obj) (sizeof(struct module_object))/sizeof(q) +#define GD_OBJ_SIZE(obj) ((sizeof(struct module_object))/sizeof(q)) #include #include +extern const struct modinfo defined_modules[]; +extern struct predicate* locate_predicate_in_module(); + /* basic method definitions */ GDDEF_GUNIFY() @@ -101,7 +104,6 @@ GDDEF_GMETHOD(defined_2) { G_STD_DECL; - extern struct predicate *locate_predicate_in_module(); q predname = GD_ARGV[0]; q arity = GD_ARGV[1]; @@ -110,7 +112,7 @@ GD_GDEREF(arity); if (!G_ISINT(arity) || G_INTVAL(arity) < 0) GD_GFAIL; if (locate_predicate_in_module(GD_SELF->name, predname, - G_INTVAL(arity)) != 0) { + G_INTVAL(arity)) != NULL) { GD_GSUCCEED; } else { GD_GFAIL; @@ -147,7 +149,6 @@ { GD_STD_DECL_FOR_NEW; q atom; - extern const struct modinfo defined_modules[]; const struct modinfo* mp; unsigned char *name; diff -ruN klic-3.003-2002-01-07b/runtime/gmvv.c klic-3.003-2002-01-11/runtime/gmvv.c --- klic-3.003-2002-01-07b/runtime/gmvv.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-11/runtime/gmvv.c Fri Jan 11 10:31:26 2002 @@ -30,10 +30,24 @@ #include #define VECTOR_OBJ(x) ((GD_OBJ_TYPE *)(G_FUNCTORP(x))) +#define Shallow(vector) \ +do{ if( !IS_SHALLOW_VECTOR(vector) ) do_shallow(vector); }while(0) + +extern q hash_kl1_term(); + +#ifdef DIST +extern void encode_data(); +extern void push_decode_stack(); +extern q pop_decode_stack(); +extern q element_of_vector(q v, q k); +static q* decode_vector(combuf* inbuf, q* g_allocp); +#endif /* DIST */ + /* shallowing */ -static do_shallow(vector) +static void +do_shallow(vector) struct vector_object *vector; { q v, last, next; @@ -68,8 +82,6 @@ } } -#define Shallow(vector) \ -{ if (!IS_SHALLOW_VECTOR(vector)) do_shallow(vector); } /* basic method definitions */ @@ -143,21 +155,6 @@ newself->index = size; newself->body = newbody; for (k=0; kindex = GD_SELF->index; GD_COPY_KL1_TERM_TO_NEWGEN(GD_SELF->next, newself->next); /* - The following macro is manually expanded inline here - to avoid type conflict problem. - - GD_COPY_KL1_TERM_TO_NEWGEN(GD_SELF->body, newself->body); - */ + * The following macro is manually expanded inline here + * to avoid type conflict problem. + * + * GD_COPY_KL1_TERM_TO_NEWGEN(GD_SELF->body, newself->body); + */ newself->body = GD_SELF->body; if ((g_sp) == gcmax) { (g_sp) = make_larger_stack(g_sp); @@ -181,12 +178,6 @@ } #ifdef DIST -q element_of_vector(); - -q *decode_vector(); -void encode_data(); - - GDDEF_ENCODE() { G_STD_DECL; @@ -209,31 +200,7 @@ return(GENERIC_SUCCEEDED); } - -/* -GDDEF_ENCODE() -{ - G_STD_DECL; - int i; - q elem; - long size; - - Shallow(GD_SELF); - size = GD_SELF->index; - - PUT_BUFFER(buffer, decode_vector); - PUT_BUFFER(buffer, size); - for(i = 0; iindex; if (GD_LEVEL == 0 || size == 0) { @@ -607,7 +573,8 @@ /* Interface with builtin predicates */ -q create_vector(body, size, g_allocp) +extern q +create_vector(body, size, g_allocp) q *body; long size; q *g_allocp; @@ -623,14 +590,16 @@ return G_MAKEFUNCTOR(newvect); } -q size_of_vector(v) +extern q +size_of_vector(v) q v; { Shallow(VECTOR_OBJ(v)); return G_MAKEINT(VECTOR_OBJ(v)->index); } -q element_of_vector(v, k) +extern q +element_of_vector(v, k) q v, k; { Shallow(VECTOR_OBJ(v)); @@ -642,12 +611,8 @@ } #ifdef DIST - - -void push_decode_stack(); -q pop_decode_stack(); - -q *decode_vector(inbuf, g_allocp) +static q* +decode_vector(inbuf, g_allocp) combuf *inbuf; q *g_allocp; { @@ -658,31 +623,31 @@ q res; module decoder; -/* GDSET_NEWOBJ_FOR_NEW(newvect ,G_SIZE_IN_Q(GD_OBJ_TYPE));*/ + /* GDSET_NEWOBJ_FOR_NEW(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE)); */ G_HEAPALLOC_WITH_CHECK(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *), g_allocp, res); -/* G_HEAPALLOC(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *));*/ + /* G_HEAPALLOC(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE*)); */ if(GENERIC_GCREQUEST == res){ this_more_space += G_SIZE_IN_Q(GD_OBJ_TYPE); inbuf->rd_index--; -/* fprintf(stderr, "Node %d Heap shortage in decoding vector(1)",my_node);*/ + /* fprintf(stderr, "Node %d Heap shortage in decoding vector(1)", my_node); */ return(g_allocp); } newvect->method_table = &GD_method_table; newvect-> index = size = (long)GET_BUFFER(inbuf); -/* GD_ALLOC_AREA_FOR_NEW(body, (q*), size);*/ + /* GD_ALLOC_AREA_FOR_NEW(body, (q*), size); */ G_HEAPALLOC_WITH_CHECK(body, size, (q*), g_allocp, res); -/* G_HEAPALLOC(body, size, (q*));*/ + /* G_HEAPALLOC(body, size, (q*)); */ if(GD_GCREQUEST == res){ this_more_space += size; inbuf->rd_index -= 2; -/* fprintf(stderr, "Node %d Heap shortage in decoding vector(2)",my_node);*/ + /* fprintf(stderr, "Node %d Heap shortage in decoding vector(2)", my_node); */ return(g_allocp); } @@ -697,49 +662,4 @@ push_decode_stack((q)makefunctor(newvect)); return(g_allocp); } - -/*q *decode_vector(inbuf, g_allocp) - combuf *inbuf; - q *g_allocp; -{ - G_STD_DECL; - GD_OBJ_TYPE *newvect; - q *body; - long size, k; - module decoder; - -/ * EPrint("Decode vector\n");* / - -/ * GDSET_NEWOBJ_FOR_NEW(newvect ,G_SIZE_IN_Q(GD_OBJ_TYPE));* / -/ * G_HEAPALLOC_WITH_CHECK(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE), - (GD_OBJ_TYPE *), g_allocp, res);* / - G_HEAPALLOC(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *)); - -/ * if(GENERIC_GCREQUEST == res){ - fatal("GC while decoding vector is not supported yet(1)"); - }* / - newvect->method_table = &GD_method_table; - newvect-> index = size = (long)GET_BUFFER(inbuf); - -/ * GD_ALLOC_AREA_FOR_NEW(body, (q*), size);* / -/ * G_HEAPALLOC_WITH_CHECK(body, size, (q*), g_allocp, res); * / - G_HEAPALLOC(body, size, (q*)); -/ * if(GD_GCREQUEST == res){ - fatal("GC while decoding vector is not supported yet(2)"); - }* / - - for(k = 0; knext = VECTOR_SHALLOW_MARK; - newvect->iscnst = 0; - newvect->body = body; - - decode_data = (q)makefunctor(newvect); - return(g_allocp); -} -*/ -#endif +#endif /* DIST */ diff -ruN klic-3.003-2002-01-07b/runtime/gobj.h klic-3.003-2002-01-11/runtime/gobj.h --- klic-3.003-2002-01-07b/runtime/gobj.h Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-01-11/runtime/gobj.h Fri Jan 11 10:03:24 2002 @@ -15,49 +15,19 @@ */ #define method_table_of(obj) ((obj)->method_table) -#define generic_passive_unify(obj, anothor) \ - (method_table_of(obj)->passive_unify((obj), (anothor))) #define generic_active_unify(obj, anothor, allocp) \ do{ \ (allocp) = method_table_of(obj)->active_unify((obj), (anothor), (allocp)); \ }while(0) -#define generic_print(obj, stream, depth, length) \ - (method_table_of(obj)->print((obj), (stream), (depth), (length))) -#define generic_gc(obj, allocp, sp) \ - (method_table_of(obj)->gc((obj), (allocp), (sp))) -#define generic_regist(obj) \ - (method_table_of(obj)->regist(obj)) -#define generic_deallocate(obj) \ - (method_table_of(obj)->deallocate(obj)) -#define generic_close(obj, allocp) \ - (method_table_of(obj)->close(obj)) #define generic_generate(obj, allocp) \ (method_table_of(obj)->generate((obj), (allocp))) -#define generic_suspend(obj, ref, goal) \ - (method_table_of(obj)->suspend((ref), (goal))) - -/*** for Distributed KLIC system ***/ -#define generic_encode(obj, pe, depth) \ - (method_table_of(obj)->encode((obj), (pe), (depth))) - /*** for Shared-memory KLIC system ***/ #define generic_shmcopy(obj) \ (method_table_of(obj)->shmcopy(obj)) -#define generic_new(class, n, args) \ - (((struct data_object_method_table *)(class))->new((n), (args))) - /**** header file for using data and functions defined in kernel ****/ - -/* temporary */ - -#define general_passive_unify(obj, anothor) \ - eq_terms_body((obj), (anothor)) - -#define general_active_unify(obj, anothor, allocp) \ - ((allocp) = do_shallow_unify((allocp), (obj), (anothor))) /* datas for general utility with consumer object diff -ruN klic-3.003-2002-01-07b/runtime/gpointer.c klic-3.003-2002-01-11/runtime/gpointer.c --- klic-3.003-2002-01-07b/runtime/gpointer.c Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-01-11/runtime/gpointer.c Fri Jan 11 09:45:19 2002 @@ -59,7 +59,8 @@ GD_RETURN_FROM_NEW(newobj); } -q gd_new_pointer(arg0,g_allocp) +extern q +gd_new_pointer(arg0, g_allocp) q arg0; q *g_allocp; { diff -ruN klic-3.003-2002-01-07b/runtime/gstring.c klic-3.003-2002-01-11/runtime/gstring.c --- klic-3.003-2002-01-07b/runtime/gstring.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-11/runtime/gstring.c Fri Jan 11 09:44:17 2002 @@ -23,15 +23,26 @@ #define GD_CLASS_NAME() byte__string #define GD_OBJ_TYPE struct byte_string_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)) -#define ELEMSIZE 8 #include +#define ELEMSIZE 8 #define STRING_OBJ(x) ((GD_OBJ_TYPE *)(G_FUNCTORP(x))) +#define ROUND_UP(size) (((size)+sizeof(q)-1)/sizeof(q)) +#define Shallow(string) \ +do{ if( !IS_SHALLOW_STRING(string) ) do_shallow(string); }while(0) + +#ifdef DIST +extern void push_decode_stack(); +extern unsigned char* generic_string_body(GD_OBJ_TYPE* str); +static q* decode_byte_string(combuf* inbuf, q* g_allocp); +#endif /* DIST */ + /* shallowing */ -static do_shallow(string) +static void +do_shallow(string) struct byte_string_object *string; { q s, last, next; @@ -66,8 +77,6 @@ } } -#define Shallow(string) \ -{ if (!IS_SHALLOW_STRING(string)) do_shallow(string); } /* basic method definitions */ @@ -115,8 +124,6 @@ GD_RETURN; } -#define ROUND_UP(size) (((size)+sizeof(q)-1)/sizeof(q)) - GDDEF_GC() { G_STD_DECL; @@ -148,9 +155,6 @@ } #ifdef DIST -q* decode_byte_string(); -unsigned char *generic_string_body(); - /* for byte string */ GDDEF_ENCODE() { @@ -171,8 +175,7 @@ } return(GENERIC_SUCCEEDED); } - -#endif +#endif /* DIST */ #ifdef SHM GDDEF_SHMCOPY() @@ -199,7 +202,7 @@ } return(makefunctor(newself)); } -#endif +#endif /* SHM */ /* Generic method */ @@ -649,54 +652,8 @@ } #ifdef DIST -/*q *decode_byte_string(inbuf, g_allocp) - combuf *inbuf; - q *g_allocp; -{ - G_STD_DECL; - GD_OBJ_TYPE *newstring; - unsigned char *body; - unsigned long size; - long *tmp_buf; - int i; - -/ * printf("Decode string\n");* / - -/ * G_HEAPALLOC_WITH_CHECK(newstring, G_SIZE_IN_Q(GD_OBJ_TYPE), - (GD_OBJ_TYPE *), g_allocp, res);* / - G_HEAPALLOC(newstring, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *)); - -/ * if(GENERIC_GCREQUEST == res){ - fatal("GC while decoding string is not supported yet(1)"); - }* / - newstring->method_table = &GD_method_table; - newstring->index = (long)GET_BUFFER(inbuf); - - size = ROUND_UP(newstring->index); - -/ * G_HEAPALLOC_WITH_CHECK((q *)body, size, (q*), g_allocp, res); * / - G_HEAPALLOC(body, size, (unsigned char *)); - -/ * if(GD_GCREQUEST == res){ - fatal("GC while decoding string is not supported yet(2)"); - }* / - - tmp_buf = (long *)body; - for(i = 0 ; i < size ; i++){ - tmp_buf[i] = GET_BUFFER(inbuf); - } - - newstring->next = STRING_SHALLOW_MARK; - newstring->iscnst = 0; - newstring->body = body; - - decode_data = (q)makefunctor(newstring); - return(g_allocp); -} -*/ -void push_decode_stack(); - -q *decode_byte_string(inbuf, g_allocp) +static q* +decode_byte_string(inbuf, g_allocp) combuf *inbuf; q *g_allocp; { @@ -710,14 +667,14 @@ G_HEAPALLOC_WITH_CHECK(newstring, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *), g_allocp, res); -/* G_HEAPALLOC(newstring, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *)); */ + /* G_HEAPALLOC(newstring, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE*)); */ if(GENERIC_GCREQUEST == res){ this_more_space += G_SIZE_IN_Q(GD_OBJ_TYPE); inbuf->rd_index--; -/* fprintf(stderr, "Node %d Heap shortage in decoding string(1)",my_node);*/ + /* fprintf(stderr, "Node %d Heap shortage in decoding string(1)", my_node); */ return(g_allocp); } newstring->method_table = &GD_method_table; @@ -730,14 +687,14 @@ G_HEAPALLOC_WITH_CHECK(tmpbody, size, (q*), g_allocp, res); body = (unsigned char *) tmpbody; } -/* G_HEAPALLOC(body, size, (unsigned char *));*/ + /* G_HEAPALLOC(body, size, (unsigned char*)); */ if(GD_GCREQUEST == res){ this_more_space += size; inbuf->rd_index -= 2; -/* fprintf(stderr, "Node %d Heap shortage in decoding string(2)",my_node);*/ + /* fprintf(stderr, "Node %d Heap shortage in decoding string(2)", my_node); */ return(g_allocp); } @@ -750,46 +707,30 @@ newstring->iscnst = 0; newstring->body = body; -/* decode_data = (q)makefunctor(newstring);*/ + /* decode_data = (q) makefunctor(newstring); */ push_decode_stack((q)makefunctor(newstring)); return(g_allocp); } +#endif /* DIST */ -#endif - -unsigned char *generic_string_body(str) -GD_OBJ_TYPE *str; +extern unsigned char* +generic_string_body(str) + GD_OBJ_TYPE* str; { Shallow(str); return (str->body); } -unsigned long generic_string_size(str) -GD_OBJ_TYPE *str; +extern unsigned long +generic_string_size(str) + GD_OBJ_TYPE* str; { Shallow(str); return (str->index); } -q gd_new_string(size,g_allocp) - long size; - q *g_allocp; -{ - q argv[1]; - argv[0] = makeint(size); - return byte__string_g_new(1,argv,g_allocp); -} - -q gd_list_to_string(list,g_allocp) - q list; - q *g_allocp; -{ - q argv[2]; - argv[0] = list; - return byte__string_g_new(1,argv,g_allocp); -} - -q convert_c_string_to_klic_string(cstr,g_allocp) +extern q +convert_c_string_to_klic_string(cstr, g_allocp) char *cstr; q *g_allocp; { @@ -804,7 +745,8 @@ return str; } -q convert_binary_c_string_to_klic_string(cstr,len,g_allocp) +extern q +convert_binary_c_string_to_klic_string(cstr, len, g_allocp) char *cstr; long len; q *g_allocp; @@ -819,7 +761,8 @@ return str; } -char *convert_klic_string_to_c_string(s) +extern char* +convert_klic_string_to_c_string(s) q s; { struct byte_string_object *str = @@ -834,14 +777,16 @@ /* Interface with builtin */ -q size_of_string(s) +extern q +size_of_string(s) q s; { Shallow(STRING_OBJ(s)); return G_MAKEINT(STRING_OBJ(s)->index); } -q element_of_string(s, k) +extern q +element_of_string(s, k) q s, k; { Shallow(STRING_OBJ(s)); diff -ruN klic-3.003-2002-01-07b/runtime/gtermarray.c klic-3.003-2002-01-11/runtime/gtermarray.c --- klic-3.003-2002-01-07b/runtime/gtermarray.c Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-01-11/runtime/gtermarray.c Fri Jan 11 09:23:12 2002 @@ -71,7 +71,8 @@ GD_RETURN_FROM_NEW(newobj); } -q gd_new_termarray(argc,argv,g_allocp) +extern q +gd_new_termarray(argc, argv, g_allocp) unsigned long argc; q argv[]; q *g_allocp; diff -ruN klic-3.003-2002-01-07b/runtime/print.c klic-3.003-2002-01-11/runtime/print.c --- klic-3.003-2002-01-07b/runtime/print.c Sun Jan 6 13:30:38 2002 +++ klic-3.003-2002-01-11/runtime/print.c Fri Jan 11 09:58:24 2002 @@ -21,6 +21,9 @@ int verbose_print; #endif +#define generic_print(obj, stream, depth, length) \ + (method_table_of(obj)->print((obj), (stream), (depth), (length))) + extern void fprint_partially(stream, x, depth, length) FILE* stream; diff -ruN klic-3.003-2002-01-07b/runtime/unify2.c klic-3.003-2002-01-11/runtime/unify2.c --- klic-3.003-2002-01-07b/runtime/unify2.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-11/runtime/unify2.c Fri Jan 11 09:55:39 2002 @@ -26,6 +26,9 @@ #define SUCCEEDED ((q)0) #define FAILED ((q)1) +#define generic_passive_unify(obj, anothor) \ + (method_table_of(obj)->passive_unify((obj), (anothor))) + extern q eq_terms_body(x,y) q x, y;