f2j-0.8.1/0000700000077700002310000000000011031241067012244 5ustar seymourgraduatef2j-0.8.1/bin/0000700000077700002310000000000011031241063013010 5ustar seymourgraduatef2j-0.8.1/src/0000700000077700002310000000000011031241064013030 5ustar seymourgraduatef2j-0.8.1/src/codegen.c0000600000077700002310000157576111031241063014627 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/codegen.c,v $ * $Revision: 1.286 $ * $Date: 2007/12/14 20:56:39 $ * $Author: keithseymour $ */ /***************************************************************************** * codegen.c * * * * Generates Java source code from the AST representation of a Fortran * * program. * * * *****************************************************************************/ #include"codegen.h" #include"f2j_externs.h" /***************************************************************************** * Global variables, a necessary evil when working with yacc. * *****************************************************************************/ int gendebug = FALSE; /* set to TRUE to generate debugging output */ char *unit_name, /* name of this function/subroutine */ *returnname, /* return type of this prog. unit */ *cur_filename, /* name of the class file currently writing */ **funcname=input_func;/* input functions, EOF-detecting or non-detecting */ Dlist cur_assign_list = NULL, /* list of labels used in ASSIGN TO statements */ dummy_nodes = NULL, /* list of dummy graph nodes to free later */ doloop = NULL, /* stack of do loop labels */ while_list = NULL, /* stack of while loop labels */ adapter_list = NULL, /* list of adapter functions (see tech report) */ methcall_list = NULL; /* list of methods to be called by reflection */ SUBSTITUTION global_sub={NULL,0}; /* substitution used for implied loops */ FILE *javafp, /* the class file currently generating */ *curfp, /* the file currently being written to */ *savefp; /* temp var for saving the current file pointer */ SYMTABLE /* Symbol tables containing... */ *cur_type_table, /* type information */ *cur_external_table, /* external functions */ *cur_intrinsic_table, /* intrinsic functions */ *cur_args_table, /* variables which are arguments */ *cur_array_table, /* variables which are arrays */ *cur_format_table, /* format statements */ *cur_data_table, /* variables contained in DATA stmts */ *cur_save_table, /* variables contained in SAVE stmts */ *cur_common_table, /* variables contained in COMMON stmts */ *cur_param_table, /* variables which are parameters */ *cur_equiv_table; /* variables which are equivalenced */ JVM_CLASS *cur_class_file; /* class file for the current program unit */ AST *cur_equivList, /* list of equivalences */ *cur_unit, /* program unit currently being translated. */ *local_list; /* saved pointer to list of local vars. */ BOOL import_reflection, /* does this class need to import reflection */ import_blas, /* does it need to import the BLAS library */ bytecode_gen=TRUE, /* is bytecode generation currently enabled */ save_all_locals; /* should all locals be declared static? */ unsigned int stdin_lvar = -1, /* local var number of the EasyIn object */ iovec_lvar = -1; /* local var number of the input/output Vector */ JVM_METHOD *main_method, /* the primary method for this fortran program unit */ *cur_method; JVM_EXCEPTION_TABLE_ENTRY * reflect_entry, /* exception table entry for reflection exceptions. */ * access_entry; /* exception table entry for access exceptions. */ extern METHODTAB intrinsic_toks[]; /* Fortran intrinsic function names. */ extern FILE *devnull; /* file pointer to /dev/null, opened in f2jmain.c */ /***************************************************************************** * * * emit * * * * This is the main code generation function. We traverse the * * AST and recursively call emit() on each node. This * * function figures out what kind of node it's looking at and * * calls the appropriate function to handle the code generation. * * * *****************************************************************************/ void emit (AST * root) { int c; int locals; switch (root->nodetype) { case 0: if (gendebug) fprintf (stderr,"Bad node\n"); emit (root->nextstmt); break; case Progunit: { JVM_METHOD *clinit_method; HASHNODE *hashtemp; char *tmp_method_desc; char *methodname; char *classname; char *tmpname; if (gendebug) printf ("Source.\n"); save_all_locals = root->astnode.source.save_all; tmpname = root->astnode.source.progtype-> astnode.source.name->astnode.ident.name; classname = strdup(tmpname); lowercase(classname); /* check if this program unit is a PROGRAM. if so, the * method name is "main". */ if(root->astnode.source.progtype->nodetype == Program) { /* dup constant "main" so that we can free() later & won't * be trying to free non-heap memory */ methodname = strdup("main"); } else methodname = strdup(classname); classname[0] = toupper(classname[0]); cur_filename = bc_get_full_classname(classname, package_name); /* First set up the local hash tables. */ cur_type_table = root->astnode.source.type_table; cur_external_table = root->astnode.source.external_table; cur_intrinsic_table = root->astnode.source.intrinsic_table; cur_args_table = root->astnode.source.args_table; cur_array_table = root->astnode.source.array_table; cur_format_table = root->astnode.source.format_table; cur_data_table = root->astnode.source.data_table; cur_save_table = root->astnode.source.save_table; cur_common_table = root->astnode.source.common_table; cur_param_table = root->astnode.source.parameter_table; cur_equiv_table = root->astnode.source.equivalence_table; cur_equivList = root->astnode.source.equivalences; cur_assign_list = root->astnode.source.stmt_assign_list; cur_class_file = root->astnode.source.class = bc_new_class(classname,inputfilename, "java.lang.Object", package_name, F2J_CLASS_ACC); bc_add_default_constructor(cur_class_file, F2J_INIT_ACC); if(gendebug) print_equivalences(cur_equivList); initialize_lists(); clinit_method = bc_new_method(cur_class_file, "", "()V", strictFp ? F2J_STRICT_ACC : F2J_NORMAL_ACC); cur_method = clinit_method; locals = assign_varnums_to_arguments( root->astnode.source.progtype->astnode.source.args); /* needs_reflection is determined during typecheck */ if(root->astnode.source.progtype->astnode.source.needs_reflection) import_reflection = TRUE; else import_reflection = FALSE; /* needs_blas is also determined during typecheck */ if(root->astnode.source.progtype->astnode.source.needs_blas && !type_lookup(blas_routine_table,tmpname)) import_blas = TRUE; else import_blas = FALSE; prepare_comments(root); open_output_file(root->astnode.source.progtype, classname); savefp = curfp; set_bytecode_status(cur_method, JAVA_AND_JVM); if(root->astnode.source.prologComments != NULL) emit_prolog_comments(root); if((hashtemp=type_lookup(function_table, tmpname)) != NULL) tmp_method_desc = hashtemp->variable->astnode.source.descriptor; else tmp_method_desc = MAIN_DESCRIPTOR; main_method = bc_new_method(cur_class_file, methodname, tmp_method_desc, strictFp ? F2J_STRICT_ACC : F2J_NORMAL_ACC); if(!save_all_override) assign_varnums_to_locals(main_method, root->astnode.source.typedecs); insert_fields(root); /* as part of creating a new classfile structure, we have * already created an method, the default constructor. * the class may also need a method, the class * initializer. the method initializes any static * fields, DATA stmts, Strings which require new objects to * be created, etc. here we create an empty CodeAttribute * structure and then emit the typedecs. afterwards, we * check to see if any code was generated for . * if so, we must create a method structure and add * that to the current classfile structure. if not, we do * nothing. */ /* save pointer for local vars in local_emit */ local_list = root->astnode.source.typedecs; emit (root->astnode.source.typedecs); emit (root->astnode.source.progtype); /* check whether any class initialization code was generated. * if so, finish initializing the method and insert it into this * class. */ if(bc_get_code_length(cur_method) > 0) { bc_append(cur_method, jvm_return); fprintf(indexfp,"%s:%s:%s\n",cur_filename, "", "()V"); } else { bc_remove_method(cur_method); bc_free_method(cur_method); } /* if this program unit is a function, then assign a local * variable number to the implicit return variable. */ if(root->astnode.source.progtype->nodetype == Function) { hashtemp=type_lookup(cur_type_table, unit_name); if(hashtemp) hashtemp->variable->astnode.ident.localvnum = bc_get_next_local(main_method, jvm_data_types[root->astnode.source.progtype->astnode.source.returns]); } cur_method = main_method; /* return stuff */ if(!save_all_override) local_emit(cur_method, root->astnode.source.typedecs); /* If this program unit does any reading, we declare an instance of * the EasyIn class. grab a local var for this, but dont worry * about releasing it, since we might need it throughout the life * of the method. */ if(root->astnode.source.progtype->astnode.source.needs_input) { fprintf(curfp," EasyIn %s = new EasyIn();\n", F2J_STDIN); stdin_lvar = bc_get_next_local(cur_method, jvm_Object); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, EASYIN_CLASS); bc_append(cur_method, jvm_new,c); bc_append(cur_method, jvm_dup); c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "", EASYIN_DESC); bc_append(cur_method, jvm_invokespecial, c); bc_gen_store_op(cur_method, stdin_lvar, jvm_Object); } /* Initialize a vector to be used for storing arguments to the * formatted write routine (f77write). */ if(root->astnode.source.progtype->astnode.source.needs_output) { fprintf(curfp," java.util.Vector %s = new java.util.Vector();\n", F2J_IO_VEC); iovec_lvar = bc_get_next_local(cur_method, jvm_Object); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, VECTOR_CLASS); bc_append(cur_method, jvm_new,c); bc_append(cur_method, jvm_dup); c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "", VECTOR_DESC); bc_append(cur_method, jvm_invokespecial, c); bc_gen_store_op(cur_method, iovec_lvar, jvm_Object); } if((type_lookup(cur_external_table, "etime") != NULL) || type_lookup(cur_external_table, "second") != NULL) { fprintf(curfp, " Etime.etime();\n"); c = bc_new_methodref(cur_class_file, ETIME_CLASS, "etime", ETIME_DESC); bc_append(cur_method, jvm_invokestatic, c); } /* if one of the arguments is a function, we must use the * reflection mechanism to perform the method call. */ if(import_reflection) { reflect_declarations_emit(cur_method, root->astnode.source.progtype->astnode.source.args); /* The 'catch' corresponding to the following try is generated * in case End. */ fprintf(curfp,"try {\n"); /* start the exception handler from the next opcode */ reflect_entry = (JVM_EXCEPTION_TABLE_ENTRY *) f2jalloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY)); reflect_entry->from = bc_append(cur_method, jvm_xxxunusedxxx); access_entry = (JVM_EXCEPTION_TABLE_ENTRY *) f2jalloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY)); access_entry->from = reflect_entry->from; } emit(root->astnode.source.statements); /* check if code was generated for this program unit's method. * if so, finish initializing the method and insert it into this * class. */ if(bc_get_code_length(cur_method) > 0) fprintf(indexfp,"%s:%s:%s\n",cur_filename, methodname, tmp_method_desc); f2jfree(methodname, strlen(methodname)+1); emit_invocations(); emit_adapters(); fprintf(curfp,"} // End class.\n"); fclose(curfp); bc_write_class(cur_class_file, output_dir); if(gendebug) cp_dump(cur_class_file); bc_free_class(cur_class_file); free_lists(); f2jfree(classname, strlen(classname)+1); f2jfree(cur_filename, strlen(cur_filename)+1); break; } case Subroutine: if (gendebug) printf ("Subroutine.\n"); returnname = NULL; /* Subroutines return void. */ cur_unit = root; unit_name = root->astnode.source.name->astnode.ident.name; if(gendebug) printf ("Subroutine name: %s\n", unit_name); constructor (root); break; case Function: if (gendebug) printf ("Function.\n"); returnname = root->astnode.source.name->astnode.ident.name; cur_unit = root; unit_name = root->astnode.source.name->astnode.ident.name; if(gendebug) printf ("Function name: %s\n", unit_name); constructor (root); break; case Program: if (gendebug) printf ("Program.\n"); returnname = NULL; /* programs return void. */ cur_unit = root; unit_name = root->astnode.source.name->astnode.ident.name; if (gendebug) printf ("Program name: %s\n", unit_name); constructor(root); break; case Typedec: if (gendebug) printf ("Typedec.\n"); if(save_all_override) typedec_emit_all_static (cur_method, root); else typedec_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case DataList: if (gendebug) printf ("Data.\n"); data_emit (cur_method, root); if (root->nextstmt != NULL) /* End of data list. */ emit (root->nextstmt); break; case Specification: if (gendebug) printf ("Specification.\n"); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Equivalence: if (gendebug) printf ("Equivalence.\n"); equiv_emit (cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Statement: if (gendebug) printf ("Statement.\n"); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Assignment: if (gendebug) printf ("Assignment.\n"); assign_emit (cur_method, root); fprintf (curfp, ";\n"); if (root->nextstmt != NULL) emit (root->nextstmt); break; case StmtLabelAssign: if (gendebug) printf ("StmtLabelAssign.\n"); assign_emit (cur_method, root); fprintf (curfp, ";\n"); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Call: if (gendebug) printf ("Call.\n"); call_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Forloop: if (gendebug) printf ("Forloop.\n"); forloop_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Blockif: if (gendebug) printf ("Blockif.\n"); blockif_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Elseif: if (gendebug) printf ("Elseif.\n"); elseif_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Else: if (gendebug) printf ("Else.\n"); else_emit (root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Logicalif: if (gendebug) printf ("Logicalif.\n"); logicalif_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Arithmeticif: if (gendebug) printf ("Arithmeticif.\n"); arithmeticif_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Return: if(gendebug) printf("Return: %s.\n", returnname != NULL ? returnname : "void"); /* * According to the f77 spec, labels cannot contain more * than five digits, so we use six nines as the label * for the final return statement to avoid conflicts with * labels that already exist in the program. */ fprintf(curfp,"Dummy.go_to(\"%s\",999999);\n",cur_filename); return_emit(cur_method); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Goto: if (gendebug) printf ("Goto.\n"); goto_emit (cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case ComputedGoto: if (gendebug) printf ("Computed Goto.\n"); computed_goto_emit (cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case AssignedGoto: if (gendebug) printf ("Assigned Goto.\n"); assigned_goto_emit (cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Label: if (gendebug) printf ("Label.\n"); label_emit (cur_method, root); if (root->nextstmt != NULL) /* End of typestmt list. */ emit (root->nextstmt); break; case Write: if (gendebug) printf ("Write statement.\n"); write_emit (cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Read: if (gendebug) printf ("Read statement.\n"); read_emit (cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Format: if (gendebug) printf("skipping format statement\n"); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Stop: if (gendebug) printf ("Stop.\n"); stop_emit(cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Pause: if (gendebug) printf ("Pause.\n"); pause_emit(cur_method, root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case End: if (gendebug) printf ("End.\n"); end_emit(cur_method); break; case Save: if (gendebug) printf ("Save (ignoring).\n"); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Common: fprintf(stderr,"Warning: hit case Common in emit()\n"); if (root->nextstmt != NULL) emit (root->nextstmt); break; case CommonList: if (gendebug) printf ("Common.\n"); common_emit(root); if (root->nextstmt != NULL) emit (root->nextstmt); break; case MainComment: while(root->nextstmt != NULL && root->nextstmt->nodetype == Comment) root = root->nextstmt; if (root->nextstmt != NULL) emit (root->nextstmt); break; case Comment: if (gendebug) printf ("Comment.\n"); if(curfp != NULL) fprintf(curfp,"// %s", root->astnode.ident.name); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Dimension: if(gendebug) printf("Dimension\n"); /* ignore */ if (root->nextstmt != NULL) emit (root->nextstmt); break; case Unimplemented: fprintf (curfp, " ; // WARNING: Unimplemented statement in Fortran source.\n"); if (root->nextstmt != NULL) emit (root->nextstmt); break; case Constant: default: fprintf(stderr,"emit(): Error, bad nodetype (%s)\n", print_nodetype(root)); if (root->nextstmt != NULL) emit (root->nextstmt); break; } /* switch on nodetype. */ } /***************************************************************************** * * * prepare_comments * * * * Here we check whether there was a block of prologue comment statements. * * If that block is longer than the current javadoc comment block (or if * * there is no javadoc comment block) then use the prologue instead. * * * *****************************************************************************/ void prepare_comments(AST *root) { AST *pc, *jc; if(genJavadoc) { pc = root->astnode.source.prologComments; jc = root->astnode.source.progtype->astnode.source.javadocComments; if(pc) { if(jc) { if(pc->astnode.ident.len > jc->astnode.ident.len) { jc->nodetype = Comment; pc->nodetype = MainComment; root->astnode.source.progtype->astnode.source.javadocComments = pc; root->astnode.source.prologComments = NULL; } } else { pc->nodetype = MainComment; root->astnode.source.progtype->astnode.source.javadocComments = pc; root->astnode.source.prologComments = NULL; } } } } /***************************************************************************** * * * initialize_lists * * * * initializes new list instances for the current program unit. * * * *****************************************************************************/ void initialize_lists() { /* Initialize the lists. */ dummy_nodes = make_dl(); while_list = make_dl(); doloop = make_dl(); adapter_list = make_dl(); methcall_list = make_dl(); } /***************************************************************************** * * * free_lists * * * * frees memory associated with the global lists. * * * *****************************************************************************/ void free_lists(JVM_METHOD *meth) { Dlist tmp; /* free memory from previous program units. */ if(dummy_nodes) { dl_traverse(tmp, dummy_nodes) f2jfree(dl_val(tmp), sizeof(JVM_CODE_GRAPH_NODE)); dl_delete_list(dummy_nodes); } if(while_list) { dl_traverse(tmp, while_list) f2jfree(dl_val(tmp), sizeof(int)); dl_delete_list(while_list); } dl_delete_list(doloop); dl_delete_list(adapter_list); if(methcall_list) { dl_traverse(tmp, methcall_list) dl_delete_list((Dlist)dl_val(tmp)); dl_delete_list(methcall_list); } } /***************************************************************************** * * * set_bytecode_status * * * * allow temporarily suspending generation of bytecode for situations where * * the code generation ordering is very different between Java source and * * JVM bytecode. this way, f2java may suspend bytecode, generate the java * * source, then generate the JVM bytecode differently. * * * *****************************************************************************/ void set_bytecode_status(JVM_METHOD *meth, int mode) { switch(mode) { case JVM_ONLY: bc_set_gen_status(meth, TRUE); savefp = curfp; curfp = devnull; break; case JAVA_ONLY: bc_set_gen_status(meth, FALSE); curfp = savefp; break; case JAVA_AND_JVM: default: bc_set_gen_status(meth, TRUE); bytecode_gen=TRUE; curfp = savefp; break; } } /***************************************************************************** * * * reflect_declarations_emit * * * * this function emits declarations for each function passed in as an arg. * * the arg type is Object, so we call Object.getClass().getDeclaredMethods() * * to get the Method array of that object. then we assign the first method * * to the next available local variable. * * * *****************************************************************************/ void reflect_declarations_emit(JVM_METHOD *meth, AST *root) { HASHNODE *hashtemp, *ht2; AST *tempnode; int c; int meth_var_num = 0; for(tempnode = root; tempnode != NULL; tempnode = tempnode->nextstmt) { hashtemp = type_lookup(cur_external_table, tempnode->astnode.ident.name); if(hashtemp) { hashtemp->variable->astnode.ident.localvnum = bc_get_next_local(meth, jvm_Object); fprintf(curfp," java.lang.reflect.Method _%s_meth ", tempnode->astnode.ident.name); fprintf(curfp," = %s.getClass().getDeclaredMethods()[0];\n", tempnode->astnode.ident.name); ht2 = type_lookup(cur_type_table, tempnode->astnode.ident.name); if(ht2) { meth_var_num = ht2->variable->astnode.ident.localvnum; if(gendebug) printf("found '%s' in type table, using localvnum = %d\n", tempnode->astnode.ident.name, meth_var_num); } else { ht2 = type_lookup(cur_args_table, tempnode->astnode.ident.name); if(ht2) { meth_var_num = ht2->variable->astnode.ident.localvnum; if(gendebug) printf("found '%s' in args table, using localvnum = %d\n", tempnode->astnode.ident.name, meth_var_num); } else { fprintf(stderr,"(1)Error: expected to find %s in symbol table.\n", tempnode->astnode.ident.name); exit(EXIT_FAILURE); } } bc_gen_load_op(meth, meth_var_num, jvm_Object); c = bc_new_methodref(cur_class_file, JL_OBJECT, "getClass", GETCLASS_DESC); bc_append(meth, jvm_invokevirtual, c); c = bc_new_methodref(cur_class_file, JL_CLASS, "getDeclaredMethods", GETMETHODS_DESC); bc_append(meth, jvm_invokevirtual, c); bc_push_int_const(meth, 0); bc_append(meth, jvm_aaload); bc_gen_store_op(meth, hashtemp->variable->astnode.ident.localvnum, jvm_Object); } } } /***************************************************************************** * * * invocation_exception_handler_emit * * * * this function emits the bytecode for the two exception handlers that are * * generated when the program unit invokes a method on a passed-in function. * * * *****************************************************************************/ void invocation_exception_handler_emit(JVM_CLASS *cclass, JVM_METHOD *meth, JVM_EXCEPTION_TABLE_ENTRY *et) { int c; unsigned int vnum; vnum = bc_get_next_local(meth, jvm_Object); /* emit handler for InvocationTargetException */ et->target = bc_gen_store_op(meth, vnum, jvm_Object); c = bc_new_fieldref(cclass, JL_SYSTEM, "err", OUT_DESC); bc_append(meth, jvm_getstatic, c); c = cp_find_or_insert(cclass, CONSTANT_Class, STRINGBUFFER); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); bc_push_string_const(meth, "Error Calling Method: "); c = bc_new_methodref(cclass, STRINGBUFFER, "", STRBUF_DESC); bc_append(meth, jvm_invokespecial, c); bc_gen_load_op(meth, vnum,jvm_Object); c = bc_new_methodref(cclass, THROWABLE_CLASS, "getMessage", GETMSG_DESC); bc_append(meth, jvm_invokevirtual, c); c = bc_new_methodref(cclass, STRINGBUFFER, "append", append_descriptor[String]); bc_append(meth, jvm_invokevirtual, c); c = bc_new_methodref(cclass, STRINGBUFFER, "toString", TOSTRING_DESC); bc_append(meth, jvm_invokevirtual, c); c = bc_new_methodref(cclass, PRINTSTREAM, "println", println_descriptor[String]); bc_append(meth, jvm_invokevirtual, c); /* artificially set stack depth at beginning of exception * handler to 1. */ bc_set_stack_depth(et->target, 1); bc_release_local(meth, jvm_Object); } /***************************************************************************** * * * pause_emit * * * * Generate the code for a PAUSE statement. If the statement has an * * argument, print it to stderr before querying the user about continuing. * * The PAUSE statement pauses the program and asks the user whether or not * * to continue. * * * *****************************************************************************/ void pause_emit(JVM_METHOD *meth, AST *root) { int c; if(root->astnode.constant.number[0] != 0) { fprintf(curfp,"org.netlib.util.Util.pause(\"%s\");\n", escape_double_quotes(root->astnode.constant.number)); bc_push_string_const(meth, root->astnode.constant.number); c = bc_new_methodref(cur_class_file, UTIL_CLASS, "pause", PAUSE_DESC); bc_append(meth, jvm_invokestatic, c); } else { fprintf(curfp,"org.netlib.util.Util.pause();\n"); c = bc_new_methodref(cur_class_file, UTIL_CLASS, "pause", PAUSE_NOARG_DESC); bc_append(meth, jvm_invokestatic, c); } } /***************************************************************************** * * * stop_emit * * * * Generate the code for a STOP statement. If the statement has an argument * * print it to stderr before exiting. * * * *****************************************************************************/ void stop_emit(JVM_METHOD *meth, AST *root) { int c; if(root->astnode.constant.number[0] != 0) { char *stop_msg; stop_msg = (char *)malloc(strlen(root->astnode.constant.number) + 7); if(!stop_msg) { fprintf(stderr, "malloc failed in stop_emit()\n"); exit(EXIT_FAILURE); } strcpy(stop_msg, "STOP: "); strncat(stop_msg, root->astnode.constant.number, MAX_CONST_LEN); c = bc_new_fieldref(cur_class_file, JL_SYSTEM, "err", OUT_DESC); bc_append(meth, jvm_getstatic, c); bc_push_string_const(meth, stop_msg); c = bc_new_methodref(cur_class_file, PRINTSTREAM, "println", println_descriptor[String]); bc_append(meth, jvm_invokevirtual, c); fprintf(curfp, "System.err.println(\"STOP: %s\");\n", escape_double_quotes(root->astnode.constant.number)); free(stop_msg); } fprintf (curfp, "System.exit(0);\n"); bc_append(meth, jvm_iconst_0); c = bc_new_methodref(cur_class_file, JL_SYSTEM, "exit", EXIT_DESC); bc_append(meth, jvm_invokestatic, c); } /***************************************************************************** * * * end_emit * * * * We only generate one real return statement. The other return statements * * are emitted as gotos to the end of the code. See the tech report for the * * reasoning behind this decision. Anyway, here at the end, we emit the * * real return statement. We use six nines as the label to avoid conflicts * * with other labels. See comment above in the Return case. * * * *****************************************************************************/ void end_emit(JVM_METHOD *meth) { JVM_CODE_GRAPH_NODE *goto_node, *goto_node2; int c; if(import_reflection) { /* this goto skips the execption handlers under normal execution */ goto_node = bc_append(meth, jvm_goto); /* set the end point for the exception handlers. */ reflect_entry->to = goto_node; access_entry->to = goto_node; invocation_exception_handler_emit(cur_class_file, meth, reflect_entry); goto_node2 = bc_append(meth, jvm_goto); invocation_exception_handler_emit(cur_class_file, meth, access_entry); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, INVOKE_EXCEPTION); reflect_entry->catch_type = c; c = cp_find_or_insert(cur_class_file, CONSTANT_Class, ACCESS_EXCEPTION); access_entry->catch_type = c; bc_add_exception_handler(meth, reflect_entry); bc_add_exception_handler(meth, access_entry); bc_set_branch_target(goto_node, bc_append(meth, jvm_xxxunusedxxx)); bc_set_branch_target(goto_node2, bc_append(meth, jvm_xxxunusedxxx)); fprintf(curfp, "%s%s%s%s%s%s%s", "} catch (java.lang.reflect.InvocationTargetException _e) {\n", " System.err.println(\"Error calling method.", " \"+ _e.getMessage());\n", "} catch (java.lang.IllegalAccessException _e2) {\n", " System.err.println(\"Error calling method.", " \"+ _e2.getMessage());\n", "}\n"); } fprintf(curfp,"Dummy.label(\"%s\",999999);\n",cur_filename); if (returnname != NULL) { if(omitWrappers && !cgPassByRef(returnname)) fprintf (curfp, "return %s;\n", returnname); else fprintf (curfp, "return %s.val;\n", returnname); } else fprintf (curfp, "return;\n"); fprintf (curfp, " }\n"); /* in Fortran if the program unit is a PROGRAM, it has no explicit * return statement. however, Java bytecode requires an explicit return * instruction even if the method returns void. also, if I remember * correctly from the F77 spec, FUNCTIONs and SUBROUTINEs do not * require an explicit return statement, but the END statement acts * as an implicit return in these cases. here we must generate a * return statement however we want to avoid generating two return * statements because then the bytecode verifier will reject the class. * to avoid duplicates, check whether the last opcode generated was * a return. if so, do not generate another one here. */ switch(bc_get_last_opcode(meth)) { case jvm_ireturn: case jvm_lreturn: case jvm_freturn: case jvm_dreturn: case jvm_areturn: case jvm_return: /* do nothing */ break; default: return_emit(meth); break; /* ansi compliance */ } } /***************************************************************************** * * * return_emit * * * * This function generates code to return from a method. Fortran program * * units PROGRAM and SUBROUTINE both return void, while FUNCTIONs return * * the Java type corresponding to their original Fortran declaration. * * * *****************************************************************************/ void return_emit(JVM_METHOD *meth) { /* for bytecode, check if the current program unit is a * Function. if so, we push the implicit return value * on the stack and return. otherwise, just return void. */ if(returnname) { HASHNODE *ht; int rlv=0; ht = type_lookup(cur_type_table, returnname); if(!ht) { fprintf(stderr,"Bad news: can't find return name '%s' in symtab.\n", returnname); rlv = 0; } else rlv = ht->variable->astnode.ident.localvnum; if(omitWrappers && !cgPassByRef(returnname)) pushVar(cur_class_file, meth, cur_unit->vartype, FALSE, cur_filename, returnname, field_descriptor[cur_unit->vartype][0], rlv, FALSE); else pushVar(cur_class_file, meth, cur_unit->vartype, FALSE, cur_filename, returnname, wrapped_field_descriptor[cur_unit->vartype][0], rlv, TRUE); bc_append(meth, return_opcodes[cur_unit->vartype]); } else bc_append(meth, jvm_return); } /***************************************************************************** * * * field_emit * * * * This function is called by insert_fields to create a new field_info * * structure for the given variable. * * * *****************************************************************************/ void field_emit(AST *root) { char * desc, * name; HASHNODE *ht; if(!type_lookup(cur_type_table, root->astnode.ident.name)) return; /* check whether this is a local var. if so, then it does not need to * be emitted as a static field of this class, so just return now. */ if(gendebug){ printf("field_emit: %s localvnum=%d\n", root->astnode.ident.name, root->astnode.ident.localvnum); } if(root->astnode.ident.localvnum != -1){ return; } /* check if this variable has a merged name. if so, * use that name instead. */ ht = type_lookup(cur_equiv_table,root->astnode.ident.name); if(ht && ht->variable->astnode.ident.merged_name) name = ht->variable->astnode.ident.merged_name; else { ht = type_lookup(cur_type_table,root->astnode.ident.name); if(ht && ht->variable->astnode.ident.merged_name) name = ht->variable->astnode.ident.merged_name; else name = root->astnode.ident.name; } desc = getVarDescriptor(root); if(ht) ht->variable->astnode.ident.descriptor = desc; else { if((ht = type_lookup(cur_type_table,root->astnode.ident.name)) != NULL) ht->variable->astnode.ident.descriptor = desc; else fprintf(stderr,"WARNING: can't find ident to set descriptor\n"); } if(gendebug) { printf("going to emit field %s\n",name); printf("\ttype: %s (%d)\n",returnstring[root->vartype], root->vartype); printf("\t dim: %d\n",root->astnode.ident.dim); printf("\tdesc: %s\n",desc); } bc_add_field(cur_class_file, name, desc, F2J_NORMAL_ACC); } /***************************************************************************** * * * insert_fields * * * * Each variable in the program unit is generated as a static field in the * * current class. Loop through all the type declarations, inserting each * * variable into the list of fields. ignore all specification statements * * except for actual type declarations. also ignore arguments to this * * program unit since they will be declared as local variables, not fields. * * we will go back later and generate code to initialize everything, but * * first we need to get all the field names in the constant pool. * * * *****************************************************************************/ void insert_fields(AST *root) { AST *temp, *dec, *etmp; HASHNODE *hashtemp; /* for every spec statement */ for(temp = root->astnode.source.typedecs; temp; temp = temp->nextstmt) { if(temp->nodetype == Typedec) { /* for every variable in this specification stmt */ for(dec = temp->astnode.typeunit.declist; dec; dec = dec->nextstmt) { if( ! type_lookup (cur_external_table, dec->astnode.ident.name) && ! type_lookup (cur_intrinsic_table, dec->astnode.ident.name) && ! type_lookup (cur_args_table, dec->astnode.ident.name) && ! type_lookup (cur_param_table, dec->astnode.ident.name) && ! type_lookup (cur_equiv_table, dec->astnode.ident.name) && ! type_lookup (cur_common_table, dec->astnode.ident.name)) { if(gendebug){ printf("calling field_emit from insert_fields\n"); } field_emit(dec); } } } else if(temp->nodetype == Equivalence) { /* for each group of equivalenced variables... */ for(etmp = temp->astnode.equiv.nlist;etmp != NULL;etmp = etmp->nextstmt) { /* only generate a field entry for the first node. */ if(etmp->astnode.equiv.clist != NULL) { hashtemp = type_lookup(cur_type_table, etmp->astnode.equiv.clist->astnode.ident.name); if(hashtemp) field_emit(hashtemp->variable); else fprintf(stderr,"insert_fields(): can't find data type for %s\n" , etmp->astnode.equiv.clist->astnode.ident.name); } } } } } /***************************************************************************** * * * print_equivalences * * * * Print the variables that are equivalenced. * * This routine is used only for debugging * * * *****************************************************************************/ void print_equivalences(AST *root) { AST *temp; printf("M_EQV Equivalences:\n"); for(temp=root; temp != NULL; temp = temp->nextstmt) { printf("M_EQV (%d)", temp->token); print_eqv_list(temp,stdout); } } /***************************************************************************** * * * print_eqv_list * * * * This function prints the equivalence list to the file * * pointed to by fptr. * * * *****************************************************************************/ void print_eqv_list(AST *root, FILE *fptr) { AST *temp; for(temp = root->astnode.equiv.clist;temp!=NULL;temp=temp->nextstmt) fprintf(fptr," %s, ", temp->astnode.ident.name); fprintf(fptr,"\n"); } /***************************************************************************** * * * emit_prolog_comments * * * * 'Prolog' refers to those comments found before the * * function/subroutine declaration. Here we emit those * * comments. * * * *****************************************************************************/ void emit_prolog_comments(AST *root) { AST *temp; temp = root->astnode.source.prologComments; if(temp == NULL) return; while( (temp != NULL) && (temp->nodetype == Comment)) { fprintf(curfp,"// %s",temp->astnode.ident.name); temp = temp->nextstmt; } } /***************************************************************************** * * * emit_javadoc_comments * * * * generate comments in javadoc format. * * * *****************************************************************************/ void emit_javadoc_comments(AST *root) { AST *temp; temp = root->astnode.source.javadocComments; if(temp == NULL) return; fprintf(curfp,"/**\n"); fprintf(curfp,"*
\n");
  fprintf(curfp,"*Following is the description from the original\n");
  fprintf(curfp,"*Fortran source.  For each array argument, the Java\n");
  fprintf(curfp,"*version will include an integer offset parameter, so\n");
  fprintf(curfp,"*the arguments may not match the description exactly.\n");
  fprintf(curfp,"*Contact ");
  fprintf(curfp,"seymour@cs.utk.edu with any");
  fprintf(curfp," questions.\n");
  fprintf(curfp,"*

\n"); fprintf(curfp,"*\n"); while( (temp != NULL) && (temp->nodetype == MainComment || temp->nodetype == Comment)) { fprintf(curfp,"* %s",temp->astnode.ident.name); temp = temp->nextstmt; } fprintf(curfp,"*

\n"); fprintf(curfp,"**/\n"); } /***************************************************************************** * * * equiv_emit * * * * Generate declarations for equivalenced variables. This handles * * only a very restricted set of equivalences. Scalars can be * * equivalenced and arrays can be equivalenced, but only if the * * starting points are the same. * * * * To translate equivalences, we just merge the equivalenced names * * into one name and generate one Java declaration. * * * *****************************************************************************/ void equiv_emit (JVM_METHOD *meth, AST *root) { HASHNODE *ht; AST *temp; enum returntype curType; /* for each group of equivalenced variables... */ for(temp = root->astnode.equiv.nlist; temp != NULL; temp = temp->nextstmt) { /* just check the first variable since we're only going to emit * one declaration. */ if(temp->astnode.equiv.clist != NULL) { ht = type_lookup(cur_type_table, temp->astnode.equiv.clist->astnode.ident.name); if(ht) { curType = ht->variable->vartype; if(gendebug) if(ht->variable->astnode.ident.arraylist != NULL) printf("EQV looks like %s is an array\n", ht->variable->astnode.ident.name); } else { fprintf(stderr,"equiv_emit(): can't find data type for %s\n" , temp->astnode.equiv.clist->astnode.ident.name); curType = 0; } /* now emit the declaration as with any other variable. */ if(temp->astnode.equiv.clist->astnode.ident.merged_name != NULL) vardec_emit(meth, ht->variable, curType, "public static "); } } } /***************************************************************************** * * * find_commonblock * * * * finds a common block entry in the .f2j file. * * * *****************************************************************************/ JVM_METHODREF * find_commonblock(char *cblk_name, Dlist dt) { char *temp_commonblockname; JVM_METHODREF *mtmp; temp_commonblockname = (char *) f2jalloc(strlen(cblk_name) + strlen(CB_PREFIX) + 1); sprintf(temp_commonblockname, "%s%s", CB_PREFIX, cblk_name); if(gendebug) printf("#@#@ looking for temp_commonblockname = '%s'\n", temp_commonblockname); mtmp = find_method(temp_commonblockname, dt); f2jfree(temp_commonblockname, strlen(temp_commonblockname)+1); return mtmp; } /***************************************************************************** * * * skipCommonVarEntry * * * * This function returns a pointer to the next common block variable in * * the common block entry of an .f2j file. * * * *****************************************************************************/ char * skipCommonVarEntry(char *p) { if(!p || (*p == '\0')) return NULL; p++; /* skip over CB_DELIMITER */ while(*p != CB_DELIMITER) if(*p == '\0') return NULL; else p++; return p; } /***************************************************************************** * * * getVarDescFromCommonEntry * * * * This function returns the descriptor from a common block entry obtained * * an .f2j file. * * * *****************************************************************************/ char * getVarDescFromCommonEntry(const char *p) { char *newdesc = (char *) f2jalloc(strlen(p) + 1); /* upper bound on len */ char *np = newdesc; p++; /* skip over CB_DELIMITER */ while((*p != '\0') && (*p != CB_SEPARATOR)) *np++ = *p++; *np = '\0'; return newdesc; } /***************************************************************************** * * * getVarNameFromCommonEntry * * * * This function returns the name from a common block entry obtained from * * an .f2j file. * * * *****************************************************************************/ char * getVarNameFromCommonEntry(const char *p) { char *newdesc = (char *) f2jalloc(strlen(p) + 1); /* upper bound on len */ char *np = newdesc; while((*p != '\0') && (*p++ != CB_SEPARATOR)) /* spin */ ; while((*p != '\0') && (*p != CB_DELIMITER)) *np++ = *p++; *np = '\0'; return newdesc; } /***************************************************************************** * * * assign_merged_names * * * * This function loops through all the variables in a given COMMON block * * declaration and assigns the 'merged_name' and 'descriptor' fields to * * the values found in the .f2j files. This allows having a COMMON block * * split across multiple Java packages. Our current need for this feature * * stems from the fact that to allow for a user-specifiable XERBLA error * * reporting routine, we had to put it in another package. Since the * * LAPACK testers use their own XERBLA which contains a COMMON block that * * is shared with the rest of the tester source, we needed this feature * * in order to run the "error-exits" tests. 3/14/01 --keith * * * *****************************************************************************/ void assign_merged_names(AST *Ctemp, JVM_METHODREF *mtmp) { HASHNODE *hashtemp; AST *Ntemp; char *dp; dp = mtmp->descriptor; if(!dp) return; for(Ntemp=Ctemp->astnode.common.nlist;Ntemp!=NULL;Ntemp=Ntemp->nextstmt) { if((hashtemp=type_lookup(cur_type_table,Ntemp->astnode.ident.name))==NULL) { if(gendebug) printf("assign_merged_names: Var Not Found\n"); continue; } hashtemp->variable->astnode.ident.merged_name = getVarNameFromCommonEntry(dp); hashtemp->variable->astnode.ident.descriptor = getVarDescFromCommonEntry(dp); dp = skipCommonVarEntry(dp); } } /***************************************************************************** * * * common_emit * * * * This function emits common blocks as a static class containing * * the variables specified in the COMMON statement. Currently, * * each COMMON statement must specify the same variable names for * * the translation to work reliably. 10/9/97 --Keith * * * * Now COMMON statements may use different variable names and * * f2java attempts to merge the names into one. --Keith * * * *****************************************************************************/ void common_emit(AST *root) { JVM_METHOD *clinit_method; HASHNODE *hashtemp; JVM_METHODREF *mtmp; AST *Ctemp, *Ntemp, *temp; char *common_classname=NULL, *filename=NULL; FILE *commonfp; char * prefix = strtok(strdup(inputfilename),"."); JVM_CLASS *save_class_file; char *save_filename; /* save the current global variables pointing to the class file. this is * necessary because we're in the middle of generating the class file * for the current fortran program unit, but now we need to generate some * classes to hold COMMON blocks and we dont want to alter the pc, stack, * etc for the current class. */ save_class_file = cur_class_file; save_filename = cur_filename; /* set cur_filename to NULL in case we decide not to reset it here and * end up trying to free it later. then we don't blow away the * original memory. */ cur_filename = NULL; /* * Ctemp loops through each common block name specified * in the COMMON statement and Ntemp loops through each * variable in each common block. */ for(Ctemp=root->astnode.common.nlist;Ctemp!=NULL;Ctemp=Ctemp->nextstmt) { if(Ctemp->astnode.common.name != NULL) { if(gendebug) printf("common_emit.2: lookin for common block '%s'\n", Ctemp->astnode.common.name); mtmp = find_commonblock(Ctemp->astnode.common.name, descriptor_table); if(mtmp) { if(gendebug) printf("common_emit.3: %s,%s,%s\n", mtmp->classname, mtmp->methodname, mtmp->descriptor); assign_merged_names(Ctemp, mtmp); continue; }else{ if(gendebug) printf("common name not found in descriptor table\n"); } /* common block filename will be a concatenation of * the original input filename and the name of this * common block. */ common_classname = (char *)f2jrealloc(common_classname, strlen(prefix) + strlen(Ctemp->astnode.common.name) + 2); sprintf(common_classname,"%s_%s",prefix,Ctemp->astnode.common.name); if(gendebug) printf("emitting common block '%s'\n",common_classname); cur_filename = bc_get_full_classname(common_classname, package_name); filename = (char *)f2jrealloc(filename, strlen(cur_filename) + 6); sprintf(filename,"%s.java", cur_filename); cur_class_file = bc_new_class(common_classname,inputfilename, "java.lang.Object", package_name, F2J_CLASS_ACC); bc_add_default_constructor(cur_class_file, F2J_INIT_ACC); clinit_method = bc_new_method(cur_class_file, "", "()V", strictFp ? F2J_STRICT_ACC : F2J_NORMAL_ACC); if(gendebug) printf("## going to open file: '%s'\n", filename); if((commonfp = bc_fopen_fullpath(filename,"w", output_dir))==NULL) { fprintf(stderr,"Cannot open output file '%s'.\n",filename); perror("Reason"); exit(EXIT_FAILURE); } curfp = commonfp; if(package_name != NULL) fprintf(curfp,"package %s;\n",package_name); /* import util package for object wrapper classes */ fprintf(curfp,"import org.netlib.util.*;\n\n"); if(Ctemp->astnode.common.name != NULL) fprintf(curfp,"public class %s_%s\n{\n",prefix, Ctemp->astnode.common.name); fprintf(indexfp,"%s:common_block/%s:",cur_filename, Ctemp->astnode.common.name); for(Ntemp=Ctemp->astnode.common.nlist;Ntemp!=NULL;Ntemp=Ntemp->nextstmt) { if(gendebug) { printf("Common block %s -- %s\n",Ctemp->astnode.common.name, Ntemp->astnode.ident.name); printf("Looking up %s in the type table\n", Ntemp->astnode.ident.name); } /* each variable in the common block should have a type * declaration associated with it. */ if((hashtemp=type_lookup(cur_type_table,Ntemp->astnode.ident.name)) == NULL) { fprintf(stderr,"Error: can't find type for common %s\n", Ntemp->astnode.ident.name); if(gendebug) printf("Not Found\n"); continue; } if(gendebug) printf("Found\n"); temp = hashtemp->variable; if(gendebug)printf("drew field_emit: %c%s, %s (parent=%p)\n", CB_DELIMITER, getVarDescriptor(temp), getCommonVarName(Ntemp), (void *)temp->parent); fprintf(indexfp,"%c%s,%s",CB_DELIMITER, getVarDescriptor(temp), getCommonVarName(Ntemp)); field_emit(temp); /* now emit the variable declaration as with any * other variable. */ vardec_emit(clinit_method, temp, temp->vartype, "public static "); } fprintf(indexfp,"\n"); if(Ctemp->astnode.common.name != NULL) fprintf(curfp,"}\n"); fclose(curfp); /* check whether any class initialization code was generated. * if so, finish initializing the method and insert it into this * class. */ if(bc_get_code_length(clinit_method) > 0) { bc_append(clinit_method, jvm_return); fprintf(indexfp,"%s:%s:%s\n",cur_filename, "", "()V"); } else { bc_remove_method(clinit_method); bc_free_method(clinit_method); } bc_write_class(cur_class_file, output_dir); bc_free_class(cur_class_file); } } curfp = javafp; if(prefix) f2jfree(prefix,strlen(prefix)+1); if(common_classname) f2jfree(common_classname,strlen(common_classname)+1); if(filename) f2jfree(filename,strlen(filename)+1); if(cur_filename) f2jfree(cur_filename,strlen(cur_filename)+1); /* restore previously saved globals */ cur_class_file = save_class_file; cur_filename = save_filename; } /***************************************************************************** * * * getNameFromCommonDesc * * * * given a common block 'descriptor' (as found in the .f2j file), we return * * the variable name corresponding to the Nth variable in the common block. * * * *****************************************************************************/ char * getNameFromCommonDesc(char *desc, int idx) { int len = 0, del_count = 0; char *p, *name; /* skip initial delimiter */ p = desc + 1; while(del_count < idx) { p = bc_next_desc_token(p); /* skip the descriptor */ p++; /* skip the comma */ /* skip until next descriptor */ while((*p != CB_DELIMITER) && (*p != '\0')) p++; del_count++; p++; /* skip the delimiter */ } if(p == '\0') return NULL; p = bc_next_desc_token(p); p++; while((*(p+len) != CB_DELIMITER) && (*(p+len) != '\0')) len++; name = (char *) f2jalloc(len+2); strncpy(name, p, len+1); name[len] = '\0'; return name; } /***************************************************************************** * * * getFieldDescFromCommonDesc * * * * given a common block 'descriptor' (as found in the .f2j file), we return * * the descriptor corresponding to the Nth variable in the common block. * * * *****************************************************************************/ char * getFieldDescFromCommonDesc(char *desc, int idx) { int len = 0, del_count = 0; char *p, *name; /* skip initial delimiter */ p = desc + 1; while(del_count < idx) { /* skip until next descriptor */ while((*p != CB_DELIMITER) && (*p != '\0')) p++; del_count++; p++; /* skip the delimiter */ } if(p == '\0') return NULL; while((*(p+len) != CB_SEPARATOR) && (*(p+len) != '\0')) len++; name = (char *) f2jalloc(len+2); strncpy(name, p, len+1); name[len] = '\0'; return name; } /***************************************************************************** * * * getCommonVarName * * * * Given a node, this function returns the merged name of this variable in * * the common block. if the variable is not in a common block or if we * * can't find the variable in the symbol table, return "unknown". * * * *****************************************************************************/ char * getCommonVarName(AST *root) { HASHNODE *ht2; if(type_lookup(cur_common_table,root->astnode.ident.name) != NULL) { ht2 = type_lookup(cur_type_table,root->astnode.ident.name); return ht2->variable->astnode.ident.merged_name; } return "Unknown"; } /***************************************************************************** * * * typedec_emit * * * * this procedure only emits static variables, data and save. (drew) * * * *****************************************************************************/ void typedec_emit (JVM_METHOD *meth, AST * root) { AST *temp; HASHNODE *ht; enum returntype returns; returns = root->astnode.typeunit.returns; for(temp=root->astnode.typeunit.declist; temp != NULL; temp = temp->nextstmt) { if(omitWrappers) { if(gendebug) printf("vardec %s\n", temp->astnode.ident.name); if((ht= type_lookup(cur_type_table,temp->astnode.ident.name)) != NULL) { if(gendebug) printf("%s should be %s\n", temp->astnode.ident.name, ht->variable->astnode.ident.passByRef ? "WRAPPED" : "PRIMITIVE"); } else { char *tempname; /* if this is an intrinsic then don't emit any warning since we * didn't want to emit a real declaration for this anyway. */ tempname = strdup(temp->astnode.ident.name); uppercase(tempname); if(methodscan(intrinsic_toks, tempname)) { free(tempname); continue; } fprintf(stderr,"could not find %s\n", temp->astnode.ident.name); free(tempname); } } if(is_static(temp)) vardec_emit(meth, temp, returns, "public static "); } } /* Close typedec_emit(). */ /***************************************************************************** * * * is_static * * * * this functions returns true if the stmt is a data or save and has not * * been declared.(drew) * * * *****************************************************************************/ BOOL is_static(AST *root) { AST *temp; HASHNODE *ht; temp = root; if(type_lookup(cur_args_table,temp->astnode.ident.name)) { if(gendebug) printf("@@ is_static(): %s: not static (is arg)\n", temp->astnode.ident.name); return FALSE; } else if(type_lookup(cur_data_table,temp->astnode.ident.name)) { if(gendebug) printf("@@ Variable %s: Found corresponding data stmt\n", temp->astnode.ident.name); ht = type_lookup(cur_type_table,temp->astnode.ident.name); if(ht == NULL) return FALSE; if(!ht->variable->astnode.ident.needs_declaration) { if(gendebug) printf("is_static: declared data statement\n"); return FALSE; } if(gendebug) printf("is_static: undeclared data statement\n"); return TRUE; } else if(type_lookup(cur_save_table,temp->astnode.ident.name)) { if(gendebug) printf("@@ Variable %s: Found corresponding SAVE stmt\n", temp->astnode.ident.name); return TRUE; } else if(type_lookup (cur_external_table, temp->astnode.ident.name) || type_lookup (cur_intrinsic_table, temp->astnode.ident.name) || type_lookup (cur_args_table, temp->astnode.ident.name) || type_lookup (cur_param_table, temp->astnode.ident.name) || type_lookup (cur_equiv_table, temp->astnode.ident.name) || type_lookup (cur_common_table, temp->astnode.ident.name)) { if(gendebug) printf("@@ is_static %s: no, it's a spec stmt\n", temp->astnode.ident.name); return FALSE; } else if(save_all_locals) { if(gendebug) printf("@@ Save Variable %s: SAVE all\n", temp->astnode.ident.name); return TRUE; } else{ if(gendebug) printf("@@ Variable %s: Corresponding data stmt not found\n", temp->astnode.ident.name); if(type_lookup (cur_array_table, temp->astnode.ident.name) && f2j_arrays_static) return TRUE; else return FALSE; } } /***************************************************************************** * * * is_local * * * * this function checks to see if the varibles are local and returns * * true if they are. (drew) * * * *****************************************************************************/ BOOL is_local(AST *root){ AST *temp; HASHNODE *hashtemp; char *tempname; BOOL isarg; temp = root; hashtemp = type_lookup (cur_args_table, temp->astnode.ident.name); isarg = hashtemp != NULL; if(f2j_arrays_static) { if(type_lookup (cur_array_table, temp->astnode.ident.name) && !type_lookup (cur_args_table, temp->astnode.ident.name)) { return FALSE; } } if(type_lookup(cur_data_table,temp->astnode.ident.name)) { if(gendebug) printf("@@ Variable %s: Found corresponding data stmt\n", temp->astnode.ident.name); return FALSE; } hashtemp = type_lookup(cur_equiv_table,temp->astnode.ident.name); if(hashtemp) { if(type_lookup(cur_common_table,temp->astnode.ident.name)) { fprintf(stderr,"Please dont mix COMMON and EQUIVALENCE. "); fprintf(stderr,"I dont like it. It scares me.\n"); }else { fprintf(curfp," // %s equivalenced to %s\n", temp->astnode.ident.name, hashtemp->variable->astnode.ident.merged_name); } return FALSE; } if(type_lookup(cur_save_table,temp->astnode.ident.name)) return FALSE; if(type_lookup(cur_common_table,temp->astnode.ident.name)) return FALSE; /* * Dont emit anything for intrinsic functions. */ tempname = strdup(temp->astnode.ident.name); uppercase(tempname); if(( methodscan (intrinsic_toks, tempname) != NULL) && (type_lookup(cur_intrinsic_table,temp->astnode.ident.name) != NULL)) { f2jfree(tempname,strlen(tempname)+1); return FALSE; } f2jfree(tempname,strlen(tempname)+1); /* * Let's do the argument lookup first. No need to retype variables * that are already declared in the argument list, or declared * as externals. So if it is already declared, loop again. */ if (isarg) { if(gendebug) printf("### %s is in the args_table, so I'm skipping it.\n", temp->astnode.ident.name); return FALSE; } if(type_lookup(cur_external_table, temp->astnode.ident.name) != NULL) { /* skip externals */ return FALSE; } if(save_all_locals && !isarg) return FALSE; if(gendebug) printf("Returning TRUE from is_local\n"); return TRUE; } /***************************************************************************** * * * local_emit * * * * This function calls vardec_emit on local variables (drew) * * * *****************************************************************************/ void local_emit(JVM_METHOD *meth, AST *root) { AST *temp, *temp2; HASHNODE *ht; enum returntype returns; if(gendebug)printf("in local_emit\n"); temp2 = root; while(temp2 != NULL) { if(temp2->nodetype != Typedec) { temp2 = temp2->nextstmt; continue; } returns = temp2->astnode.typeunit.returns; if(gendebug)printf("in local_emit, returns=%s\n", returnstring[returns]); for(temp=temp2->astnode.typeunit.declist;temp!=NULL;temp=temp->nextstmt) { if(is_local(temp)==TRUE) { /* emit if it is local variable */ if(gendebug) printf("local variable found\n"); ht = type_lookup(cur_type_table,temp->astnode.ident.name); if(!ht) { char *tempname; /* if this is an intrinsic then don't emit any warning since we * didn't want to emit a real declaration for this anyway. */ tempname = strdup(temp->astnode.ident.name); uppercase(tempname); if(!methodscan(intrinsic_toks, tempname)) { fprintf(stderr,"Warning: local_emit() could not find '%s'\n", temp->astnode.ident.name); fprintf(stderr,"vartype is: %s\n",returnstring[temp->vartype]); } free(tempname); continue; } if(gendebug) printf("Emitting local variable %s\n", temp->astnode.ident.name); vardec_emit(meth, temp, returns, ""); } } temp2=temp2->nextstmt; } } /***************************************************************************** * * * assign_varnums_to_locals * * * * This routine assigns a local variable (aka register) number to every * * variable that should not be static. * * * *****************************************************************************/ void assign_varnums_to_locals(JVM_METHOD *meth, AST *root) { AST *temp, *temp2; HASHNODE *ht; temp2 = root; while(temp2 != NULL) { if(temp2->nodetype != Typedec) { temp2 = temp2->nextstmt; continue; } for(temp=temp2->astnode.typeunit.declist;temp!=NULL;temp=temp->nextstmt) { if(is_local(temp)==TRUE) { ht = type_lookup(cur_type_table,temp->astnode.ident.name); if(!ht) { char *tempname; /* if this is an intrinsic then don't emit any warning since we * didn't want to emit a real declaration for this anyway. */ tempname = strdup(temp->astnode.ident.name); uppercase(tempname); if(!methodscan(intrinsic_toks, tempname)) { fprintf(stderr,"assign_varnums_to_locals() could not find '%s'\n", temp->astnode.ident.name); fprintf(stderr,"vartype is: %s\n",returnstring[temp->vartype]); } free(tempname); continue; } /* might want to check whether it's a double precision array & only * grab one register in that case... kgs */ ht->variable->astnode.ident.localvnum = bc_get_next_local(meth, jvm_data_types[temp->vartype]); temp->astnode.ident.localvnum = ht->variable->astnode.ident.localvnum; if(gendebug) printf("assign_varnums_to_locals: %s -> slot %d %d\n", temp->astnode.ident.name, ht->variable->astnode.ident.localvnum, temp->astnode.ident.localvnum); } } temp2=temp2->nextstmt; } } /***************************************************************************** * * * typedec_emit * * * * Emit all the type declarations. This procedure checks * * whether variables are typed in the argument list, and * * does not redeclare those arguments. * * * *****************************************************************************/ void typedec_emit_all_static (JVM_METHOD *meth, AST * root) { AST *temp; HASHNODE *hashtemp, *ht; enum returntype returns; char *tempname; /* * This may have to be moved into the looop also. Could be * why I have had problems with this stuff. * * commented out 3/6/98 -- keith * * hashtemp = type_lookup (cur_external_table, temp->astnode.ident.name); * if (hashtemp) * return; */ returns = root->astnode.typeunit.returns; /* * Somewhere in here I need to do a table lookup * to see whether the variable is in the argument * list for the method. If so, it takes the type * in the argument list and is not retyped here. */ for(temp=root->astnode.typeunit.declist;temp != NULL;temp = temp->nextstmt) { if(omitWrappers) { if(gendebug) printf("vardec %s\n", temp->astnode.ident.name); if((ht= type_lookup(cur_type_table,temp->astnode.ident.name)) != NULL) { if(gendebug) printf("%s should be %s\n", temp->astnode.ident.name, ht->variable->astnode.ident.passByRef ? "WRAPPED" : "PRIMITIVE"); } else { char *tempname; /* if this is an intrinsic then don't emit any warning since we * didn't want to emit a real declaration for this anyway. */ tempname = strdup(temp->astnode.ident.name); uppercase(tempname); if(methodscan(intrinsic_toks, tempname)) { free(tempname); continue; } free(tempname); fprintf(stderr,"could not find %s\n", temp->astnode.ident.name); } } /* * If there is a corresponding data statement for this * variable, don't emit anything here. Just wait and * let the whole thing get emitted when we come across * the DATA node. --9/22/97, Keith */ if(type_lookup(cur_data_table,temp->astnode.ident.name)) { if(gendebug) printf("@@ Variable %s: Found corresponding data stmt\n", temp->astnode.ident.name); ht = type_lookup(cur_type_table,temp->astnode.ident.name); if(ht == NULL) continue; if( ! ht->variable->astnode.ident.needs_declaration) continue; } else if(gendebug) printf("@@ Variable %s: Corresponding data stmt not found\n", temp->astnode.ident.name); /* * dont worry about checking the save table now since we're * going to emit everything as static variables. --keith * * if(type_lookup(cur_save_table,temp->astnode.ident.name)) * continue; */ /* * check to se if this variable is equivalenced with some * other variable(s). if so, do not emit a variable * declaration here. */ hashtemp = type_lookup(cur_equiv_table,temp->astnode.ident.name); if(hashtemp) { if(type_lookup(cur_common_table,temp->astnode.ident.name)) { fprintf(stderr,"Please dont mix COMMON and EQUIVALENCE. "); fprintf(stderr,"I dont like it. It scares me.\n"); } else { fprintf(curfp," // %s equivalenced to %s\n", temp->astnode.ident.name, hashtemp->variable->astnode.ident.merged_name); } continue; } /* * also do not try to redefine a 'common' variable since * they are placed in their own classes. 10-8-97 -- Keith */ if(type_lookup(cur_common_table,temp->astnode.ident.name)) continue; /* * Dont emit anything for intrinsic functions. */ tempname = strdup(temp->astnode.ident.name); uppercase(tempname); if(( methodscan (intrinsic_toks, tempname) != NULL) && (type_lookup(cur_intrinsic_table,temp->astnode.ident.name) != NULL)) { f2jfree(tempname,strlen(tempname)+1); continue; } f2jfree(tempname,strlen(tempname)+1); /* * Let's do the argument lookup first. No need to retype variables * that are already declared in the argument list, or declared * as externals. So if it is already declared, loop again. */ hashtemp = type_lookup (cur_args_table, temp->astnode.ident.name); if (hashtemp) { if(gendebug) printf("### %s is in the args_table, so I'm skipping it.\n", temp->astnode.ident.name); continue; } if(type_lookup(cur_external_table, temp->astnode.ident.name) != NULL) { /* skip externals */ continue; } if(gendebug) printf("### calling vardec_emit on %s\n",temp->astnode.ident.name); vardec_emit(meth, temp, returns, "public static "); } } /* Close typedec_emit(). */ /***************************************************************************** * * * newarray_emit * * * * this function emits the newarray instruction appropriate to the data type * * of the given node. * * * *****************************************************************************/ void newarray_emit(JVM_METHOD *meth, enum returntype vtype) { int c; switch(vtype) { case String: case Character: c = cp_find_or_insert(cur_class_file, CONSTANT_Class, "java/lang/String"); bc_append(meth, jvm_anewarray, c); break; case Complex: case Double: case Float: case Integer: case Logical: bc_append(meth, jvm_newarray, jvm_array_type[vtype]); break; default: fprintf(stderr,"WARNING: newarray_emit() unknown vartype\n"); } } /***************************************************************************** * * * getMergedName * * * * given an ident, return the merged name. * * * *****************************************************************************/ char * getMergedName(AST *root) { HASHNODE *ht, *ht2; char *name; if(type_lookup(cur_common_table,root->astnode.ident.name) != NULL) { ht2 = type_lookup(cur_type_table,root->astnode.ident.name); name = ht2->variable->astnode.ident.merged_name; } else if((ht=type_lookup(cur_equiv_table,root->astnode.ident.name))!=NULL) name = ht->variable->astnode.ident.merged_name; else name = root->astnode.ident.name; return name; } /***************************************************************************** * * * getMergedDescriptor * * * * given an ident, return the descriptor. * * * *****************************************************************************/ char * getMergedDescriptor(AST *root, enum returntype returns) { HASHNODE *ht, *ht2; char *desc; if(gendebug){ printf("@@## looking for '%s' in common table\n", root->astnode.ident.name); } if(type_lookup(cur_common_table,root->astnode.ident.name)!=NULL) { if(gendebug){ printf("@@## found! in common table\n"); } ht2 = type_lookup(cur_type_table,root->astnode.ident.name); if(gendebug)printf("@@## ht2 is '%s'\n", ht2 ? "non-null": "NULL"); desc = ht2->variable->astnode.ident.descriptor; if(gendebug)printf("@@## desc is '%s'\n", desc ? desc: "NULL"); } else if((ht=type_lookup(cur_equiv_table,root->astnode.ident.name))!=NULL) { desc = ht->variable->astnode.ident.descriptor; } else { ht2 = type_lookup(cur_type_table,root->astnode.ident.name); if(ht2 && ht2->variable->astnode.ident.descriptor) desc = ht2->variable->astnode.ident.descriptor; else { desc = field_descriptor[returns][(root->astnode.ident.dim > 0)]; } } return desc; } /***************************************************************************** * * * vardec_emit * * * * the body of this function used to be in typedec_emit, but * * I moved it so that I could use the same code to emit static * * or nonstatic variables. 10/3/97 -- Keith * * * * This could probably be simplified somewhat now that all * * variables are emitted 'static'. 1/27/98 -- Keith * * ...done 3/26/98 -- Keith * * * *****************************************************************************/ void vardec_emit(JVM_METHOD *meth, AST *root, enum returntype returns, char *prefix) { char *name, *desc; HASHNODE *hashtemp; int count; AST *temp2; int c; struct var_info *ainf; if(type_lookup(cur_external_table, root->astnode.ident.name)) return; ainf = get_var_info(root); if(gendebug) { printf("vardec emit %s\n", root->astnode.ident.name); printf("ident = %s, prefix = %s\n",root->astnode.ident.name,prefix); } /* the top of the stack now contains the array we just created. * now issue the store instruction to store the array reference * into the static variable. if this ident is equivalenced, we * need to get the name/descriptor from the merged variable. */ name = getMergedName(root); desc = getMergedDescriptor(root, returns); if(gendebug) { if(!name) printf("!name\n"); if(!desc) printf("!desc\n"); } /* * check to see if this is an array declaration or not. * if so, we must generate the appropriate "new" statement. * otherwise, just declare & initialize in one statement. --keith */ if(root->astnode.ident.arraylist != NULL) { fprintf (curfp, "%s%s [] ",prefix, returnstring[returns]); if (gendebug) printf ("found array %s, calling name_emit\n", returnstring[returns]); name_emit (meth, root); if (returns == Integer) fprintf (curfp, "= new int["); else if (returns == Float) fprintf (curfp, "= new float["); else if (returns == Double) fprintf (curfp, "= new double["); else if (returns == Logical) fprintf (curfp, "= new boolean["); else if ((returns == String) || (returns == Character)) fprintf (curfp, "= new String["); else fprintf(stderr,"vardec_emit(): Unknown type (%d)!\n",returns); /* make sure this variable is in the array table */ hashtemp = type_lookup(cur_array_table,root->astnode.ident.name); if(hashtemp != NULL) { /* loop through each dimension of the array */ temp2=root->astnode.ident.arraylist; for(count=0 ; temp2!=NULL ; temp2=temp2->nextstmt, count++) { if(temp2 != root->astnode.ident.arraylist) fprintf(curfp, " * "); /* if not the first iteration */ fprintf(curfp,"("); if(temp2->nodetype == ArrayIdxRange) { /* if we have a range of indices (e.g. integer a(0:12)) * then we must allocate (end - start + 1) elements. */ expr_emit(meth, temp2->astnode.expression.rhs); fprintf(curfp," - "); expr_emit(meth, temp2->astnode.expression.lhs); fprintf(curfp," + 1"); /* at this point, we've pushed the end and start onto the * stack, so now we just subtract start from end and increment * by one as described above. */ bc_append(meth, jvm_isub); bc_append(meth, jvm_iconst_1); bc_append(meth, jvm_iadd); } else expr_emit(meth, temp2); /* if this isn't the first iteration, then we must multiply * the dimensions to get the total size of the array. */ if(temp2 != root->astnode.ident.arraylist) bc_append(meth, jvm_imul); fprintf(curfp,")"); } } else fprintf(stderr,"vardec_emit: Can't find %s in array table!\n", root->astnode.ident.name); fprintf (curfp, "];\n"); /* now the stack contains the number of elements for this * array, so now we issue a newarray instruction to create the * new array. we have to distinguish between arrays of * primitives and arrays of references because there are * different opcodes for creating these arrays. */ newarray_emit(meth, root->vartype); storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); } else { /* this is not an array declaration */ if(!type_lookup(cur_param_table, root->astnode.ident.name)) { if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) fprintf (curfp, "%s%s ", prefix, returnstring[returns]); else fprintf (curfp, "%s%s ", prefix, wrapper_returns[returns]); if (gendebug) printf ("%s\n", returnstring[returns]); name_emit (meth, root); /* this variable is not declared as a parameter, so * initialize it with an initial value depending on * its data type. */ if ((returns == String) || (returns == Character)) { print_string_initializer(meth, root); fprintf(curfp,";\n"); if(gendebug) { printf("new fieldref:\n"); printf("\tclass: %s\n", cur_filename); printf("\tname: %s\n", name); printf("\tdesc: %s\n", desc ? desc : "NULL"); } storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); } else { if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) { fprintf(curfp,"= %s;\n", init_vals[returns]); bc_append(meth, init_opcodes[returns]); storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); } else { c = cp_find_or_insert(cur_class_file,CONSTANT_Class, full_wrappername[returns]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); bc_append(meth, init_opcodes[returns]); c = bc_new_methodref(cur_class_file,full_wrappername[returns], "", wrapper_descriptor[returns]); bc_append(meth, jvm_invokespecial, c); storeVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); fprintf(curfp,"= new %s(%s);\n",wrapper_returns[returns], init_vals[returns]); } } } } } /***************************************************************************** * * * print_string_initializer * * * * This function prints the initialization code for a * * String object. If we know how long the string is supposed to * * be, then we can generate a blank string of that length. Thus * * any length operations on the 'uninitialized' string would be * * correct. * * * *****************************************************************************/ void print_string_initializer(JVM_METHOD *meth, AST *root) { char *src_initializer, *bytecode_initializer; AST *tempnode; HASHNODE *ht; if(gendebug) printf("in print_string_initializer()\n"); ht = type_lookup(cur_type_table,root->astnode.ident.name); if(ht == NULL) { fprintf(stderr,"Weird...can't find '%s' in type_table\n", root->astnode.ident.name); /* We can't find this variable in the hash table, * so just initialize the string to the standard initial * value found in init_vals. dup this constant string * so that we can always free() later regardless of * whether we hit this case or the latter case. */ src_initializer = strdup(init_vals[String]); } else { /* check if this is a Fortran character array. it will have been * allocated as a Java String, so don't treat it as an array. */ if((ht->variable->astnode.ident.len == 1) && (ht->variable->astnode.ident.dim == 0) && (ht->variable->astnode.ident.arraylist == NULL) && (ht->variable->astnode.ident.startDim[2] != NULL)) { AST *temp_node, *save_parent; int c; temp_node = addnode(); if(!temp_node) { fprintf(stderr, "Internal error: Failed to alloc temporary node.\n"); exit(EXIT_FAILURE); } save_parent = ht->variable->astnode.ident.startDim[2]->parent; ht->variable->astnode.ident.startDim[2]->parent = temp_node; temp_node->astnode.expression.rhs = ht->variable->astnode.ident.startDim[2]; temp_node->astnode.expression.lhs = NULL; temp_node->astnode.expression.minus = '+'; temp_node->nodetype = Unaryop; temp_node->vartype = ht->variable->astnode.ident.startDim[2]->vartype; fprintf(curfp, "= new String(new char["); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, JL_STRING); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); expr_emit (meth, ht->variable->astnode.ident.startDim[2]); bc_append(meth, jvm_newarray, JVM_T_CHAR); c = bc_new_methodref(cur_class_file, JL_STRING, "", CHAR_ARRAY_DESC); bc_append(meth, jvm_invokespecial, c); fprintf(curfp, "])"); ht->variable->astnode.ident.startDim[2]->parent = save_parent; f2jfree(temp_node, sizeof(AST)); return; } /* We know how long this string is supposed to be, so we * allocate a blank string with that many characters. For * example, CHARACTER*5 blah is translated to: * String blah = new String(" "); * assuming it has not been declared with a DATA statement. */ if(ht->variable->astnode.ident.len < 0) { src_initializer = (char *)f2jalloc(5); sprintf(src_initializer,"\" \""); } else { src_initializer = (char *)f2jalloc(ht->variable->astnode.ident.len+3); sprintf(src_initializer,"\"%*s\"",ht->variable->astnode.ident.len," "); } } /* we've created the initializer for java source code generation, * but for JVM opcode, we do not need the quotes within the string. * here we remove them and create a bytecode initializer. */ bytecode_initializer = (char *)f2jalloc(strlen(src_initializer) - 1); strncpy(bytecode_initializer,src_initializer+1,strlen(src_initializer)-2); bytecode_initializer[strlen(src_initializer) - 2] = '\0'; tempnode = addnode(); tempnode->token = STRING; tempnode->astnode.constant.number = strdup(bytecode_initializer); if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) { fprintf(curfp,"= new String(%s)", src_initializer); invoke_constructor(meth, JL_STRING, tempnode, STR_CONST_DESC); } else { fprintf(curfp,"= new StringW(%s)", src_initializer); invoke_constructor(meth, full_wrappername[String], tempnode, wrapper_descriptor[String]); } f2jfree(bytecode_initializer, strlen(bytecode_initializer)+1); f2jfree(src_initializer, strlen(src_initializer)+1); f2jfree(tempnode, sizeof(AST)); } /***************************************************************************** * * * data_emit * * * * This function handles emitting DATA statements, which consist of a * * list of names and a list of data items. We start with the first name * * and assign as many data items from the list as the size allows. for * * example if the first name is a 5 element array, we assign the first 5 * * data items to the first name. then we go to the second name, third * * name, etc. and assign values in the same way. 10/3/97 --Keith * * * *****************************************************************************/ void data_emit(JVM_METHOD *meth, AST *root) { AST * Dtemp, *Ntemp, *Ctemp; HASHNODE *hashtemp; /* foreach Data spec... */ for(Dtemp = root->astnode.label.stmt;Dtemp != NULL;Dtemp = Dtemp->prevstmt) { Ctemp = Dtemp->astnode.data.clist; /* foreach variable... */ for(Ntemp = Dtemp->astnode.data.nlist;Ntemp != NULL;Ntemp=Ntemp->nextstmt) { /* check to see if we're looking at an implied do loop */ if(Ntemp->nodetype == DataImpliedLoop) { data_implied_loop_emit(meth, Ntemp, Ctemp); continue; } /* This variable should have a type declaration associated with it */ hashtemp = type_lookup(cur_type_table,Ntemp->astnode.ident.name); if(hashtemp == NULL) { fprintf(stderr,"No typedec associated with this DATA variable: %s\n", Ntemp->astnode.ident.name); continue; } if(hashtemp->variable == NULL) { fprintf(stderr,"Wow, hashtemp->variable is NULL!\n"); continue; } /* check to see if this variable is also part of a common block */ if(type_lookup(cur_common_table, Ntemp->astnode.ident.name)) { fprintf(stderr,"Warning: can't handle COMMON varables"); fprintf(stderr," w/DATA statements.\n"); continue; } if((hashtemp->variable->vartype == String) && (hashtemp->variable->astnode.ident.len == 1) && (hashtemp->variable->astnode.ident.dim == 0) && (hashtemp->variable->astnode.ident.arraylist == NULL) && (hashtemp->variable->astnode.ident.startDim[2] != NULL)) { int i, length; /* this is a Fortran character array generated as a Java String. * copy the original dimension info to the arraylist field and * call determine_var_length(), then set it back to NULL before * emitting the string initializer. */ hashtemp->variable->astnode.ident.arraylist = hashtemp->variable->astnode.ident.startDim[2]; length = determine_var_length(hashtemp); hashtemp->variable->astnode.ident.arraylist = NULL; Ctemp = data_var_emit(meth, Ntemp, Ctemp, hashtemp, length); if(Ntemp->astnode.ident.arraylist) { /* * if Ntemp is a single element of a character array, e.g.: * DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', 'l'/ * then the whole thing would have been emitted above in the call * to data_var_emit(). So, here we skip the remaining single * element references so that we don't try to emit them again. */ for(i=0;inextstmt; } } else Ctemp = data_var_emit(meth, Ntemp, Ctemp, hashtemp, -1); } } } /***************************************************************************** * * * data_implied_loop_emit * * * * This function generates the code for implied do loops in DATA * * statements. The initialization is done in Java within a static * * block. For example, the following fortran statements: * * * * integer x * * data (x(j),j=1,4)/5,6,7,8/ * * * * would be emitted in Java as: * * * * static int [] x= new int[(4)]; * * static { * * x[( 1 )- 1] = 5; * * x[( 2 )- 1] = 6; * * x[( 3 )- 1] = 7; * * x[( 4 )- 1] = 8; * * } * * * *****************************************************************************/ AST * data_implied_loop_emit(JVM_METHOD *meth, AST * root, AST *Clist) { AST * loop_var, * lhs; int start, stop, incr, i; HASHNODE *ht; if(gendebug) { printf("/* \n"); printf("* looking at an implied data loop...\n"); printf("*\n"); } start = atoi(root->astnode.forloop.start->astnode.constant.number); if(gendebug) printf("* the start is: %d\n",start); stop = atoi(root->astnode.forloop.stop->astnode.constant.number); if(gendebug) printf("* the stop is: %d\n",stop); if(root->astnode.forloop.incr != NULL) incr = atoi(root->astnode.forloop.incr->astnode.constant.number); else incr = 1; if(gendebug) printf("* the increment is: %d\n",incr); loop_var = root->astnode.forloop.counter; if(gendebug) printf("* the name for the loop var is: %s\n", loop_var->astnode.ident.name); lhs = root->astnode.forloop.Label; if(gendebug) { AST *temp; printf("* the Lhs for this data stmt is: %s\n", lhs->astnode.ident.name); printf("* lets see whats in Clist\n"); for(temp=Clist;temp!=NULL;temp=temp->nextstmt) printf("* temp: %s\n", temp->astnode.constant.number); } ht = type_lookup(cur_type_table,lhs->astnode.ident.name); if(ht) lhs->vartype = ht->variable->vartype; else fprintf(stderr,"WARNING: [DATA] couldn't get vartype of '%s'\n", lhs->astnode.ident.name); global_sub.name = loop_var->astnode.ident.name; /* emit the static initialization block */ fprintf(curfp,"static {\n"); for(i = start; i <= stop; i += incr) { global_sub.val = i; name_emit(meth, lhs); fprintf(curfp, " = "); expr_emit(meth, Clist); fprintf(curfp, ";\n"); Clist = Clist->nextstmt; bc_gen_array_store_op(meth, jvm_data_types[ht->variable->vartype]); } fprintf(curfp,"}\n"); if(gendebug) printf("*/ \n"); global_sub.name = NULL; return Clist; } /***************************************************************************** * * * data_var_emit * * * * This function emits variable declarations for those variables * * originally contained in DATA statements in the fortran source. * * * *****************************************************************************/ AST * data_var_emit(JVM_METHOD *meth, AST *Ntemp, AST *Ctemp, HASHNODE *hashtemp, int java_str_len) { int length, is_array, needs_dec; if(gendebug) printf("VAR here we are emitting data for %s\n", Ntemp->astnode.ident.name); /* check to see whether we're going to be assigning to * an array element. If so, the declaration for the array * would have already been emitted, so we dont need a * declaration here - just assign the value. Otherwise, * we do need a declaration. * (my gut feeling is that for bytecode generation, needs_dec * is irrelevant. we shall see.) */ if(Ntemp->astnode.ident.arraylist == NULL) needs_dec = FALSE; else needs_dec = TRUE; /* here we determine whether this variable was declared as * an array or not. hashtemp points to the symtable info. */ if((hashtemp->variable->astnode.ident.arraylist != NULL ) && !needs_dec) is_array = TRUE; else is_array = FALSE; if(java_str_len >= 0) { fprintf(curfp,"public static %s ", returnstring[ hashtemp->variable->vartype]); if(gendebug) printf("VAR STRING going to data_string_emit\n"); Ctemp = data_string_emit(meth, java_str_len, Ctemp, Ntemp); return Ctemp; } if( hashtemp->variable->astnode.ident.leaddim != NULL ) { if(gendebug) printf("VAR leaddim not NULL\n"); /* Check for attempts to initialize dummy argument. we can't * determine the number of elements in a dummy arg. */ if(hashtemp->variable->astnode.ident.leaddim[0] == '*') { fprintf(stderr,"Attempt to initialize dummy argument: %s\n", hashtemp->variable->astnode.ident.name); return Ctemp; } else if (type_lookup(cur_args_table,Ntemp->astnode.ident.name)) { fprintf(stderr,"Attempt to initialize argument: %s\n", hashtemp->variable->astnode.ident.name); return Ctemp; } } if(is_array) { /* determine how many elements are in this array so that * we know how many items from the DATA statement to assign * to this variable. */ length = determine_var_length(hashtemp); if(gendebug) printf("VAR length = %d\n",length); fprintf(curfp,"public static %s ", returnstring[ hashtemp->variable->vartype]); if(gendebug) printf("VAR going to data_array_emit\n"); Ctemp = data_array_emit(meth, length, Ctemp, Ntemp); } else { if(!needs_dec) { if(omitWrappers && !cgPassByRef(Ntemp->astnode.ident.name)) fprintf(curfp,"public static %s ", returnstring[ hashtemp->variable->vartype]); else fprintf(curfp,"public static %s ", wrapper_returns[ hashtemp->variable->vartype]); data_scalar_emit(meth, hashtemp->variable->vartype, Ctemp, Ntemp, needs_dec); } else { fprintf(curfp,"static {\n"); data_scalar_emit(meth, hashtemp->variable->vartype, Ctemp, Ntemp, needs_dec); fprintf(curfp,"}\n"); } Ctemp = Ctemp->nextstmt; } return Ctemp; } /***************************************************************************** * determine_var_length * * * * Determine the number of elements in this array variable. * * * *****************************************************************************/ int determine_var_length(HASHNODE *var) { AST *temp2; int length = 1; int dims = var->variable->astnode.ident.dim; if(gendebug) { printf("determining length of %s\n", var->variable->astnode.ident.name); printf("dim = %d\n", dims); } /* loop through each dimension of the array and evaluate it. * multiply the length of each dimension as we go. */ temp2=var->variable->astnode.ident.arraylist; for( ; temp2 != NULL ; temp2=temp2->nextstmt ) { if(temp2->nodetype == ArrayIdxRange) { if(idxNeedsDecr(temp2)) length *= (int)eval_const_expr(temp2->astnode.expression.rhs); else length *= (int)eval_const_expr(temp2->astnode.expression.rhs) + 1; if(gendebug) printf("VAR now length = %d\n", length); } else if(temp2->nodetype != Constant) { length = -1; break; } else { length *= atoi(temp2->astnode.constant.number); } } if(gendebug) printf("VAR returning length = %d\n", length); return length; } /***************************************************************************** * * * data_string_emit * * * * This function generates data statements that are used to initialize * * character arrays, e.g.: * * * * CHARACTER TRANSS( NTRAN ) * * DATA TRANSS / 'N', 'T', 'C' / * * * * This is a horrible hack and probably won't work well for most things. * * I think the character handling needs to be totally rewritten. * * * *****************************************************************************/ AST * data_string_emit(JVM_METHOD *meth, int length, AST *Ctemp, AST *Ntemp) { unsigned int count, size = 0; HASHNODE *ht; int i, str_idx; struct var_info *ainf; char *init_string; ainf = get_var_info(Ntemp); if(gendebug) printf("VAR here we are in data_string_emit, length = %d\n",length); ht=type_lookup(cur_type_table, Ntemp->astnode.ident.name); if(!ht) { fprintf(stderr,"type table may be screwed. Can't find '%s'.", Ntemp->astnode.ident.name); exit(EXIT_FAILURE); } fprintf(curfp,"%s = \"",Ntemp->astnode.ident.name); /* for bytecode, we have to determine the number of elements * prior to emitting the elements themselves because we must * push the array size on the stack first. if the length is * not known, we count the number of actual data items. * otherwise, we set the array size equal to the given length. */ if(length == -1) { AST *tmp; for(tmp = Ctemp;tmp != NULL;tmp=tmp->nextstmt) size++; } else size = length; init_string = (char *)f2jalloc(size+1); str_idx = 0; init_string[str_idx] = 0; for(i=0,count=0;(length==-1)?(Ctemp != NULL):(i< length);i++) { if(Ctemp->nodetype == Binaryop) { fprintf(stderr, "repeated characters in data stmts not supported\n"); exit(EXIT_FAILURE); } else { if(Ctemp->token == STRING) { init_string[str_idx] = Ctemp->astnode.constant.number[0]; } else { init_string[str_idx] = '?'; fprintf(stderr, "expected a string constant in data statement\n"); } str_idx++; } if((Ctemp = Ctemp->nextstmt) == NULL) break; } init_string[str_idx] = 0; fprintf(curfp,"%s\";\n", escape_double_quotes(init_string)); bc_push_string_const(meth, init_string); storeVar(cur_class_file, meth, Ntemp->vartype, ainf->is_arg, ainf->class, ainf->name, "Ljava/lang/String;", ainf->localvar, FALSE); return Ctemp; } /***************************************************************************** * * * data_array_emit * * * * This function generates array declarations which are contained in * * DATA statements. * * * *****************************************************************************/ AST * data_array_emit(JVM_METHOD *meth, int length, AST *Ctemp, AST *Ntemp) { unsigned int count, size = 0; HASHNODE *ht; int i; struct var_info *ainf; ainf = get_var_info(Ntemp); if(gendebug) printf("VAR here we are in data_array_emit, length = %d\n",length); ht=type_lookup(cur_type_table, Ntemp->astnode.ident.name); if(!ht) { fprintf(stderr,"type table may be screwed. Can't find '%s'.", Ntemp->astnode.ident.name); exit(EXIT_FAILURE); } fprintf(curfp,"[] "); /* * if this variable is static, we can't declare it here * because it has been declared already as a class variable. * so we use the "_temp_" prefix and emit the initialization. * later we assign the temp variable to the class variable. * 10/3/97 --Keith * * i think the above comment is out of date. there is really * no distinction between static/nonstatic anymore. --kgs 5/15/00 */ fprintf(curfp,"%s = {\n",Ntemp->astnode.ident.name); /* for bytecode, we have to determine the number of elements * prior to emitting the elements themselves because we must * push the array size on the stack first. if the length is * not known, we count the number of actual data items. * otherwise, we set the array size equal to the given length. */ if(length == -1) { AST *tmp; for(tmp = Ctemp;tmp != NULL;tmp=tmp->nextstmt) size++; } else size = length; bc_push_int_const(meth, size); newarray_emit(meth, ht->variable->vartype); for(i=0,count=0;(length==-1)?(Ctemp != NULL):(i< length);i++) { if(Ctemp->nodetype == Binaryop) count = data_repeat_emit(meth, Ctemp, Ntemp, count); else { bc_append(meth, jvm_dup); bc_push_int_const(meth, count++); if(Ctemp->token == STRING) { fprintf(curfp,"\"%s\" ", escape_double_quotes(Ctemp->astnode.constant.number)); invoke_constructor(meth, JL_STRING, Ctemp, STR_CONST_DESC); } else { fprintf(curfp,"%s ", Ctemp->astnode.constant.number); pushConst(meth, Ctemp); } bc_gen_array_store_op(meth, jvm_data_types[ht->variable->vartype]); /* * Every now and then, emit a newline for readability. * I have run across some lines that end up so long that * they screw up 'vi'. 9/30/97 --Keith */ if( (count+1) % 5 == 0 ) fprintf(curfp,"\n"); } if( (Ctemp = Ctemp->nextstmt) == NULL ) break; else { if(length == -1) { if (Ctemp != NULL) fprintf(curfp,", "); } else if(i != length -1 ) fprintf(curfp,", "); } } fprintf(curfp,"};\n"); storeVar(cur_class_file, meth, Ntemp->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); return Ctemp; } /***************************************************************************** * * * data_repeat_emit * * * * This function generates repeated DATA specifications, for example: * * INTEGER x(30) * * DATA x/30*1/ * * * * For bytecode generation, we must keep track of which index we're emitting * * so we return the int value of the next array index to emit. * * * *****************************************************************************/ int data_repeat_emit(JVM_METHOD *meth, AST *root, AST *Ntemp, unsigned int idx) { int j, repeat; char *ditem; BOOL keep_going = FALSE; if((root->astnode.expression.lhs == NULL) || (root->astnode.expression.rhs == NULL)) { fprintf(stderr,"Bad data statement!\n"); exit(EXIT_FAILURE); } if((root->astnode.expression.lhs->nodetype != Constant) || (root->astnode.expression.rhs->nodetype != Constant)) { fprintf(stderr,"Error: Data items must be constants.\n"); exit(EXIT_FAILURE); } repeat = atoi(root->astnode.expression.lhs->astnode.constant.number); ditem = root->astnode.expression.rhs->astnode.constant.number; /* emit the all but the last with a comma.. the last one without */ for(j=0;jvartype != root->astnode.expression.rhs->vartype)||(keep_going)) { root->astnode.expression.rhs->token = cast_data_stmt(Ntemp, root->astnode.expression.rhs->token); root->astnode.expression.rhs->vartype = Ntemp->vartype; keep_going = TRUE; /* Used because the vartype is the same now */ } fprintf(curfp,"%s, ", ditem); bc_append(meth, jvm_dup); bc_push_int_const(meth, idx++); pushConst(meth, root->astnode.expression.rhs); bc_gen_array_store_op(meth, jvm_data_types[root->astnode.expression.rhs->vartype]); } if((Ntemp->vartype != root->astnode.expression.rhs->vartype)||(keep_going)) { root->astnode.expression.rhs->token = cast_data_stmt(Ntemp, root->astnode.expression.rhs->token); root->astnode.expression.rhs->vartype = Ntemp->vartype; } fprintf(curfp,"%s ", ditem); bc_append(meth, jvm_dup); bc_push_int_const(meth, idx++); pushConst(meth, root->astnode.expression.rhs); bc_gen_array_store_op(meth, jvm_data_types[root->astnode.expression.rhs->vartype]); return idx; } /***************************************************************************** * * * data_scalar_emit * * * * This function generates declarations of scalar items which are * * contained in DATA statements. * * * *****************************************************************************/ void data_scalar_emit(JVM_METHOD *meth, enum returntype type, AST *Ctemp, AST *Ntemp, int needs_dec) { int c; if(Ctemp->nodetype == Binaryop) { fprintf(stderr,"Attempt to assign more than one value to a scalar.\n"); return; } if(Ctemp->token == STRING) { HASHNODE *ht; int len; /* find this string in the symbol table */ ht = type_lookup(cur_type_table,Ntemp->astnode.ident.name); /* determine the length of the string (as declared in the fortran src) */ if(ht == NULL) len = 1; else { if(Ntemp->astnode.ident.len < 0) len = 1; else len = Ntemp->astnode.ident.len; } /* now initialize the string to all blanks. but we try to keep the length * of the string constant, otherwise some subscript operations get screwed * up. so we initialize the string to n blanks, where n is the original * string length. * ..i dont think this code is working as described above. however, it * doesn't seem to be hurting anything currently. --kgs */ if(!needs_dec) { /* assigning to a scalar element. call invoke_constructor() to push * the new string object onto the stack and then emit a putstatic * instruction to store it into the scalar variable. we can safely * assume that it is not an argument to this program unit because * you cannot use the DATA statement to initialize an argument. */ if(omitWrappers && !cgPassByRef(Ntemp->astnode.ident.name)) { fprintf(curfp,"%s = new String(\"%*s\");\n", Ntemp->astnode.ident.name, len, escape_double_quotes(Ctemp->astnode.constant.number)); invoke_constructor(meth, JL_STRING, Ctemp, STR_CONST_DESC); c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name, field_descriptor[String][0]); } else { fprintf(curfp,"%s = new StringW(\"%*s\");\n", Ntemp->astnode.ident.name, len, escape_double_quotes(Ctemp->astnode.constant.number)); invoke_constructor(meth, full_wrappername[type], Ctemp, STR_CONST_DESC); c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name, wrapped_field_descriptor[String][0]); } bc_append(meth, jvm_putstatic, c); } else { /* assigning to an array element. first, call expr_emit() which will * push a reference to the array & the array index onto the stack. * then call invoke_constructor() to push a new string object onto * the stack. finally, emit an array store instruction to store the * string into the array element. */ expr_emit(meth, Ntemp); fprintf(curfp," = \"%*s\";\n", len, escape_double_quotes(Ctemp->astnode.constant.number)); invoke_constructor(meth, JL_STRING, Ctemp, STR_CONST_DESC); bc_gen_array_store_op(meth, jvm_data_types[Ntemp->vartype]); } } else { /* this is not a string, so the declaration/initialization is * pretty straightforward. */ if(!needs_dec) { /* as above in the string case, we are assigning to a scalar * variable, which we may safely assume is not an argument. * if it does not need to be wrapped, just push the constant * onto the stack. otherwise, call invoke_constructor() to * create the appropriate wrapper object. */ if(omitWrappers && !cgPassByRef(Ntemp->astnode.ident.name)) { fprintf(curfp, "%s = ", Ntemp->astnode.ident.name); if(Ntemp->vartype != Ctemp->vartype){ Ctemp->token = cast_data_stmt(Ntemp, Ctemp->token); Ctemp->vartype = Ntemp->vartype; } fprintf(curfp, "%s;\n", Ctemp->astnode.constant.number); pushConst(meth, Ctemp); c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name, field_descriptor[type][0]); } else { fprintf(curfp,"%s = new %s(%s);\n",Ntemp->astnode.ident.name, wrapper_returns[ type], Ctemp->astnode.constant.number); invoke_constructor(meth, full_wrappername[type], Ctemp, wrapper_descriptor[type]); c = bc_new_fieldref(cur_class_file,cur_filename,Ntemp->astnode.ident.name, wrapped_field_descriptor[type][0]); } bc_append(meth, jvm_putstatic, c); } else { /* as above in string case, we are assigning to an array element. * the individual elements of an array are never wrapped, so we * just push the constant onto the stack and issue an array store * instruction. */ expr_emit(meth, Ntemp); fprintf(curfp, " = "); if(Ntemp->vartype != Ctemp->vartype){ Ctemp->token = cast_data_stmt(Ntemp, Ctemp->token); Ctemp->vartype = Ntemp->vartype; } fprintf(curfp,"%s;\n", Ctemp->astnode.constant.number); pushConst(meth, Ctemp); bc_gen_array_store_op(meth, jvm_data_types[type]); } } } /***************************************************************************** * * * invoke_constructor * * * * invokes the method of the given class constructor. used for the * * numeric & string classes (one-arg constructors). the AST node 'constant' * * should represent a constant value of course (i.e. dont pass idents). * * * *****************************************************************************/ void invoke_constructor(JVM_METHOD *meth, char *classname, AST *constant, char *desc) { int c; if(gendebug) printf("invoke_constructor(): classname = %s, constant = '%s'\n", classname, constant->astnode.constant.number); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, classname); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); pushConst(meth, constant); c = bc_new_methodref(cur_class_file, classname, "", desc); bc_append(meth, jvm_invokespecial, c); } /***************************************************************************** * * * name_emit * * * * A name will either fly solo or lead off * * a named array. So far, this code will emit * * a name or an array with integer indices. The * * procedure also needs to check all relevant tables * * to determine whether the name is an array or * * a procedure (i.e. Class.method) call, and whether * * the name is a STRING, CHAR, etc. Frankly, this is * * a hideous procedure and really needs to * * be rewritten. * * * * ...and it's getting worse by the day --Keith * * * * Heh... gotta love it... -dmd 9/26/97 * * * * Started cleaning up name_emit 10/10/97 --Keith * * * *****************************************************************************/ void name_emit (JVM_METHOD *meth, AST * root) { HASHNODE *hashtemp; char * tempname; if(gendebug) printf("entering name_emit\n"); /* * Check to see whether name is in external table. Names are * loaded into the external table from the parser. */ if(root->nodetype == Identifier) if(root->token == STRING) fprintf(stderr,"** string literal (this case should NOT be reached)\n"); tempname = strdup(root->astnode.ident.name); uppercase(tempname); if(gendebug) if(type_lookup(cur_equiv_table, root->astnode.ident.name)) printf("EQV %s is equivalenced\n",root->astnode.ident.name); /* * If this is not a substring operation and the name is in the * external table, then check to see if it is an intrinsic function * instead (e.g. SQRT, ABS, etc). */ if(root->nodetype != Substring) { hashtemp = type_lookup (cur_array_table, root->astnode.ident.name); if((root->astnode.ident.arraylist == NULL) && (!type_lookup(cur_external_table, root->astnode.ident.name))) { scalar_emit(meth, root, hashtemp); return; } else if(hashtemp || (!hashtemp && (root->astnode.ident.arraylist != NULL) && (root->vartype == String))) { array_emit(meth, root); return; } } /* * If the name is in the external table, then check to see if * it is an intrinsic function instead (e.g. SQRT, ABS, etc). */ if(type_lookup(cur_external_table, root->astnode.ident.name) || type_lookup(function_table, root->astnode.ident.name) || find_method(root->astnode.ident.name, descriptor_table)) { hashtemp = type_lookup(cur_type_table, root->astnode.ident.name); if(hashtemp) root->vartype = hashtemp->variable->vartype; external_emit(meth, root); } else if((type_lookup(function_table, root->astnode.ident.name) == NULL) && (find_method(root->astnode.ident.name, descriptor_table) == NULL) && (type_lookup(cur_type_table, root->astnode.ident.name) == NULL) && (methodscan(intrinsic_toks, tempname) != NULL)) { if(gendebug) printf("calling intrinsic emit %s\n", root->astnode.ident.name); intrinsic_emit(meth, root); } else switch (root->token) { /* * I think the first case (STRING/CHAR) is obsolete now since string * and char constants were moved to the Constant production. * 9/23/97, Keith */ case STRING: case CHAR: if(gendebug) { printf("** emit String/char literal!"); printf(" (should this case be reached?)\n"); } fprintf (curfp, "\"%s\"", escape_double_quotes(root->astnode.constant.number)); break; case INTRINSIC: break; case NAME: default: if (root->nodetype == Substring) substring_emit(meth, root); else{ subcall_emit(meth, root); } break; } f2jfree(tempname,strlen(tempname)+1); if(gendebug) printf("leaving name_emit\n"); } /***************************************************************************** * * * substring_emit * * * * This function emits substring operations. * * * *****************************************************************************/ void substring_emit(JVM_METHOD *meth, AST *root) { HASHNODE *hashtemp; hashtemp = type_lookup (cur_array_table, root->astnode.ident.name); if(hashtemp) fprintf(stderr,"WARNING: substring on array element not supported.\n"); scalar_emit(meth, root, hashtemp); if((root->parent->nodetype == Assignment) && (root->parent->astnode.assignment.lhs == root)) { /* in this case we are assigning TO a substring, so we * do not want to generate the calls to substring() because * we will create a new string and assign it to this variable. */ return; } if(root->astnode.ident.startDim[0] || root->astnode.ident.endDim[0]) fprintf(curfp,".substring("); return; } /***************************************************************************** * * * subcall_emit * * * * This function emits a function call. I think this function * * is only called in cases where the function or subroutine is * * not declared external or intrinsic and we dont know what * * else to do with it. * * * *****************************************************************************/ void subcall_emit(JVM_METHOD *meth, AST *root) { JVM_METHODREF *mref; AST *temp; char *tempstr, *t; char *desc; HASHNODE *ht; int c; fprintf(stderr,"WARNING: undeclared function call: %s", root->astnode.ident.name); fprintf(stderr," (likely to be emitted wrong)\n"); if(gendebug) { printf("@##@ in subcall_emit, %s\n",root->astnode.ident.name); if(type_lookup(cur_args_table, root->astnode.ident.name)) printf("@@ calling passed-in func %s\n",root->astnode.ident.name); } /* captialize the first letter of the subroutine name to get the * class name. */ tempstr = strdup (root->astnode.ident.name); *tempstr = toupper (*tempstr); mref = get_method_name(root, FALSE); /* mref should always be non-null, though i guess it's * possible that the elements may be null. */ if((mref->classname != NULL) && (strlen(mref->classname) > 0)) { t = char_substitution(mref->classname, '/', '.'); fprintf (curfp, "%s.%s", t, root->astnode.ident.name); f2jfree(t, strlen(t)+1); } else fprintf (curfp, "%s.%s", tempstr, root->astnode.ident.name); temp = root->astnode.ident.arraylist; desc = get_desc_from_arglist(temp); ht = type_lookup(cur_type_table, root->astnode.ident.name); if(gendebug){ printf("codegen: function return type: %s\n", returnstring[ht->variable->vartype]); } /* Loop through the argument list and emit each one. */ fprintf (curfp, "("); if(temp->nodetype != EmptyArgList) for (; temp != NULL; temp = temp->nextstmt) { if(temp != root->astnode.ident.arraylist) fprintf (curfp, ","); /* if not first iteration */ if (*temp->astnode.ident.name != '*') expr_emit (meth, temp); } c = bc_new_methodref(cur_class_file, bc_get_full_classname(tempstr, package_name), root->astnode.ident.name, desc); bc_append(meth, jvm_invokestatic, c); fprintf (curfp, ")"); bc_free_fieldref(mref); } /***************************************************************************** * * * idxNeedsDecr * * * * This function returns a boolean value depending on whether * * the array pointed to by alist needs to have its index (dims) * * decremented by one or not. This allows arrays to start * * indexing at an arbitrary point. If we recognize that the * * indexing starts at 0 then we dont have to decrement and we * * return FALSE. If indexing begins at 1 (the default in Fortran), * * then we must decrement since Java indexing begins at 0. * * * *****************************************************************************/ int idxNeedsDecr(AST *alist) { AST *startIdx; int eval; if( (alist != NULL) && (alist->nodetype == ArrayIdxRange)) { if((startIdx = alist->astnode.expression.lhs) != NULL) { /* evaluate the start index. we dont really care about the * end index at this point. */ eval = (int)eval_const_expr(startIdx); if(gendebug) printf("VAR eval returns %d\n",eval); if(eval == 0) return FALSE; else if(eval == 1) return TRUE; else fprintf(stderr,"Can't handle array starting at arbitrary index\n"); } else fprintf(stderr,"NULL lhs in array dec!\n"); } return TRUE; } /***************************************************************************** * * * func_array_emit * * * * This function emits the index to an array. The boolean argument * * is_arg represents whether the array is an argument to the current * * function or subroutine and the boolean is_ext represents whether * * the array is being passed to an external function. * * * *****************************************************************************/ void func_array_emit(JVM_METHOD *meth, AST *root, char *arrayname, int is_arg, int is_ext) { int needs_cast; HASHNODE *ht; if(is_ext) fprintf (curfp, ","); else fprintf (curfp, "["); /* if the index is not an integer value, then it needs a cast to int. for * bytecode generation, we cast the indices as we emit them, so a final * cast should not be necessary. */ needs_cast = root->vartype != Integer; if(needs_cast) fprintf(curfp,"(int)("); if(gendebug) printf("~looking up %s in the array table\n", arrayname); /* find this variable in the array table */ ht = type_lookup(cur_array_table, arrayname); if(ht == NULL) { if(gendebug) printf("~Could not find!\n"); } else { AST *tmp; int i,j; /* hack alert! what i'm doing here is changing the * nodetype of the array dimension expression's parent. * the reason being that when we emit the start and * end dimensions, if the parent nodetype is ArrayDec * then nothing will be emitted for bytecode. --keith * p.s. note that we only need to set this for one * dimension since they all share the same parent node. */ if(ht->variable->astnode.ident.endDim[0]) ht->variable->astnode.ident.endDim[0]->parent->nodetype = Identifier; tmp = root; for(i=0;ivariable->astnode.ident.dim;i++) { AST *start, *end; if(tmp != root) fprintf(curfp,"+"); fprintf(curfp,"("); expr_emit(meth, tmp); if(tmp->vartype != Integer) bc_append(meth, typeconv_matrix[tmp->vartype][Integer]); fprintf(curfp,"-("); start = ht->variable->astnode.ident.startDim[i]; if(start != NULL) { expr_emit(meth, start); if(start->vartype != Integer) bc_append(meth, typeconv_matrix[start->vartype][Integer]); } else { fprintf(curfp,"1"); bc_push_int_const(meth, 1); } fprintf(curfp,"))"); bc_append(meth, jvm_isub); for(j=i-1;j>=0;j--) { fprintf(curfp," * "); fprintf(curfp,"("); start = ht->variable->astnode.ident.startDim[j]; end = ht->variable->astnode.ident.endDim[j]; if(start != NULL) { expr_emit(meth, end); if(end->vartype != Integer) bc_append(meth, typeconv_matrix[end->vartype][Integer]); fprintf(curfp," - "); expr_emit(meth, start); if(start->vartype != Integer) bc_append(meth, typeconv_matrix[start->vartype][Integer]); bc_append(meth, jvm_isub); fprintf(curfp," + 1"); bc_push_int_const(meth, 1); bc_append(meth, jvm_iadd); } else { expr_emit(meth, end); if(end->vartype != Integer) bc_append(meth, typeconv_matrix[end->vartype][Integer]); } fprintf(curfp,")"); bc_append(meth, jvm_imul); } if(tmp != root) bc_append(meth, jvm_iadd); tmp = tmp->nextstmt; } } if(is_arg) { int varnum; fprintf(curfp, "+ _%s_offset",arrayname); /* locate the array's symtable entry and assign the varnum * of the offset arg to be one greater than the array's varnum. */ ht = type_lookup(cur_type_table, arrayname); if(!ht) { fprintf(stderr,"WARNING: type table screwed."); fprintf(stderr," looking for localvarnum for '_%s_offset'\n", arrayname); varnum = 1; } else varnum = ht->variable->astnode.ident.localvnum + 1; pushVar(cur_class_file, meth, Integer,is_arg,cur_filename, "dummy string...is this significant?", "I", varnum , FALSE); bc_append(meth, jvm_iadd); } if(needs_cast) fprintf(curfp,")"); if(!is_ext) { fprintf(curfp, "]"); } } /***************************************************************************** * * * cgPassByRef * * * * wrapper around isPassByRef() for codegen routines. this is just to * * make the code a bit more compact. we could have used a #define but they * * can be annoying sometimes. * * * *****************************************************************************/ int cgPassByRef(char *name) { return isPassByRef(name, cur_type_table, cur_common_table, cur_external_table); } /***************************************************************************** * * * isPassByRef * * * * Given the name of a variable, this function returns * * TRUE if the variable is passed by reference, FALSE * * otherwise. Generally, being passed by reference * * means that the variable will be wrapped in an object. * * * *****************************************************************************/ int isPassByRef(char *name, SYMTABLE *ttable, SYMTABLE *ctable, SYMTABLE *etable) { HASHNODE *ht, *ht2, *ht3; char *blockName; int pos, i; AST *temp; /* First look up the variable name in the main hash table. */ ht = type_lookup(ttable,name); if(ht) { if(gendebug) printf("isPassByRef(): found '%s' in type table\n", name); if(ht->variable->nodetype != Identifier) { fprintf(stderr,"isPassByRef(): non-ident node found (%s).\n", name); fprintf(stderr, " node type is: %s\n", print_nodetype(ht->variable)); return FALSE; } if(ht->variable->astnode.ident.passByRef) { /* simple case. if the variable is tagged as pass-by-reference * in the hash table, then return TRUE. */ if(gendebug) printf("isPassByRef(): '%s' is tagged pass-by-ref\n", name); return TRUE; } else { JVM_METHODREF * mtmp; /* otherwise, we look up the variable name in the table of * COMMON variables. */ if(gendebug) printf("isPassByRef(): '%s' is not tagged pass-by-ref\n", name); ht2 = type_lookup(ctable,name); if(ht2) { /* since different declarations of the same common block * may use different variable names for the members, we * use the position of the variable in the common block * to look up the actual variable. */ pos = ht2->variable->astnode.ident.position; blockName = ht2->variable->astnode.ident.commonBlockName; ht3 = type_lookup(global_common_table, blockName); if(ht3) { /* after getting a pointer to the common block, we loop * through the entries until we get to the Nth entry, where * N = pos, or until the pointer is NULL. */ i = 0; temp = ht3->variable->astnode.common.nlist; while((i < pos) && (temp != NULL)) { i++; temp = temp->nextstmt; } if(temp != NULL) return temp->astnode.ident.passByRef; else fprintf(stderr,"isPassByRef(): mismatch in common block size\n"); } else fprintf(stderr, "isPassByRef(): cant find common block %s\n", blockName); return TRUE; } else if((mtmp=find_commonblock(name, descriptor_table)) != NULL) { char * temp_desc; /** TODO: 'pos' was being used here uninitialized, but I can't * remember the circumstances that would drop us into this * case anyway. it seems common block variables are always * tagged pass-by-ref, so this is never executed (at least * compiling all blas, lapack, testers, etc never result in * this case being executed). * * For now, just set pos to 0 and figure it out later. **/ pos = 0; temp_desc = getFieldDescFromCommonDesc(mtmp->descriptor, pos); return isPassByRef_desc(temp_desc); } else { return FALSE; } } } else if(type_lookup(etable, name)) { if(gendebug) { printf("isPassByRef(): '%s' not found in type table,", name); printf(" but found in external table\n"); } return FALSE; } else { fprintf(stderr,"isPassByRef(): variable %s not found (unit: %s)\n", name, unit_name); return TRUE; } /* should not reach this point */ } /***************************************************************************** * * * array_emit * * * * Here we emit array variables. actually we first determine * * the context in which the array access is found and then call * * func_array_emit() to emit the array index. * * 10/10/97 --Keith * * * *****************************************************************************/ void array_emit(JVM_METHOD *meth, AST *root) { AST *temp; struct var_info *arrayinf; if(gendebug) printf ("Array... %s, My node type is %s\n", root->astnode.ident.name, print_nodetype(root)); temp = root->astnode.ident.arraylist; if((root->vartype == String) && temp && !temp->nextstmt && !type_lookup(cur_array_table, root->astnode.ident.name)) { int c, charat_ref; /* special handling for single dimension string array reference */ fprintf(curfp, "String.valueOf("); arrayinf = push_array_var(meth, root); fprintf(curfp, ".charAt(("); c = bc_new_methodref(cur_class_file, "java/lang/String", "valueOf", "(C)Ljava/lang/String;"); expr_emit(meth, temp); bc_append(meth, jvm_iconst_1); bc_append(meth, jvm_isub); charat_ref = bc_new_methodref(cur_class_file,JL_STRING, "charAt", CHARAT_DESC); bc_append(meth, jvm_invokevirtual, charat_ref); bc_append(cur_method, jvm_invokestatic, c); fprintf(curfp, ")-1))"); return; } arrayinf = push_array_var(meth, root); if(root->parent == NULL) { /* Under normal circumstances, I dont think this should * be reached. */ fprintf (stderr,"Array... %s, NO PARENT - ", arrayinf->name); fprintf (stderr,"This is not good!\n"); } else { if(gendebug) printf ("Array... %s, Parent node type... %s\n", arrayinf->name, print_nodetype(root->parent)); if((root->parent->nodetype == Call)) { if(type_lookup(cur_external_table, root->parent->astnode.ident.name) && !type_lookup(cur_args_table,root->parent->astnode.ident.name) ) { func_array_emit(meth, temp, root->astnode.ident.name, arrayinf->is_arg, TRUE); } else { func_array_emit(meth, temp, root->astnode.ident.name, arrayinf->is_arg, FALSE); bc_gen_array_load_op(meth, jvm_data_types[root->vartype]); } } else if(((root->parent->nodetype == Assignment) && (root->parent->astnode.assignment.lhs == root)) || (root->parent->nodetype == DataStmt) || (root->parent->nodetype == DataImpliedLoop)) { func_array_emit(meth, temp, root->astnode.ident.name, arrayinf->is_arg, FALSE); } else if((root->parent->nodetype == Typedec)) { /* Just a declaration, don't emit index. */ if(gendebug) printf("I guess this is just an array declaration\n"); } else { func_array_emit(meth, temp, root->astnode.ident.name, arrayinf->is_arg, FALSE); bc_gen_array_load_op(meth, jvm_data_types[root->vartype]); } } free_var_info(arrayinf); } /***************************************************************************** * * * push_array_var * * * * this function pushes a reference to the array variable onto the stack. * * * *****************************************************************************/ struct var_info * push_array_var(JVM_METHOD *meth, AST *root) { struct var_info *ainf; ainf = get_var_info(root); /* * Now, what needs to happen here is the context of the * array needs to be determined. If the array is being * passed as a parameter to a method, then the array index * needs to be passed separately and the array passed as * itself. If not, then an array value is being set, * so dereference with index arithmetic. */ /* for typedec, generate no bytecode */ if((root->parent != NULL) && (root->parent->nodetype == Typedec)) fprintf (curfp, "%s", ainf->name); else { char *com_prefix; com_prefix = get_common_prefix(root->astnode.ident.name); fprintf (curfp, "%s%s", com_prefix, ainf->name); pushVar(cur_class_file, meth, root->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); f2jfree(com_prefix, strlen(com_prefix)+1); } if(gendebug) printf("push_array_var(%s) - '%s' -> %d\n", cur_filename, root->astnode.ident.name, ainf->localvar); return ainf; } /***************************************************************************** * * * get_var_info * * * * this function returns information about an identifier (name, desc, etc). * * * *****************************************************************************/ struct var_info * get_var_info(AST *root) { int is_arg; unsigned int varnum=0; char *com_prefix; char *name, *tmpclass, *desc; HASHNODE *ht; struct var_info *new_array_inf; new_array_inf = (struct var_info *)f2jalloc(sizeof(struct var_info)); /* find the descriptor & local var number (if applicable) for this var */ if((ht = type_lookup(cur_type_table, root->astnode.ident.name)) != NULL) { desc = getVarDescriptor(ht->variable); varnum = ht->variable->astnode.ident.localvnum; } else { fprintf(stderr,"WARNING: get_var_info() '%s' not in hash table!\n", root->astnode.ident.name); desc = "asdfjkl"; } /* If this is a COMMON variable, get the prefix for the common * class name. */ com_prefix = get_common_prefix(root->astnode.ident.name); name = root->astnode.ident.name; if(com_prefix[0] != '\0') { char *idx; /* if this is a COMMON variable, find out the merged * name, if any, that we should use instead. Names are * merged when different declarations of a common * block use different variable names. */ ht = type_lookup(cur_type_table,root->astnode.ident.name); if (ht == NULL) fprintf(stderr,"get_var_info:Cant find %s in type_table\n", root->astnode.ident.name); if(ht->variable->astnode.ident.merged_name != NULL) name = ht->variable->astnode.ident.merged_name; tmpclass = strdup(com_prefix); while( (idx = strchr(tmpclass, '.')) != NULL ) *idx = '/'; tmpclass[strlen(tmpclass)-1] = '\0'; } else tmpclass = strdup(cur_filename); /* if this is an equivalenced variable, find out the merged * name that we should use instead. Equivalenced names are * always merged. */ if((ht = type_lookup(cur_equiv_table,root->astnode.ident.name)) != NULL) name = ht->variable->astnode.ident.merged_name; if (name == NULL) { fprintf(stderr,"get_var_info: setting name to NULL!\n"); name = root->astnode.ident.name; } if(gendebug) printf("### #in get_var_info, setting name = %s\n",name); /* Determine whether this variable is an argument to the current * program unit. */ if( type_lookup(cur_args_table,root->astnode.ident.name) != NULL ) is_arg = TRUE; else is_arg = FALSE; new_array_inf->name = strdup(name); new_array_inf->desc = strdup(desc); new_array_inf->localvar = varnum; new_array_inf->is_arg = is_arg; new_array_inf->class = strdup(tmpclass); f2jfree(com_prefix, strlen(com_prefix)+1); f2jfree(tmpclass, strlen(tmpclass)+1); return new_array_inf; } /***************************************************************************** * * * get_common_prefix * * * * If the variable is in a common block, this function returns the name of * * the class file in which it is declared. Otherwise, it returns a blank * * string. * * * *****************************************************************************/ char * get_common_prefix(char *varname) { HASHNODE *ht; char * inf = strdup(inputfilename); char * prefix = strtok(inf,"."); static char * cprefix; JVM_METHODREF *mtmp; char * idx; /* Look up this variable name in the table of COMMON variables */ ht = type_lookup(cur_common_table, varname); if(gendebug) printf("in get_common_prefix, name = '%s'\n",varname); if(ht) { if(gendebug) printf("commonblockname = '%s'\n", ht->variable->astnode.ident.commonBlockName); if((mtmp = find_commonblock(ht->variable->astnode.ident.commonBlockName, descriptor_table)) != NULL) { cprefix = (char *) f2jalloc( strlen(mtmp->classname) + 3); sprintf(cprefix,"%s.", mtmp->classname); } else { char * full_prefix = bc_get_full_classname(prefix, package_name); cprefix = (char *) f2jalloc( strlen(ht->variable->astnode.ident.commonBlockName) + strlen(full_prefix) + 3); sprintf(cprefix,"%s_%s.", full_prefix, ht->variable->astnode.ident.commonBlockName); } } else cprefix = strdup(""); /* dup so we can free() later */ /* convert fully-qualified class name to dotted notation */ while( (idx = strchr(cprefix, '/')) != NULL ) *idx = '.'; if(gendebug) if(cprefix && strlen(cprefix) > 0) printf("get_common_prefix returning '%s'\n", cprefix); f2jfree(inf, strlen(inf)+1); return(cprefix); } /***************************************************************************** * * * getVarDescriptor * * * * Returns the descriptor for this variable. * * * *****************************************************************************/ char * getVarDescriptor(AST *root) { if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) return field_descriptor[root->vartype][(root->astnode.ident.dim > 0)]; else return wrapped_field_descriptor[root->vartype] [(root->astnode.ident.dim > 0)]; } /***************************************************************************** * * * pushConst * * * * this function pushes the constant value pointed to by root onto the * * jvm stack. * * * *****************************************************************************/ void pushConst(JVM_METHOD *meth, AST *root) { switch(root->token) { case INTEGER: bc_push_int_const(meth, atoi(root->astnode.constant.number)); break; case E_EXPONENTIAL: case FLOAT: bc_push_float_const(meth, atof(root->astnode.constant.number)); break; case D_EXPONENTIAL: case DOUBLE: bc_push_double_const(meth, atof(root->astnode.constant.number)); break; case TrUE: /* dont expect to find booleans anyway, so dont try */ bc_append(meth, jvm_iconst_1); break; case FaLSE: bc_append(meth, jvm_iconst_0); break; case STRING: bc_push_string_const(meth, root->astnode.constant.number); break; default: break; } } /***************************************************************************** * * * scalar_emit * * * * This function emits a scalar variable. The first thing that needs * * to be checked here is whether the variable is part of a common block. * * If so, we need to emit the common block name followed by a dot and * * the variable name. Otherwise, just emit the variable name. If using * * object wrappers, the nodetype of the parent node must be checked. If the * * parent node is a 'call' to an external function then the variables must * * be passed as objects. Otherwise, the value from the wrapper should be * * obtained by appending .val to the variable name. 10/10/97 -- Keith * * * * (note: this function also emits array variables which do not have * * indices since they look like scalars to the parser) * * * *****************************************************************************/ void scalar_emit(JVM_METHOD *meth, AST *root, HASHNODE *hashtemp) { char *com_prefix, *desc, *name, *scalar_class; HASHNODE *ht, *isArg, *typenode; /* determine descriptor */ if((typenode = type_lookup(cur_type_table,root->astnode.ident.name))!=NULL) desc = getVarDescriptor(typenode->variable); else { fprintf(stderr,"ERROR: can't find '%s' in hash table\n", root->astnode.ident.name); exit(EXIT_FAILURE); } if(gendebug) printf("in scalar_emit, name = %s, desc = %s\n", root->astnode.ident.name, desc); /* get the name of the common block class file, if applicable */ com_prefix = get_common_prefix(root->astnode.ident.name); name = root->astnode.ident.name; isArg = type_lookup(cur_args_table,name); if(com_prefix[0] != '\0') { char *idx; /* if this is a COMMON variable, find out the merged * name, if any, that we should use instead. Names are * merged when different declarations of a common * block use different variable names. */ ht = type_lookup(cur_type_table,root->astnode.ident.name); if (ht == NULL) fprintf(stderr,"scalar_emit:Cant find %s in type_table\n", root->astnode.ident.name); else if(ht->variable->astnode.ident.merged_name != NULL) name = ht->variable->astnode.ident.merged_name; scalar_class = strdup(com_prefix); while( (idx = strchr(scalar_class, '.')) != NULL ) *idx = '/'; scalar_class[strlen(scalar_class)-1] = '\0'; } else scalar_class = strdup(cur_filename); if(gendebug) printf("scalar_emit: scalar_class is '%s'\n",scalar_class); /* if this is an equivalenced variable, find out the merged * name that we should use instead. Equivalenced names are * always merged. */ if((ht = type_lookup(cur_equiv_table,root->astnode.ident.name))!=NULL) { name = ht->variable->astnode.ident.merged_name; if(gendebug) printf("%s -> %s\n",root->astnode.ident.name,name); } if (name == NULL) { fprintf(stderr,"scalar_emit: name was NULL!\n"); name = root->astnode.ident.name; } if(hashtemp == NULL) { /* if hashtemp is NULL, then this variable is not in the * array table (i.e. it is not an array). */ if(gendebug) { printf("here we are emitting a scalar: %s, len = %d, ", root->astnode.ident.name, root->astnode.ident.len); printf("The parent node is : %s\n",print_nodetype(root->parent)); } if(gendebug) printf("### #in scalar_emit, setting name = %s\n",name); if(root->parent == NULL) { /* not good. */ fprintf(stderr,"scalar_emit(): NO PARENT! (%s)\n", name); } else { if (root->parent->nodetype == Call) { JVM_METHODREF *user_method; char *tempname; if(gendebug) printf("in scalar_emit CALL, '%s' <- '%s'\n", root->parent->astnode.ident.name, name); user_method = find_method(root->parent->astnode.ident.name, descriptor_table); tempname = strdup(root->parent->astnode.ident.name); uppercase(tempname); /* Determine whether the parent (a call) is an intrinsic or an * array access. If neither, we pass the scalar as is - wrapped * in an object if necessary. This provides the ability to simulate * pass by reference in Java. If the parent is either an intrinsic * function call or an array access, we must pass the actual value. * Fortran intrinsics are implemented using functions from the core * Java API which only take primitive types as arguments. And arrays * must always be indexed using primitive integers. Therefore, in * those two cases, we must emit the primitive value, in some cases * obtained by appending ".val" to the wrapper object. */ if(((methodscan(intrinsic_toks, tempname) == NULL) || user_method) && (type_lookup(cur_array_table, root->parent->astnode.ident.name) == NULL)) { /* parent is not a call to an intrinsic and not an array access */ if(gendebug) printf("did not find %s in intrinsics table\n", root->parent->astnode.ident.name); fprintf (curfp, "%s%s", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } else { if(gendebug) printf("found %s in intrinsics or array table\n", root->parent->astnode.ident.name); if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) { fprintf (curfp, "%s%s", com_prefix,name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } else { fprintf (curfp, "%s%s.val", com_prefix,name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, TRUE); } } f2jfree(tempname, strlen(tempname)+1); } else if(root->parent->nodetype == Typedec) { /* Parent is a type declaration - just emit the name itself. * * For bytecode generation, nothing needs to be done here * because insert_fields() handles all typedecs. */ if(gendebug) printf("Emitting typedec name: %s\n", name); fprintf (curfp, "%s", name); } else if(root->parent->nodetype == Equivalence) { /* Parent is an EQUIVALENCE statement. This is handled the * same as a type declaration, except we emit the merged name. * * Nothing needs to be done here for bytecode generation. */ if(gendebug) printf("Emitting equivalenced name: %s\n", root->astnode.ident.merged_name); fprintf (curfp, "%s", root->astnode.ident.merged_name); } else if(root->parent->nodetype == ArrayDec) { /* Parent is an array declaration, but we know that the * variable we're emitting is not an array, so this must * be the size of the array. * * Nothing needs to be done here for bytecode generation. */ if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) fprintf (curfp, "%s%s", com_prefix, name); else fprintf (curfp, "%s%s.val", com_prefix, name); } else if(((root->parent->nodetype == Assignment) || (root->parent->nodetype == StmtLabelAssign)) && (root->parent->astnode.assignment.lhs == root)) { /* this is the LHS of some assignment. this is only an * issue for bytecode generation since we don't want to * generate a load instruction for the LHS of an assignment. * for Java source, generate as usual. */ if((global_sub.name != NULL) && !strcmp(global_sub.name, name)) fprintf (curfp, " %d ", global_sub.val); else { if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) fprintf (curfp, "%s%s", com_prefix, name); else { fprintf (curfp, "%s%s.val", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } } } else { /* General case - just generate the name, with the * .val suffix if applicable. the global_sub stuff is * for implied DO loops in data statements. in that * case, we dont want to actually emit a variable name, * so we substitute its corresponding number. */ if((global_sub.name != NULL) && !strcmp(global_sub.name, name)) { fprintf (curfp, " %d ", global_sub.val); bc_push_int_const(meth, global_sub.val); } else { if(omitWrappers && !cgPassByRef(root->astnode.ident.name)) { fprintf (curfp, "%s%s", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } else { fprintf (curfp, "%s%s.val", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, TRUE); } } } } } else { /* * if we reach this case, we are emitting an array, but there * is no index specified. Normally, we would just emit the variable * name, but we must also check the parent nodetype. If it is a * call to an external function, then we have to emit the variable * name followed by ",0" to signify that the offset into this array * is 0. 10/10/97 --Keith */ if(root->parent == NULL) { fprintf(stderr,"scalar_emit(): NO PARENT!\n"); } else { if(gendebug) { printf("here we are emitting a scalar: %s,",name); printf("The parent node is : %s\n",print_nodetype(root->parent)); } if(root->parent->nodetype == Call) { if(type_lookup(cur_args_table, root->parent->astnode.ident.name) && !type_lookup(cur_type_table, root->parent->astnode.ident.name)) { /* if the parent is a subroutine passed as an arg to this function, * then we do not append the offset. */ fprintf (curfp, "%s%s", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } else if(type_lookup(cur_args_table,root->astnode.ident.name)) { fprintf (curfp, "%s%s,_%s_offset", com_prefix, name, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); bc_gen_load_op(meth, typenode->variable->astnode.ident.localvnum+1, jvm_Int); } else { fprintf (curfp, "%s%s,0", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); bc_append(meth, jvm_iconst_0); } } else if(root->parent->nodetype == Write) { if(type_lookup(cur_args_table,root->astnode.ident.name)) { fprintf (curfp, "%s%s,_%s_offset", com_prefix, name, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); bc_gen_load_op(meth, typenode->variable->astnode.ident.localvnum+1, jvm_Int); } else { fprintf (curfp, "%s%s,0", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); bc_append(meth, jvm_iconst_0); } } else if(((root->parent->nodetype == Assignment) || (root->parent->nodetype == StmtLabelAssign)) && (root->parent->astnode.assignment.lhs == root)) { /* LHS of assignment. do not generate any bytecode. */ fprintf (curfp, "%s%s", com_prefix, name); } else { fprintf (curfp, "%s%s", com_prefix, name); pushVar(cur_class_file, meth, root->vartype, isArg!=NULL, scalar_class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } } } f2jfree(scalar_class, strlen(scalar_class)+1); f2jfree(com_prefix, strlen(com_prefix)+1); } /***************************************************************************** * * * external_emit * * * * This function translates calls to external functions. First, * * check whether we are translating a call to ETIME or SECOND. * * We have implemented java versions of these pseduo intrinsics. * * If we're not translating a call to ETIME or SECOND, use the * * function call_emit(). --Keith * * * *****************************************************************************/ void external_emit(JVM_METHOD *meth, AST *root) { char *tempname, *javaname; METHODTAB *entry; AST *temp; int c; if(gendebug) { printf("here we are in external_emit (%s)\n", root->astnode.ident.name); printf("nodetype = %s, parent nodetype = %s\n", print_nodetype(root),print_nodetype(root->parent)); } /* * If we encounter this external variable within a * function/subroutine call, but the name itself is not * being used as a call, then we know that the function * is being passed as a parameter. */ if( (root->parent->nodetype == Call) && (root->astnode.ident.arraylist == NULL)) { HASHNODE *ht; if(gendebug) printf("unit %s: EXTERNAL has parent CALL\n", unit_name); tempname = strdup(root->astnode.ident.name); *tempname = toupper(*tempname); /* if this external function is also an argument to the * current unit, we already have an Object reference to * it, so just pass that. If not, we create a new * instance of whatever class we want to pass. */ if(type_lookup(cur_args_table,root->astnode.ident.name)) { ht=type_lookup(cur_type_table,root->astnode.ident.name); if(ht) bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object); else bc_gen_load_op(meth, 0, jvm_Object); fprintf(curfp,"%s", root->astnode.ident.name); } else { int c; char *fc; fprintf(curfp," new %s() ",tempname); fc = bc_get_full_classname(tempname, package_name); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, fc); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,fc, "", "()V"); bc_append(meth, jvm_invokespecial, c); } return; } tempname = strdup(root->astnode.ident.name); uppercase(tempname); entry = methodscan (intrinsic_toks, tempname); /* * This block of code is only called if the identifier * absolutely does not have an entry in any table, * and corresponds to a method invocation of * something in the blas or lapack packages. */ if (entry == NULL) { if (root->astnode.ident.arraylist != NULL) call_emit (meth, root); f2jfree(tempname, strlen(tempname)+1); return; } javaname = entry->java_method; if(gendebug) { printf("javaname = %s\n",javaname); printf("args = %p\n", (void*)root->astnode.ident.arraylist); } /* Ensure that the call has arguments */ if (root->astnode.ident.arraylist != NULL) { temp = root->astnode.ident.arraylist; if(!strcmp(tempname, "ETIME")) { /* first, make sure there are enough args to work with */ if(temp == NULL) { fprintf(stderr,"No args to ETIME\n"); f2jfree(tempname, strlen(tempname)+1); return; } if(gendebug) printf("emitting ETIME...\n"); fprintf (curfp, "Etime.etime("); expr_emit(meth, temp); fprintf (curfp, ")"); c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); } else if(!strcmp(tempname, "SECOND")) { if(gendebug) printf("emitting SECOND...\n"); fprintf(curfp, "Second.second()"); c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); } } f2jfree(tempname, strlen(tempname)+1); } /***************************************************************************** * * * intrinsic_emit * * * * This function generates calls to intrinsic functions. Basically we just * * map fortran intrinsics to equivalent functions in the core Java API. * * It might be a good idea to write separate handlers for each intrinsic. * * Many intrinsics can be handled with a generic handler, so we could have * * a generic one-argument handler, a generic two-argument handler, etc. * * Intrinsics that need more specialized handling, such as LOG10, would need * * their own handler. Because of the need for specialized handlers, the * * commented-out loop below may not ever really work. * * (6/2000 removed loop - kgs). * * * *****************************************************************************/ void intrinsic_emit(JVM_METHOD *meth, AST *root) { AST *temp; HASHNODE *ht; int c; METHODTAB *entry; char *tempname, *javaname; enum _intrinsics id; if(gendebug) printf("entering intrinsic_emit\n"); tempname = strdup(root->astnode.ident.name); uppercase(tempname); entry = methodscan (intrinsic_toks, tempname); if(!entry) { fprintf(stderr,"Error: not expecting null entry at this point.\n"); exit(EXIT_FAILURE); } /* if strict floating-point is enabled and the intrinsic has a * strict version, then use it for generating the call. */ if(strictMath && entry->strict_java_method) javaname = entry->strict_java_method; else javaname = entry->java_method; id = entry->intrinsic; switch(id) { /* numeric type conversion intrinsics. */ case ifunc_INT: case ifunc_IFIX: case ifunc_IDINT: case ifunc_REAL: case ifunc_FLOAT: case ifunc_SNGL: case ifunc_DBLE: case ifunc_CMPLX: temp = root->astnode.ident.arraylist; /* for Java source, we just emit a cast. */ fprintf (curfp, "%s(", javaname); expr_emit (meth, temp); fprintf (curfp, ")"); /* for bytecode, we emit the appropriate conversion opcode. */ if(temp->vartype != root->vartype) bc_append(meth, typeconv_matrix[temp->vartype][root->vartype]); break; /* conversion to integer */ case ifunc_ICHAR: temp = root->astnode.ident.arraylist; fprintf (curfp, "%s(", javaname); expr_emit (meth, temp); fprintf (curfp, ".charAt(0))"); bc_append(meth, jvm_iconst_0); c = bc_new_methodref(cur_class_file,JL_STRING, "charAt", CHARAT_DESC); bc_append(meth, jvm_invokevirtual, c); break; /* conversion to character */ case ifunc_CHAR: c = cp_find_or_insert(cur_class_file,CONSTANT_Class, JL_CHAR); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); temp = root->astnode.ident.arraylist; fprintf (curfp, "new Character( %s(", javaname); expr_emit (meth, temp); fprintf (curfp, ") ).toString()"); c = bc_new_methodref(cur_class_file,JL_CHAR, "", "(C)V"); bc_append(meth, jvm_invokespecial, c); c = bc_new_methodref(cur_class_file, JL_CHAR, "toString", TOSTRING_DESC); bc_append(meth, jvm_invokevirtual, c); break; /* truncation */ case ifunc_AINT: case ifunc_DINT: if((root->astnode.ident.arraylist->vartype == Float) && (id==ifunc_AINT)) aint_intrinsic_emit(meth, root, entry); else dint_intrinsic_emit(meth, root, entry); break; /* nearest whole number */ case ifunc_ANINT: case ifunc_DNINT: if(root->astnode.ident.arraylist->vartype == Double) { entry = &intrinsic_toks[ifunc_DNINT]; if(strictMath && entry->strict_java_method) javaname = entry->strict_java_method; else javaname = entry->java_method; fprintf (curfp, "(double)%s(", javaname); } else fprintf (curfp, "(float)%s(", javaname); expr_emit (meth, root->astnode.ident.arraylist); fprintf (curfp, ")"); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file, entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); if(root->astnode.ident.arraylist->vartype == Double) bc_append(meth, jvm_i2d); else bc_append(meth, jvm_i2f); break; /* nearest integer */ case ifunc_NINT: case ifunc_IDNINT: if(root->astnode.ident.arraylist->vartype == Double) entry = &intrinsic_toks[ifunc_IDNINT]; if(strictMath && entry->strict_java_method) javaname = entry->strict_java_method; else javaname = entry->java_method; fprintf (curfp, "%s(", javaname); expr_emit (meth, root->astnode.ident.arraylist); fprintf (curfp, ")"); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file, entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); break; /* absolute value */ case ifunc_ABS: if(root->astnode.ident.arraylist->vartype == Integer) entry = &intrinsic_toks[ifunc_IABS]; else if(root->astnode.ident.arraylist->vartype == Double) entry = &intrinsic_toks[ifunc_DABS]; else if(root->astnode.ident.arraylist->vartype == Complex) entry = &intrinsic_toks[ifunc_CABS]; case ifunc_DABS: case ifunc_IABS: case ifunc_CABS: if(strictMath && entry->strict_java_method) javaname = entry->strict_java_method; else javaname = entry->java_method; temp = root->astnode.ident.arraylist; fprintf (curfp, "%s(", javaname); expr_emit (meth, temp); fprintf (curfp, ")"); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file, entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); break; /* remainder */ case ifunc_MOD: case ifunc_AMOD: case ifunc_DMOD: temp = root->astnode.ident.arraylist; fprintf(curfp,"("); expr_emit (meth, temp); fprintf(curfp,")%%("); if(temp->vartype > root->vartype) bc_append(meth, typeconv_matrix[temp->vartype][root->vartype]); expr_emit (meth, temp->nextstmt); fprintf(curfp,")"); if(temp->nextstmt->vartype > root->vartype) bc_append(meth, typeconv_matrix[temp->nextstmt->vartype][root->vartype]); if(root->vartype == Float) bc_append(meth, jvm_frem); else if(root->vartype == Integer) bc_append(meth, jvm_irem); else bc_append(meth, jvm_drem); break; /* transfer of sign */ case ifunc_SIGN: if(root->vartype == Integer) entry = &intrinsic_toks[ifunc_ISIGN]; else if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DSIGN]; case ifunc_ISIGN: case ifunc_DSIGN: intrinsic2_call_emit(meth, root,entry, root->vartype); break; /* positive difference */ case ifunc_DIM: if(root->vartype == Integer) entry = &intrinsic_toks[ifunc_IDIM]; else if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DDIM]; case ifunc_IDIM: case ifunc_DDIM: intrinsic2_call_emit(meth, root,entry, root->vartype); break; /* double precision product of two reals */ case ifunc_DPROD: temp = root->astnode.ident.arraylist; fprintf(curfp, "((double)("); expr_emit (meth, temp); bc_append(meth, jvm_f2d); fprintf(curfp, ") * (double)("); expr_emit (meth, temp->nextstmt); bc_append(meth, jvm_f2d); fprintf(curfp, "))"); bc_append(meth, jvm_dmul); break; /* real AMAX0(integer) */ case ifunc_AMAX0: max_intrinsic_emit(meth, root, entry); break; /* integer MAX1(real) */ case ifunc_MAX1: fprintf(curfp,"(int)("); max_intrinsic_emit(meth, root, entry); fprintf(curfp,")"); bc_append(meth, typeconv_matrix[Float][Integer]); break; /* generic maximum or MAX that returns same type as args */ case ifunc_MAX: case ifunc_MAX0: case ifunc_AMAX1: case ifunc_DMAX1: max_intrinsic_emit(meth, root, entry); break; /* real AMIN0(integer) */ case ifunc_AMIN0: min_intrinsic_emit(meth, root, entry); break; /* integer MIN1(real) */ case ifunc_MIN1: fprintf(curfp,"(int)("); min_intrinsic_emit(meth, root, entry); fprintf(curfp,")"); bc_append(meth, typeconv_matrix[Float][Integer]); break; /* generic minimum or MIN that returns same type as args */ case ifunc_MIN: case ifunc_MIN0: case ifunc_AMIN1: case ifunc_DMIN1: min_intrinsic_emit(meth, root, entry); break; /* length of a character entity */ case ifunc_LEN: temp = root->astnode.ident.arraylist; /* the handling of the LEN intrinsic here is really a hack.. * LEN(x) should return the declared length of x, but if x * was passed in as an argument, we may not know the declared * length of x at compile-time. In this case, we just use * the length() method at run-time. That's pretty bad, but * the alternative is to create some sort of fortran string * class that keeps track of the declared length - definitely * a hassle to implement and also makes the API nastier by * not allowing the user to pass String constants.. -keith */ if(temp != NULL) { if( (ht=type_lookup(cur_type_table,temp->astnode.ident.name)) != NULL) { if(ht->variable->astnode.ident.len > 0) { fprintf (curfp, " %d ", ht->variable->astnode.ident.len); bc_push_int_const(meth, ht->variable->astnode.ident.len); if(gendebug) printf("LEN(%s) = %d\n",temp->astnode.ident.name, ht->variable->astnode.ident.len); } else { int c; expr_emit(meth, temp); fprintf(curfp,".length()"); c = bc_new_methodref(cur_class_file,JL_STRING, "length", STRLEN_DESC); bc_append(meth, jvm_invokevirtual, c); } } else { fprintf (curfp, " 1 "); bc_append(meth, jvm_iconst_1); if(gendebug) printf("LEN(%s) = 1\n",temp->astnode.ident.name); } } break; /* Index of substring */ case ifunc_INDEX: case ifunc_AIMAG: case ifunc_CONJG: /* Unimplemented! * * INDEX returns the location of a substring within another * string. however fortran and java treat strings quite differently * so implementing INDEX properly isn't as straightforward as it seems * at first. at this point, it's not that important, so I'll leave * it for later. --kgs 6/14/00 * * AIMAG and CONJG operate on complex numbers, which are not yet * supported. */ fprintf(stderr,"WARNING: intrinsic %s not yet implemented!\n", entry->fortran_name); break; /* square root */ case ifunc_SQRT: /* the java sqrt only supports double, so use that entry for * either double or float . */ if((root->vartype == Double) || (root->vartype == Float)) entry = &intrinsic_toks[ifunc_DSQRT]; else if(root->vartype == Complex) entry = &intrinsic_toks[ifunc_CSQRT]; case ifunc_DSQRT: case ifunc_CSQRT: intrinsic_call_emit(meth, root,entry,Double); break; /* exponential */ case ifunc_EXP: /* the java exp only supports double, so use that entry for * either double or float . */ if((root->vartype == Double) || (root->vartype == Float)) entry = &intrinsic_toks[ifunc_DEXP]; else if(root->vartype == Complex) entry = &intrinsic_toks[ifunc_CEXP]; case ifunc_DEXP: case ifunc_CEXP: intrinsic_call_emit(meth, root,entry,Double); break; /* natural logarithm */ case ifunc_LOG: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DLOG]; else if(root->vartype == Float) entry = &intrinsic_toks[ifunc_ALOG]; else if(root->vartype == Complex) entry = &intrinsic_toks[ifunc_CLOG]; case ifunc_ALOG: case ifunc_DLOG: case ifunc_CLOG: intrinsic_call_emit(meth, root,entry,Double); break; /* common logarithm */ case ifunc_LOG10: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DLOG10]; else if(root->vartype == Float) entry = &intrinsic_toks[ifunc_ALOG10]; case ifunc_ALOG10: case ifunc_DLOG10: intrinsic_call_emit(meth, root, entry, Double); break; /* sine */ case ifunc_SIN: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DSIN]; else if(root->vartype == Complex) entry = &intrinsic_toks[ifunc_CSIN]; case ifunc_DSIN: case ifunc_CSIN: intrinsic_call_emit(meth, root, entry, Double); break; /* cosine */ case ifunc_COS: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DCOS]; else if(root->vartype == Complex) entry = &intrinsic_toks[ifunc_CCOS]; case ifunc_DCOS: case ifunc_CCOS: intrinsic_call_emit(meth, root, entry, Double); break; /* tangent */ case ifunc_TAN: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DTAN]; case ifunc_DTAN: intrinsic_call_emit(meth, root, entry, Double); break; /* arcsine */ case ifunc_ASIN: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DASIN]; case ifunc_DASIN: intrinsic_call_emit(meth, root, entry, Double); break; /* arccosine */ case ifunc_ACOS: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DACOS]; case ifunc_DACOS: intrinsic_call_emit(meth, root, entry, Double); break; /* arctangent */ case ifunc_ATAN: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DATAN]; case ifunc_DATAN: intrinsic_call_emit(meth, root, entry, Double); break; /* arctangent (2 arg) */ case ifunc_ATAN2: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DATAN2]; case ifunc_DATAN2: intrinsic2_call_emit(meth, root, entry, Double); break; /* Hyperbolic sine */ case ifunc_SINH: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DSINH]; case ifunc_DSINH: intrinsic_call_emit(meth, root, entry, Double); break; /* Hyperbolic cosine */ case ifunc_COSH: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DCOSH]; case ifunc_DCOSH: intrinsic_call_emit(meth, root, entry, Double); break; /* Hyperbolic tangent */ case ifunc_TANH: if(root->vartype == Double) entry = &intrinsic_toks[ifunc_DTANH]; case ifunc_DTANH: intrinsic_call_emit(meth, root, entry, Double); break; case ifunc_LGE: /* lexically greater than/equal */ case ifunc_LGT: /* lexically greater than */ case ifunc_LLE: /* lexically less than/equal */ case ifunc_LLT: /* lexically less than */ intrinsic_lexical_compare_emit(meth, root, entry); break; default: fprintf(stderr,"WARNING: codegen() unimplemented intrinsic: '%s'\n", tempname); break; /* ansi c */ } f2jfree(tempname, strlen(tempname)+1); if(gendebug) printf("leaving intrinsic_emit\n"); } /***************************************************************************** * * * intrinsic_lexical_compare_emit * * * * generates code for LGE, LGT, LLE, adn LLT intrinsics. these intrinsics * * perform lexical comparison of strings. * * * *****************************************************************************/ void intrinsic_lexical_compare_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry) { JVM_CODE_GRAPH_NODE *goto_node, *if_node = NULL; AST *temp; int c; temp = root->astnode.ident.arraylist; fprintf(curfp,"(("); expr_emit(meth, temp); fprintf(curfp,").compareTo("); expr_emit(meth, temp->nextstmt); c = bc_new_methodref(cur_class_file, JL_STRING, "compareTo", COMPARE_DESC); bc_append(meth, jvm_invokevirtual, c); if(entry->intrinsic == ifunc_LGE) { fprintf(curfp,") >= 0 ? true : false)"); if_node = bc_append(meth, jvm_ifge); } else if(entry->intrinsic == ifunc_LGT) { fprintf(curfp,") > 0 ? true : false)"); if_node = bc_append(meth, jvm_ifgt); } else if(entry->intrinsic == ifunc_LLE) { fprintf(curfp,") <= 0 ? true : false)"); if_node = bc_append(meth, jvm_ifle); } else if(entry->intrinsic == ifunc_LLT) { fprintf(curfp,") < 0 ? true : false)"); if_node = bc_append(meth, jvm_iflt); } else fprintf(stderr,"intrinsic_lexical_compare_emit(): bad tag!\n"); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); bc_set_branch_target(if_node, bc_append(meth, jvm_iconst_1)); /* create a dummy instruction node following the stmts so that * we have a branch target for the goto statement. it'll be * removed later. */ bc_set_branch_target(goto_node, bc_append(meth, jvm_xxxunusedxxx)); } /***************************************************************************** * * * intrinsic0_call_emit * * * * generates a call to an intrinsic which has no args. * * * *****************************************************************************/ void intrinsic0_call_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry) { int c; if(entry->ret != root->vartype) fprintf(curfp, "(%s)", returnstring[root->vartype]); if(strictMath && entry->strict_java_method) fprintf (curfp, "%s()", entry->strict_java_method); else fprintf (curfp, "%s()", entry->java_method); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file, entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); if(entry->ret != root->vartype) bc_append(meth, typeconv_matrix[entry->ret][root->vartype]); } /***************************************************************************** * * * intrinsic_call_emit * * * * generates a call to a single-arg intrinsic. * * * *****************************************************************************/ void intrinsic_call_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry, enum returntype argtype) { int c; /* entry->ret should represent the return type of the equivalent JAva * function, while root->vartype should represent the return type of * the fortran intrinsic. e.g. fortan's EXP may return Real but JAva's * Math.exp() always returns double. in these cases we must cast. */ if(entry->ret != root->vartype) fprintf(curfp, "(%s)", returnstring[root->vartype]); if(strictMath && entry->strict_java_method) fprintf (curfp, "%s(", entry->strict_java_method); else fprintf (curfp, "%s(", entry->java_method); intrinsic_arg_emit(meth, root->astnode.ident.arraylist, argtype); fprintf (curfp, ")"); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file,entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file,entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); if(entry->ret != root->vartype) bc_append(meth, typeconv_matrix[entry->ret][root->vartype]); } /***************************************************************************** * * * intrinsic2_call_emit * * * * generates a call to a two-arg intrinsic. * * * *****************************************************************************/ void intrinsic2_call_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry, enum returntype argtype) { AST * temp = root->astnode.ident.arraylist; int c; /* entry->ret should represent the return type of the equivalent JAva * function, while root->vartype should represent the return type of * the fortran intrinsic. e.g. fortan's EXP may return Real but JAva's * Math.exp() always returns double. in these cases we must cast. */ if(entry->ret != root->vartype) fprintf(curfp, "(%s)", returnstring[root->vartype]); if(strictMath && entry->strict_java_method) fprintf (curfp, "%s(", entry->strict_java_method); else fprintf (curfp, "%s(", entry->java_method); intrinsic_arg_emit (meth, temp, argtype); fprintf (curfp, ","); intrinsic_arg_emit (meth, temp->nextstmt, argtype); fprintf (curfp, ")"); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file, entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file, entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); if(entry->ret != root->vartype) bc_append(meth, typeconv_matrix[entry->ret][root->vartype]); } /***************************************************************************** * * * aint_intrinsic_emit * * * * this function handles calls to the AINT intrinsic function. AINT returns * * the floor of a single precision floating point number. * * * *****************************************************************************/ void aint_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB * entry) { if(strictMath && entry->strict_java_method) fprintf(curfp,"(float)(%s(",entry->strict_java_method); else fprintf(curfp,"(float)(%s(",entry->java_method); expr_emit(meth, root->astnode.ident.arraylist); fprintf(curfp,"))"); /* convert to integer to truncate, then back to float */ bc_append(meth, jvm_f2i); bc_append(meth, jvm_i2f); } /***************************************************************************** * * * dint_intrinsic_emit * * * * this function handles calls to the DINT intrinsic function. DINT returns * * the floor of a double precision floating point number. * * * *****************************************************************************/ void dint_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry) { if(strictMath && entry->strict_java_method) fprintf(curfp,"(double)(%s(",entry->strict_java_method); else fprintf(curfp,"(double)(%s(",entry->java_method); expr_emit(meth, root->astnode.ident.arraylist); fprintf(curfp,"))"); /* convert to integer to truncate, then back to double */ bc_append(meth, jvm_d2i); bc_append(meth, jvm_i2d); } /***************************************************************************** * * * intrinsic_arg_emit * * * * this function emits the arg to an intrinsic function, making type casts * * as necessary. * * * *****************************************************************************/ void intrinsic_arg_emit(JVM_METHOD *meth, AST *node, enum returntype this_type) { if(gendebug){ printf("intrinsic_arg_emit, node type = %s, this type = %s\n", returnstring[node->vartype], returnstring[this_type]); } if(node->vartype > this_type) { fprintf(curfp," (%s)",returnstring[this_type]); expr_emit (meth, node); bc_append(meth, typeconv_matrix[node->vartype][this_type]); } else expr_emit(meth, node); } /***************************************************************************** * * * max_intrinsic_emit * * * * This function handles calls to the MAX intrinsic function. here we just * * check if the generic form is used and then call maxmin_intrinsic_emit(). * * * *****************************************************************************/ void max_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry) { METHODTAB *tmpentry = entry; char *desc = "(DDD)D", *f; if(entry->intrinsic == ifunc_MAX) { switch(root->vartype) { case Integer: tmpentry = &intrinsic_toks[ifunc_MAX0]; desc = "(III)I"; break; case Float: tmpentry = &intrinsic_toks[ifunc_AMAX1]; desc = "(FFF)F"; break; case Double: tmpentry = &intrinsic_toks[ifunc_DMAX1]; desc = "(DDD)D"; break; default: fprintf(stderr,"WARNING: generic MAX used, but data type is bad!\n"); break; } } else if(entry->intrinsic==ifunc_MAX0) desc = "(III)I"; else if((entry->intrinsic==ifunc_AMAX1) || (entry->intrinsic==ifunc_MAX1)) desc = "(FFF)F"; else if(entry->intrinsic==ifunc_AMAX0) desc = "(FFF)F"; else if(entry->intrinsic==ifunc_DMAX1) desc = "(DDD)D"; else fprintf(stderr,"WARNING: bad intrinsic tag in max_intrinsic_emit()\n"); f = strictMath ? THREEARG_MAX_FUNC_STRICT : THREEARG_MAX_FUNC; maxmin_intrinsic_emit(meth, root, tmpentry, f, desc); } /***************************************************************************** * * * min_intrinsic_emit * * * * This function handles calls to the MIN intrinsic function. here we just * * check if the generic form is used and then call maxmin_intrinsic_emit(). * * * *****************************************************************************/ void min_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry) { METHODTAB *tmpentry = entry; char *desc = "(DDD)D", *f; if(entry->intrinsic == ifunc_MIN) { switch(root->vartype) { case Integer: tmpentry = &intrinsic_toks[ifunc_MIN0]; desc = "(III)I"; break; case Float: tmpentry = &intrinsic_toks[ifunc_AMIN1]; desc = "(FFF)F"; break; case Double: tmpentry = &intrinsic_toks[ifunc_DMIN1]; desc = "(DDD)D"; break; default: fprintf(stderr,"WARNING: generic MIN used, but data type is bad!\n"); break; /* ansi c */ } } else if(entry->intrinsic==ifunc_MIN0) desc = "(III)I"; else if((entry->intrinsic==ifunc_AMIN1) || (entry->intrinsic==ifunc_MIN1)) desc = "(FFF)F"; else if(entry->intrinsic==ifunc_AMIN0) desc = "(FFF)F"; else if(entry->intrinsic==ifunc_DMIN1) desc = "(DDD)D"; else fprintf(stderr,"WARNING: bad intrinsic tag in min_intrinsic_emit()\n"); if(gendebug) printf("MIN vartype = %s, %s %s %s\n", returnstring[root->vartype], entry->class_name, entry->method_name, entry->descriptor); f = strictMath ? THREEARG_MIN_FUNC_STRICT : THREEARG_MIN_FUNC; maxmin_intrinsic_emit(meth, root, tmpentry, f, desc); } /***************************************************************************** * * * maxmin_intrinsic_emit * * * * This function handles calls to the MAX and MIN intrinsic functions. these * * functions take a variable number of arguments, which is not easily * * accomplished in Java, so we generate multiple calls to Math.max/Math.min * * in case there are more than 2 args. * * * *****************************************************************************/ void maxmin_intrinsic_emit(JVM_METHOD *meth, AST *root, METHODTAB *entry, char *threearg, char *three_desc) { int ii, arg_count = 0; char *javaname, *method, *util_class; int c; AST *temp; if(strictMath && entry->strict_java_method) javaname = entry->strict_java_method; else javaname = entry->java_method; util_class = strictMath ? STRICT_UTIL_CLASS : UTIL_CLASS; /* figure out how many args we need to handle */ for(temp = root->astnode.ident.arraylist;temp!=NULL;temp = temp->nextstmt) arg_count++; /* If we only have one arg, just emit that expression. This should not * happen since it's invalid to call MAX with only one arg. */ if(arg_count == 1) { temp = root->astnode.ident.arraylist; fprintf (curfp, "("); intrinsic_arg_emit(meth, temp, entry->ret); fprintf (curfp, ")"); } /* typical situation, two args */ else if(arg_count == 2) { temp = root->astnode.ident.arraylist; fprintf(curfp, "%s(", javaname); intrinsic_arg_emit(meth, temp, entry->ret); fprintf (curfp, ", "); intrinsic_arg_emit(meth, temp->nextstmt, entry->ret); fprintf (curfp, ")"); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file,entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file,entry->class_name, entry->method_name, entry->descriptor); bc_append(meth, jvm_invokestatic, c); } /* special handling of situation in which MAX or MIN has three args */ else if(arg_count == 3) { char *ta_tmp; temp = root->astnode.ident.arraylist; fprintf(curfp, "%s(", threearg); intrinsic_arg_emit(meth, temp,entry->ret); fprintf (curfp, ", "); intrinsic_arg_emit(meth, temp->nextstmt,entry->ret); fprintf (curfp, ", "); intrinsic_arg_emit(meth, temp->nextstmt->nextstmt,entry->ret); fprintf (curfp, ")"); ta_tmp = strdup(threearg); strtok(ta_tmp,"."); method = strtok(NULL,"."); c = bc_new_methodref(cur_class_file, util_class, method, three_desc); bc_append(meth, jvm_invokestatic, c); f2jfree(ta_tmp, strlen(ta_tmp)+1); } /* * For cases in which MAX or MIN has more than three args, we generate n-1 * method calls, where n is the number of args. For example, MAX(a,b,c,d,e) * would be translated to: * Math.max(Math.max(Math.max(Math.max(a,b),c),d),e) * I dont think this situation is very common (in LAPACK/BLAS at least). * * changed this slightly to make the inner call a three-arg Util.max call. * e.g. Math.max(Math.max(Util.max(a,b,c),d),e) * --kgs 6/13/00 */ else { char *ta_tmp; for(ii=0;iiastnode.ident.arraylist; intrinsic_arg_emit(meth, temp, entry->ret); fprintf (curfp, ", "); temp = temp->nextstmt; intrinsic_arg_emit(meth, temp, entry->ret); fprintf (curfp, ", "); temp = temp->nextstmt; intrinsic_arg_emit(meth, temp, entry->ret); fprintf (curfp, "), "); ta_tmp = strdup(threearg); strtok(ta_tmp,"."); method = strtok(NULL,"."); c = bc_new_methodref(cur_class_file, util_class, method, three_desc); bc_append(meth, jvm_invokestatic, c); if(strictMath && entry->strict_class_name) c = bc_new_methodref(cur_class_file,entry->strict_class_name, entry->method_name, entry->descriptor); else c = bc_new_methodref(cur_class_file,entry->class_name, entry->method_name, entry->descriptor); for(temp = temp->nextstmt; temp != NULL; temp = temp->nextstmt) { intrinsic_arg_emit(meth, temp, entry->ret); if(temp->nextstmt != NULL) fprintf (curfp, "), "); else fprintf (curfp, ") "); bc_append(meth, jvm_invokestatic, c); } f2jfree(ta_tmp, strlen(ta_tmp)+1); } } /***************************************************************************** * * * get_type * * * * This function tries to guess the type of a value contained * * in a string. If we find a '.' in the string, we guess that * * it's a floating point number. If the string contains 'true' * * or 'false', we guess that it's a boolean value. Otherwise * * we guess that it's an integer value. Not very sophisticated, * * but it works most of the time. * * * *****************************************************************************/ enum returntype get_type(char *num) { unsigned int idx; int contains_dot = FALSE, contains_f = FALSE; for(idx = 0;idx < strlen(num);idx++) if(num[idx] == '.') contains_dot = TRUE; else if(num[idx] == 'f') contains_f = TRUE; if(contains_dot && contains_f) return Float; if(contains_dot && !contains_f) return Double; if( !strcmp(num,"false") || !strcmp(num,"true")) return Logical; return Integer; } /***************************************************************************** * * * expr_emit * * * * This function traverses an expression subtree and emits code for simple * * operations. For more complex operations, we call the appropriate code * * generation routine. * * * *****************************************************************************/ void expr_emit (JVM_METHOD *meth, AST * root) { if(root == NULL) { /* We should not have a NULL expression */ fprintf(stderr,"Warning: NULL root in expr_emit (%s)\n", cur_filename); return; } if(gendebug) { printf("expr_emit(): nodetype = %s\n", print_nodetype(root)); printf("%s\n", root->astnode.ident.name); if(root->nodetype == Binaryop) printf("\toptype = %c\n",root->astnode.expression.optype); } switch (root->nodetype) { case Identifier: name_emit (meth, root); break; case Expression: parenthesized_expr_emit(meth, root); break; case Power: fprintf (curfp, "("); power_emit(meth, root); fprintf (curfp, ")"); break; case Binaryop: fprintf (curfp, "("); binaryop_emit(meth, root); fprintf (curfp, ")"); break; case Unaryop: fprintf (curfp, "("); unaryop_emit(meth, root); fprintf (curfp, ")"); break; case Constant: constant_expr_emit(meth, root); break; case Logicalop: fprintf (curfp, "("); logicalop_emit(meth, root); fprintf (curfp, ")"); break; case Relationalop: fprintf (curfp, "("); relationalop_emit(meth, root); fprintf (curfp, ")"); break; case Substring: substring_expr_emit(meth, root); break; default: fprintf(stderr,"Warning: Unknown nodetype in expr_emit(): %s\n", print_nodetype(root)); } if(gendebug)printf("leaving-expr emit\n"); return; } /***************************************************************************** * * * parenthesized_expr_emit * * * * This function handles any expression surrounded by parens - really no * * need to do anything here, just call expr_emit() to emit the expression. * * * *****************************************************************************/ void parenthesized_expr_emit(JVM_METHOD *meth, AST *root) { if (root->astnode.expression.parens) fprintf (curfp, "("); /* is expression.lhs ever really non-null? i dont think so. * in any case, for bytecode generation, we are not concerned * with parens, so it should be ok to just call expr_emit. (kgs) */ if (root->astnode.expression.lhs != NULL) expr_emit (meth, root->astnode.expression.lhs); expr_emit (meth, root->astnode.expression.rhs); if (root->astnode.expression.parens) fprintf (curfp, ")"); return; } /***************************************************************************** * * * power_emit * * * * This function generates code for exponential expressions (e.g. x**y). * * We use java.lang.Math.pow(). * * * *****************************************************************************/ void power_emit(JVM_METHOD *meth, AST *root) { int ct; /* hack alert: determine whether this expression is used as the size * in an array declaration. if so, it must be integer, but java's * pow() method returns double. so we add a cast. it would probably * be better to detect this elsewhere (e.g. in the code that emits * array declarations). */ BOOL gencast = (root->parent != NULL) && (root->parent->nodetype == ArrayDec); char pow_cast[32]; if(gencast) sprintf(pow_cast, "(int)"); else if(root->vartype != Double) sprintf(pow_cast, "(%s)", returnstring[root->vartype]); else sprintf(pow_cast, " "); if(strictMath) fprintf(curfp, "%sStrictMath.pow(", pow_cast); else fprintf(curfp, "%sMath.pow(", pow_cast); /* the args to pow must be doubles, so cast if necessary */ expr_emit(meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype != Double) bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][Double]); fprintf(curfp, ", "); expr_emit(meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype != Double) bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][Double]); fprintf(curfp, ")"); if(strictMath) ct = bc_new_methodref(cur_class_file, "java/lang/StrictMath", "pow", "(DD)D"); else ct = bc_new_methodref(cur_class_file, "java/lang/Math", "pow", "(DD)D"); bc_append(meth, jvm_invokestatic, ct); if(gencast) bc_append(meth, jvm_d2i); else if(root->vartype != Double) bc_append(meth, typeconv_matrix[Double][root->vartype]); return; } /***************************************************************************** * * * binaryop_emit * * * * This function generates code for binary operations (mul, add, etc). * * * *****************************************************************************/ void binaryop_emit(JVM_METHOD *meth, AST *root) { int ct; /* handle special case for string concatenation in bytecode.. we * must create a new StringBuffer which contains the LHS and append * the RHS to the STringBuffer. */ if(root->token == CAT) { ct = cp_find_or_insert(cur_class_file,CONSTANT_Class, STRINGBUFFER); bc_append(meth, jvm_new,ct); bc_append(meth, jvm_dup); expr_emit (meth, root->astnode.expression.lhs); if((root->astnode.expression.lhs->vartype != String) && (root->astnode.expression.lhs->vartype != Character) ) { fprintf(stderr,"ERROR:str cat with non-string types unsupported\n"); } ct = bc_new_methodref(cur_class_file,STRINGBUFFER, "", STRBUF_DESC); fprintf (curfp, "%c", root->astnode.expression.optype); bc_append(meth, jvm_invokespecial, ct); expr_emit (meth, root->astnode.expression.rhs); if((root->astnode.expression.rhs->vartype != String) && (root->astnode.expression.rhs->vartype != Character) ) { fprintf(stderr,"ERROR:str cat with non-string types unsupported\n"); } ct = bc_new_methodref(cur_class_file,STRINGBUFFER, "append", append_descriptor[String]); bc_append(meth, jvm_invokevirtual, ct); ct = bc_new_methodref(cur_class_file,STRINGBUFFER, "toString", TOSTRING_DESC); bc_append(meth, jvm_invokevirtual, ct); } else { expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > root->vartype) bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype] [root->vartype]); fprintf (curfp, "%c", root->astnode.expression.optype); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > root->vartype) bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype] [root->vartype]); switch(root->astnode.expression.optype) { case '+': bc_append(meth, add_opcode[root->vartype]); break; case '-': bc_append(meth, sub_opcode[root->vartype]); break; case '/': bc_append(meth, div_opcode[root->vartype]); break; case '*': bc_append(meth, mul_opcode[root->vartype]); break; default: fprintf(stderr,"WARNING: unsupported optype\n"); break; /* for ANSI C compliance */ } } return; } /***************************************************************************** * * * unaryop_emit * * * * This function emits the code for a unary expression. I think the only * * unary op we handle here is unary minus. Unary negation gets handled in * * logicalop_emit(). * * * *****************************************************************************/ void unaryop_emit(JVM_METHOD *meth, AST *root) { fprintf (curfp, "%c(", root->astnode.expression.minus); expr_emit (meth, root->astnode.expression.rhs); fprintf (curfp, ")"); if(root->astnode.expression.minus == '-') bc_append(meth, neg_opcode[root->vartype]); return; } /***************************************************************************** * * * constant_expr_emit * * * * This function emits the code for a constant expression. * * * *****************************************************************************/ void constant_expr_emit(JVM_METHOD *meth, AST *root) { char *tempname = NULL; if(root->parent != NULL) { tempname = strdup(root->parent->astnode.ident.name); uppercase(tempname); } /* * here we need to determine if this is a parameter to a function * or subroutine. if so, and we are using wrappers, then we need * to create a temporary wrapper and pass that in instead of the * constant. 10/9/97 -- Keith */ if( (root->parent != NULL) && (root->parent->nodetype == Call) && (type_lookup(cur_array_table,root->parent->astnode.ident.name) == NULL) && (methodscan(intrinsic_toks, tempname) == NULL)) { if(root->token == STRING) { if(omitWrappers) { pushConst(meth, root); fprintf (curfp, "\"%s\"", escape_double_quotes(root->astnode.constant.number)); } else { invoke_constructor(meth, full_wrappername[root->vartype], root, wrapper_descriptor[root->vartype]); fprintf (curfp, "new StringW(\"%s\")", escape_double_quotes(root->astnode.constant.number)); } } else { /* non-string constant argument to a function call */ if(omitWrappers) { pushConst(meth, root); fprintf (curfp, "%s", root->astnode.constant.number); } else { invoke_constructor(meth, full_wrappername[root->vartype], root, wrapper_descriptor[root->vartype]); fprintf (curfp, "new %s(%s)", wrapper_returns[get_type(root->astnode.constant.number)], root->astnode.constant.number); } } } else /* this constant is not an argument to a function call */ { pushConst(meth, root); if(root->token == STRING) fprintf (curfp, "\"%s\"", escape_double_quotes(root->astnode.constant.number)); else fprintf (curfp, "%s", root->astnode.constant.number); } if(tempname != NULL) f2jfree(tempname, strlen(tempname)+1); return; } /***************************************************************************** * * * logicalop_emit * * * * This function emits the code for a logical expression (i.e. boolean). * * * *****************************************************************************/ void logicalop_emit(JVM_METHOD *meth, AST *root) { JVM_CODE_GRAPH_NODE *if_node1, *if_node2, *goto_node, *next_node; switch(root->token) { case NOT: fprintf (curfp, "!"); expr_emit (meth, root->astnode.expression.rhs); bc_append(meth, jvm_iconst_1); bc_append(meth, jvm_ixor); break; case AND: expr_emit (meth, root->astnode.expression.lhs); if_node1 = bc_append(meth, jvm_ifeq); fprintf (curfp, " && "); expr_emit (meth, root->astnode.expression.rhs); if_node2 = bc_append(meth, jvm_ifeq); bc_append(meth, jvm_iconst_1); goto_node = bc_append(meth, jvm_goto); next_node = bc_append(meth, jvm_iconst_0); bc_set_branch_target(if_node1, next_node); bc_set_branch_target(if_node2, next_node); next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(goto_node, next_node); break; case OR: expr_emit (meth, root->astnode.expression.lhs); if_node1 = bc_append(meth, jvm_ifne); fprintf (curfp, " || "); expr_emit (meth, root->astnode.expression.rhs); if_node2 = bc_append(meth, jvm_ifne); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); next_node = bc_append(meth, jvm_iconst_1); bc_set_branch_target(if_node1, next_node); bc_set_branch_target(if_node2, next_node); next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(goto_node, next_node); break; } return; } /***************************************************************************** * * * relationalop_emit * * * * This function emits the code for a relational expression (e.g. .lt., .gt. * * etc). * * * *****************************************************************************/ void relationalop_emit(JVM_METHOD *meth, AST *root) { int cur_vt; cur_vt = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); if(((root->astnode.expression.lhs->vartype == String) || (root->astnode.expression.lhs->vartype == Character)) && ((root->astnode.expression.rhs->vartype == String) || (root->astnode.expression.rhs->vartype == Character))) { int c; int len; if((root->token != rel_eq) && (root->token != rel_ne)) { fprintf(stderr,"ERR: didn't expect this relop on a STring type!\n"); return; } c = bc_new_methodref(cur_class_file,JL_STRING, "regionMatches", REGIONMATCHES_DESC); if(root->token == rel_ne) fprintf(curfp,"!"); expr_emit (meth, root->astnode.expression.lhs); bc_append(meth, jvm_iconst_0); fprintf(curfp,".regionMatches(0, "); expr_emit (meth, root->astnode.expression.rhs); bc_append(meth, jvm_iconst_0); len = 1; if(root->astnode.expression.lhs->nodetype == Constant) { len = strlen(root->astnode.expression.lhs->astnode.constant.number); } else if(root->astnode.expression.lhs->nodetype == Identifier) { HASHNODE *h; h = type_lookup(cur_type_table, root->astnode.expression.lhs->astnode.ident.name); if(h) { if(h->variable->astnode.ident.len < 0) len = 1; else len = h->variable->astnode.ident.len; } } if(root->astnode.expression.rhs->nodetype == Constant) { int rlen; rlen = strlen(root->astnode.expression.rhs->astnode.constant.number); if(rlen < len) len = rlen; } else if(root->astnode.expression.rhs->nodetype == Identifier) { HASHNODE *h; h = type_lookup(cur_type_table, root->astnode.expression.rhs->astnode.ident.name); if(h) if((h->variable->astnode.ident.len < len) && (h->variable->astnode.ident.len > 0)) len = h->variable->astnode.ident.len; } /* bc_append(jvm_iconst_1); */ bc_push_int_const(meth, len); fprintf(curfp,", 0, %d) ",len); bc_append(meth, jvm_invokevirtual, c); /* call regionMatches() */ /* now check the op type & reverse if .NE. */ if(root->token == rel_ne) { bc_append(meth, jvm_iconst_1); bc_append(meth, jvm_ixor); } return; /* nothing more to do for strings here. */ } switch (root->token) { case rel_eq: if(gendebug) { if(root->astnode.expression.lhs->nodetype == Identifier) printf("##@@ lhs ident %s has type %s\n", root->astnode.expression.lhs->astnode.ident.name, returnstring[root->astnode.expression.lhs->vartype]); if(root->astnode.expression.rhs->nodetype == Identifier) printf("##@@ rhs ident %s has type %s\n", root->astnode.expression.rhs->astnode.ident.name, returnstring[root->astnode.expression.rhs->vartype]); } expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]); } fprintf (curfp, " == "); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]); } break; case rel_ne: expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]); } fprintf (curfp, " != "); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]); } break; case rel_lt: expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]); } fprintf (curfp, " < "); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]); } break; case rel_le: expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]); } fprintf (curfp, " <= "); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]); } break; case rel_gt: expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]); } fprintf (curfp, " > "); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]); } break; case rel_ge: expr_emit (meth, root->astnode.expression.lhs); if(root->astnode.expression.lhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.lhs->vartype][cur_vt]); } fprintf (curfp, " >= "); expr_emit (meth, root->astnode.expression.rhs); if(root->astnode.expression.rhs->vartype > cur_vt) { bc_append(meth, typeconv_matrix[root->astnode.expression.rhs->vartype][cur_vt]); } break; } switch(cur_vt) { case String: case Character: /* we dont need to do anything here because strings were handled * above already. */ break; case Complex: fprintf(stderr,"WARNING: complex relop not supported yet!\n"); break; case Logical: fprintf(stderr,"WARNING: relop not supported on logicals!\n"); break; case Float: { JVM_CODE_GRAPH_NODE *cmp_node, *goto_node, *iconst_node, *next_node; /* the only difference between fcmpg and fcmpl is the handling * of the NaN value. for .lt. and .le. we use fcmpg, otherwise * use fcmpl. this mirrors the behavior of javac. */ if((root->token == rel_lt) || (root->token == rel_le)) bc_append(meth, jvm_fcmpg); else bc_append(meth, jvm_fcmpl); cmp_node = bc_append(meth, dcmp_opcode[root->token]); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); iconst_node = bc_append(meth, jvm_iconst_1); bc_set_branch_target(cmp_node, iconst_node); /* create a dummy instruction node following the iconst so that * we have a branch target for the goto statement. it'll be * removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(goto_node, next_node); } break; case Double: { JVM_CODE_GRAPH_NODE *cmp_node, *goto_node, *iconst_node, *next_node; /* the only difference between dcmpg and dcmpl is the handling * of the NaN value. for .lt. and .le. we use dcmpg, otherwise * use dcmpl. this mirrors the behavior of javac. */ if((root->token == rel_lt) || (root->token == rel_le)) bc_append(meth, jvm_dcmpg); else bc_append(meth, jvm_dcmpl); cmp_node = bc_append(meth, dcmp_opcode[root->token]); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); iconst_node = bc_append(meth, jvm_iconst_1); bc_set_branch_target(cmp_node, iconst_node); /* create a dummy instruction node following the iconst so that * we have a branch target for the goto statement. it'll be * removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(goto_node, next_node); } break; case Integer: { JVM_CODE_GRAPH_NODE *cmp_node, *goto_node, *iconst_node, *next_node; cmp_node = bc_append(meth, icmp_opcode[root->token]); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); iconst_node = bc_append(meth, jvm_iconst_1); bc_set_branch_target(cmp_node, iconst_node); /* create a dummy instruction node following the iconst so that * we have a branch target for the goto statement. it'll be * removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(goto_node, next_node); } break; default: fprintf(stderr,"WARNING: hit default, relop .eq.\n"); break; } return; } /***************************************************************************** * * * emit_default_substring_start * * * * This handles substring operations with an unspecified starting index. * * For example, "str(:10)". The implicit starting index is 1. * * * *****************************************************************************/ void emit_default_substring_start(JVM_METHOD *meth, AST *root) { fprintf(curfp, "1"); bc_append(meth, jvm_iconst_1); } /***************************************************************************** * * * emit_default_substring_end * * * * This handles substring operations with an unspecified ending index. * * For example, "str(5:)". The implicit ending index is the last character * * of the string. * * * *****************************************************************************/ void emit_default_substring_end(JVM_METHOD *meth, AST *root) { int c; AST *tmp_parent, *tmp_node; /* For a substring operation of the form "str(5:)", here we are trying to * emit the implicit end index expression, which would be "str.length()". * The problem is that when we pass the root node to scalar_emit() to emit * the instruction to load "str" (necessary before the method can be * invoked), it can get confused since the parent node type could be * something like 'Assignment', so it's thinking that we're looking at the * LHS of an assignment and therefore it erroneously omits the load * instruction. * * To get around that, we just fudge things a bit here and duplicate the * root node, make a dummy parent node of type 'Write', and set it as the * new node's parent. */ tmp_node = clone_ident(root); tmp_parent = addnode(); tmp_parent->nodetype = Write; tmp_parent->astnode.io_stmt.arg_list = tmp_node; tmp_node->parent = tmp_parent; scalar_emit(meth, tmp_node, NULL); fprintf(curfp, ".length()"); c = bc_new_methodref(cur_class_file, JL_STRING, "length", STRLEN_DESC); bc_append(meth, jvm_invokevirtual, c); f2jfree(tmp_node, sizeof(AST)); f2jfree(tmp_parent, sizeof(AST)); } /***************************************************************************** * * * substring_expr_emit * * * * This function emits the code for a substring expression. I think this * * only handles RHS substring expressions. Use java.lang.String.substring() * * * *****************************************************************************/ void substring_expr_emit(JVM_METHOD *meth, AST *root) { int c; /* Check if this is a single character substring */ if((root->astnode.ident.startDim[0] == NULL) && (root->astnode.ident.endDim[0] == NULL) && (root->astnode.ident.startDim[1] != NULL)) { fprintf(curfp, "Util.strCharAt("); name_emit(meth, root); fprintf(curfp,","); expr_emit(meth, root->astnode.ident.startDim[1]); fprintf(curfp,")"); c = bc_new_methodref(cur_class_file, UTIL_CLASS, "strCharAt", STRCHARAT_DESC); bc_append(meth, jvm_invokestatic, c); return; } /* Substring operations are handled with java.lang.String.substring */ name_emit(meth, root); fprintf(curfp,"("); if(root->astnode.ident.startDim[0]) expr_emit(meth, root->astnode.ident.startDim[0]); else emit_default_substring_start(meth, root); fprintf(curfp,")-1,"); bc_append(meth, jvm_iconst_m1); /* decrement start idx by one */ bc_append(meth, jvm_iadd); if(root->astnode.ident.endDim[0]) expr_emit(meth, root->astnode.ident.endDim[0]); else emit_default_substring_end(meth, root); fprintf(curfp,")"); c = bc_new_methodref(cur_class_file,JL_STRING, "substring", SUBSTR_DESC); bc_append(meth, jvm_invokevirtual, c); return; } /***************************************************************************** * * * open_output_file * * * * This function attempts to open the output file and write the * * header. * * * *****************************************************************************/ void open_output_file(AST *root, char *classname) { char * filename; char import_stmt[60]; filename = (char *) f2jalloc(strlen(cur_filename) + 6); strcpy(filename, cur_filename); strcat(filename,".java"); #ifdef _WIN32 filename = char_substitution(filename, '/', '\\'); #endif if(gendebug) printf("filename is %s\n",filename); if(gendebug) printf("## going to open file: '%s'\n", filename); if((javafp = bc_fopen_fullpath(filename,"w", output_dir))==NULL) { fprintf(stderr,"Cannot open output file '%s'.\n",filename); perror("Reason"); exit(EXIT_FAILURE); } curfp = javafp; /* set global pointer to output file */ /* add import statements if necessary */ import_stmt[0] = '\0'; if(import_reflection) strcat(import_stmt,"import java.lang.reflect.*;\n"); javaheader(javafp,import_stmt); if(genJavadoc) emit_javadoc_comments(root); if(strictFp) fprintf(javafp,"public strictfp class %s {\n\n", classname); else fprintf(javafp,"public class %s {\n\n", classname); f2jfree(filename, strlen(cur_filename) + 6); } /***************************************************************************** * * * constructor * * * * This function generates the method header for the current * * function or subroutine. * * * *****************************************************************************/ void constructor (AST * root) { enum returntype returns; AST *tempnode; char *tempstring; HASHNODE *hashtemp; if (root->nodetype == Function) { char *name; returns = root->astnode.source.returns; name = root->astnode.source.name->astnode.ident.name; /* Define the constructor for the class. */ fprintf (curfp, "\npublic static %s %s (", returnstring[returns], name); if(genInterfaces) emit_interface(root); } /* Else we have a subroutine, which returns void. */ else if(root->nodetype == Subroutine) { fprintf (curfp, "\npublic static void %s (", root->astnode.source.name->astnode.ident.name); if(genInterfaces) emit_interface(root); } else /* Else we have a program, create a main() function */ { fprintf (curfp, "\npublic static void main (String [] args"); } /* * Now traverse the list of constructor arguments for either * functions or subroutines. This is where I will * have to check what the variable type is in the * symbol table. */ tempnode = root->astnode.source.args; for (; tempnode != NULL; tempnode = tempnode->nextstmt) { hashtemp = type_lookup (cur_type_table, tempnode->astnode.ident.name); if (hashtemp == NULL) { if( type_lookup (cur_external_table, tempnode->astnode.ident.name) ) { fprintf (curfp, "Object %s", tempnode->astnode.ident.name); if (tempnode->nextstmt) fprintf (curfp, ",\n"); continue; } else { fprintf (stderr,"Type table is screwed (codegen.c).\n"); fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name); exit(EXIT_FAILURE); } } /* If this variable is declared external and it is an argument to * this program unit, it must be declared as Object in Java. */ if(type_lookup(cur_external_table, tempnode->astnode.ident.name) != NULL) returns = OBJECT_TYPE; else{ returns = hashtemp->variable->vartype; } /* * Check the numerical value returns. It should not * exceed the value of the enum returntypes. */ if (returns > MAX_RETURNS) fprintf (stderr,"Bad return value, check types.\n"); if(omitWrappers) { if((hashtemp->variable->astnode.ident.arraylist == NULL) && cgPassByRef(tempnode->astnode.ident.name)) tempstring = wrapper_returns[returns]; else tempstring = returnstring[returns]; } else { if (hashtemp->variable->astnode.ident.arraylist == NULL) tempstring = wrapper_returns[returns]; else tempstring = returnstring[returns]; } /* * I haven't yet decided how the pass-by-reference * pass-by-value problem will be resolved. It may * not be an issue at all in a java calling java * situation. The next line, when used, will list * all the arguments to the method as references. * This means that primitives such as int and * double are wrapped as objects. * * *tempstring = toupper (*tempstring); * * To save storage space, I'm wrapping the primitives with * special-purpose wrappers (intW, doubleW, etc.). * 10/8/97 --Keith */ fprintf (curfp, "%s ", tempstring); if (hashtemp->variable->astnode.ident.arraylist == NULL) fprintf (curfp, "%s", tempnode->astnode.ident.name); else { /* Declare as array variables. */ char *temp2; fprintf (curfp, "[]"); fprintf (curfp, " %s", tempnode->astnode.ident.name); /* * for arrays, add a parameter representing the base * index. -- Keith */ temp2 = (char *)f2jalloc(strlen(tempnode->astnode.ident.name) + 9); strcpy( temp2, "_"); strcat( temp2, tempnode->astnode.ident.name); strcat( temp2, "_offset"); fprintf(curfp, ", int %s",temp2); f2jfree(temp2, strlen(temp2)+1); } /* Don't emit a comma on the last iteration. */ if (tempnode->nextstmt) fprintf (curfp, ",\n"); } fprintf (curfp, ") {\n\n"); } /* Close constructor(). */ /***************************************************************************** * * * emit_interface * * * * This function generates a simplified interface to the underlying * * numerical routine. This simplification includes: * * . accepting Java row-major 2D arrays * * . omitting leading dimension parameters * * . omitting offset parameters * * The interface will have the same name as the numerical routine, but * * it will be in all caps. * * * *****************************************************************************/ void emit_interface(AST *root) { enum returntype returns; AST *tempnode, *prev; char *tempstring; HASHNODE *hashtemp; FILE *intfp; char *intfilename; char *classname; Dlist decs, rest, tmp; int i; /* BOOL skipped; */ decs = make_dl(); rest = make_dl(); classname = strdup(root->astnode.source.name->astnode.ident.name); uppercase(classname); tempstring = bc_get_full_classname(classname, package_name); intfilename = f2jalloc( strlen(tempstring) + 6 ); strcpy(intfilename, tempstring); strcat(intfilename,".java"); intfp = bc_fopen_fullpath(intfilename,"w", output_dir); if(!intfp) { perror("Unable to open file"); exit(EXIT_FAILURE); } javaheader(intfp, ""); if(genJavadoc) { fprintf(intfp,"/**\n"); fprintf(intfp,"*
\n");
    fprintf(intfp,"*%s is a simplified interface to the JLAPACK",
        classname);
    fprintf(intfp," routine %s.\n",
        root->astnode.source.name->astnode.ident.name);
    fprintf(intfp,"*This interface converts Java-style 2D row-major arrays");
    fprintf(intfp," into\n*the 1D column-major linearized arrays expected by");
    fprintf(intfp," the lower\n*level JLAPACK routines.  Using this interface");
    fprintf(intfp," also allows you\n*to omit offset and leading dimension");
    fprintf(intfp," arguments.  However, because\n*of these conversions,");
    fprintf(intfp," these routines will be slower than the low\n*level ones.");
    fprintf(intfp,"  Following is the description from the original ");
    fprintf(intfp,"Fortran\n*source.  Contact ");
    fprintf(intfp,"");
    fprintf(intfp,"seymour@cs.utk.edu with any questions.\n");
    fprintf(intfp,"*

\n"); tempnode = root->astnode.source.javadocComments; while( (tempnode != NULL) && (tempnode->nodetype == MainComment || tempnode->nodetype == Comment)) { fprintf(intfp,"* %s",tempnode->astnode.ident.name); tempnode = tempnode->nextstmt; } fprintf(intfp,"*

\n"); fprintf(intfp,"**/\n"); } fprintf(intfp,"public class %s {\n\n", classname); if (root->nodetype == Function) fprintf (intfp, "\npublic static %s %s (", returnstring[root->astnode.source.returns], classname); else if(root->nodetype == Subroutine) fprintf (intfp, "\npublic static void %s (", classname); else fprintf (stderr, "emit_interface called with bad nodetype."); prev = NULL; tempnode = root->astnode.source.args; for (; tempnode != NULL; tempnode = tempnode->nextstmt) { /* skipped = FALSE; */ hashtemp = type_lookup (cur_type_table, tempnode->astnode.ident.name); if (hashtemp == NULL) { fprintf (stderr,"Type table is screwed (codegen.c).\n"); fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name); exit(EXIT_FAILURE); } if(type_lookup(cur_external_table, tempnode->astnode.ident.name) != NULL) returns = OBJECT_TYPE; else returns = hashtemp->variable->vartype; /* * Check the numerical value returns. It should not * exceed the value of the enum returntypes. */ if (returns > MAX_RETURNS) fprintf (stderr,"Bad return value, check types.\n"); if(omitWrappers) { if((hashtemp->variable->astnode.ident.arraylist == NULL) && cgPassByRef(tempnode->astnode.ident.name)) tempstring = wrapper_returns[returns]; else tempstring = returnstring[returns]; } else { if (hashtemp->variable->astnode.ident.arraylist == NULL) tempstring = wrapper_returns[returns]; else tempstring = returnstring[returns]; } if (hashtemp->variable->astnode.ident.arraylist == NULL) { if((prev != NULL) && (prev->astnode.ident.dim > 1) && !strcmp(tempnode->astnode.ident.name,prev->astnode.ident.leaddim)) { /* skipped = TRUE; */ } else { if(prev != NULL) fprintf (intfp, ",\n"); fprintf (intfp, "%s %s", tempstring, tempnode->astnode.ident.name); } } else { char *decstr; if(prev != NULL) fprintf (intfp, ",\n"); /* allocate enough room for: */ /* */ /* the data type ('double' etc.) strlen(tempstring) */ /* plus a space 1 */ /* two for the brackets: "[]" 2 */ /* plus a space 1 */ /* one for the leading "_" 1 */ /* plus the var name strlen(name) */ /* five for the "_copy" 5 */ /* plus a space 1 */ /* the equals sign 1 */ /* plus a space 1 */ /* plus the "TwoDtoOneD" call 28 */ /* open paren 1 */ /* argument name strlen(name) */ /* close paren 1 */ /* semicolon 1 */ /* NULL termination 1 */ /* ---------------------------------------------------------------- */ /* Total 45 + (2 * strlen(name)) + strlen(tempstring) */ if(hashtemp->variable->astnode.ident.dim > 1) { decstr = (char *) f2jalloc(45 + (2 * strlen(tempnode->astnode.ident.name)) + strlen(tempstring)); sprintf(decstr,"%s [] _%s_copy = MatConv.%sTwoDtoOneD(%s);", tempstring, tempnode->astnode.ident.name, returnstring[returns], tempnode->astnode.ident.name); dl_insert_b(decs, (void *) strdup(decstr)); /* decstr should already have enough storage for the * following string. */ sprintf(decstr,"MatConv.copyOneDintoTwoD(%s,_%s_copy);", tempnode->astnode.ident.name, tempnode->astnode.ident.name); dl_insert_b(rest, (void *) strdup(decstr)); } if(hashtemp->variable->astnode.ident.dim > 2) fprintf(stderr, "Cant correctly generate interface with array over 2 dimensions\n"); fprintf (intfp, "%s ", tempstring); for(i = 0; i < hashtemp->variable->astnode.ident.dim; i++ ) fprintf(intfp,"[]"); fprintf(intfp, " %s", tempnode->astnode.ident.name); if(!noOffset && (hashtemp->variable->astnode.ident.dim == 1)) { char * temp2 = (char *) f2jalloc( strlen(tempnode->astnode.ident.name) + 9); strcpy( temp2, "_"); strcat( temp2, tempnode->astnode.ident.name); strcat( temp2, "_offset"); fprintf(intfp, ", int %s",temp2); } } prev = hashtemp->variable; } fprintf (intfp, ") {\n\n"); if (root->nodetype == Function) fprintf (intfp, "\n%s _retval;\n", returnstring[root->astnode.source.returns]); /* Emit all the 2D -> 1D conversion method calls */ dl_traverse (tmp, decs) fprintf(intfp,"%s\n", (char *) dl_val(tmp)); emit_methcall(intfp,root); /* Now emit all the 1D -> 2D conversion method calls */ dl_traverse (tmp, rest) fprintf(intfp,"%s\n", (char *) dl_val(tmp)); if (root->nodetype == Function) fprintf (intfp, "\nreturn _retval;\n"); fprintf (intfp, "}\n"); fprintf (intfp, "}\n"); fclose(intfp); } /***************************************************************************** * * * emit_methcall * * * * This routine generates the call to a 'raw' numerical routine. * * Normally this is written to the file containing the simplified * * interface for that routine. * * * *****************************************************************************/ void emit_methcall(FILE *intfp, AST *root) { AST *tempnode, *prev; char *tempstring; HASHNODE *hashtemp; /* BOOL skipped; */ if (root->nodetype == Function) fprintf (intfp, "_retval = "); tempstring = strdup(root->astnode.source.name->astnode.ident.name); *tempstring = toupper(*tempstring); fprintf(intfp,"%s.%s( ", tempstring, root->astnode.source.name->astnode.ident.name); prev = NULL; tempnode = root->astnode.source.args; /* for each argument */ for (; tempnode != NULL; tempnode = tempnode->nextstmt) { /* skipped = FALSE; */ hashtemp = type_lookup (cur_type_table, tempnode->astnode.ident.name); if (hashtemp == NULL) { fprintf (stderr,"Type table is screwed (codegen.c).\n"); fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name); exit(EXIT_FAILURE); } if (hashtemp->variable->astnode.ident.arraylist == NULL) { if((prev != NULL) && (prev->astnode.ident.dim > 1) && !strcmp(tempnode->astnode.ident.name,prev->astnode.ident.leaddim)) { /* If this arg follows a 2D array, pass the array's .length as the * leading dimension to the numerical routine. */ /* skipped = TRUE; */ fprintf(intfp, "%s.length" , prev->astnode.ident.name); } else { fprintf (intfp, "%s", tempnode->astnode.ident.name); } } else { if(hashtemp->variable->astnode.ident.dim > 2) fprintf(stderr, "Cant correctly generate interface with array over 2 dimensions\n"); if(hashtemp->variable->astnode.ident.dim == 1) fprintf(intfp, " %s", tempnode->astnode.ident.name); else if(hashtemp->variable->astnode.ident.dim == 2) fprintf(intfp, " _%s_copy", tempnode->astnode.ident.name); if(!noOffset && (hashtemp->variable->astnode.ident.dim == 1)) { char * temp2 = (char *) f2jalloc( strlen(tempnode->astnode.ident.name) + 9); strcpy( temp2, "_"); strcat( temp2, tempnode->astnode.ident.name); strcat( temp2, "_offset"); fprintf(intfp, ", %s",temp2); } else fprintf(intfp, ", 0"); } prev = hashtemp->variable; /* Don't emit a comma on the last iteration. */ if(tempnode->nextstmt) fprintf (intfp, ", "); } fprintf (intfp, ");\n\n"); } /***************************************************************************** * * * forloop_emit * * * * This function generates code to implement the fortran DO loop. * * naturally, we use Java's 'for' loop for this purpose. * * * * We also keep track of the nesting of for loops so that if we * * encounter a goto statement within a loop, we can generate a * * java 'break' or 'continue' statement. * * * * We should change the generation of for loops to match the Fortran77 * * spec. For instance, the spec calls for computing the number of * * iterations before the loop with the following formula: * * MAX( INT( (stop - start + increment)/increment), 0) * * that would simplify the code in this routine a lot. kgs 4/4/00 * * * *****************************************************************************/ void forloop_emit (JVM_METHOD *meth, AST * root) { char *indexname; forloop_bytecode_emit(meth, root); /* push this do loop's AST node on the stack */ dl_insert_b(doloop, root); set_bytecode_status(meth, JAVA_ONLY); /* * Some point I will need to test whether this is really a name * because it will crash if not. */ indexname = root->astnode.forloop.start->astnode.assignment.lhs->astnode.ident.name; fprintf(curfp, "{\n"); if(root->astnode.forloop.incr != NULL) { fprintf(curfp,"int _%s_inc = ", indexname); expr_emit (meth, root->astnode.forloop.incr); fprintf(curfp, ";\n"); } /* print out a label for this for loop */ /* commented out the forloop label since it is not used anymore. * see the comment in goto_emit(). --keith * * fprintf(curfp, "forloop%s:\n", * root->astnode.forloop.Label->astnode.constant.number); */ /* This block writes out the loop parameters. */ fprintf (curfp, "for ("); assign_emit (meth, root->astnode.forloop.start); fprintf(curfp, "; "); if(root->astnode.forloop.incr == NULL) { name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); fprintf(curfp, " <= "); if(gendebug)printf("forloop stop\n"); expr_emit (meth, root->astnode.forloop.stop); fprintf (curfp, "; "); name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); fprintf (curfp, "++"); } else { /* if there is an increment the code should use >= if the * increment is negative and <= if the increment is positive. * If we determine that the increment is a constant, then * we can simplify the code a little by generating the correct * operator now. */ if(root->astnode.forloop.incr->nodetype == Constant) { int increment=atoi(root->astnode.forloop.incr->astnode.constant.number); name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); if(increment > 0) fprintf(curfp," <= "); else if(increment < 0) fprintf(curfp," >= "); else { fprintf(stderr,"WARNING: Zero increment in do loop\n"); fprintf(curfp," /* ERR:zero increment..next op incorrect */ <= "); } if(gendebug)printf("forloop stop\n"); expr_emit (meth, root->astnode.forloop.stop); fprintf (curfp, "; "); name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); fprintf (curfp, " += _%s_inc",indexname); } else { fprintf(curfp,"(_%s_inc < 0) ? ",indexname); name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); fprintf(curfp," >= "); if(gendebug)printf("forloop stop\n"); expr_emit (meth, root->astnode.forloop.stop); fprintf(curfp," : "); name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); fprintf(curfp," <= "); expr_emit (meth, root->astnode.forloop.stop); fprintf (curfp, "; "); name_emit(meth, root->astnode.forloop.start->astnode.assignment.lhs); fprintf (curfp, " += _%s_inc",indexname); } } fprintf (curfp, ") {\n"); set_bytecode_status(meth, JAVA_AND_JVM); /* Done with loop parameters. */ } /***************************************************************************** * * * forloop_bytecode_emit * * * * this function emits the bytecode to begin a for loop. here we only * * generate the initial code that comes before the body of the loop: * * - initialization of loop variable * * - calculation of increment count * * - goto (branch to end of loop to test for loop completion) * * * *****************************************************************************/ void forloop_bytecode_emit(JVM_METHOD *meth, AST *root) { set_bytecode_status(meth, JVM_ONLY); /* emit the initialization assignment for the loop variable */ assign_emit(meth, root->astnode.forloop.start); /* now emit the expression to calculate the number of * iterations that this loop should make and store the result * into the next available local variable. */ expr_emit(meth, root->astnode.forloop.iter_expr); root->astnode.forloop.localvar = bc_get_next_local(meth, jvm_Int); bc_gen_store_op(meth, root->astnode.forloop.localvar, jvm_Int); /* goto the end of the loop where we test for completion */ root->astnode.forloop.goto_node = bc_append(meth, jvm_goto); set_bytecode_status(meth, JAVA_AND_JVM); } /***************************************************************************** * * * goto_emit * * * * Since gotos aren't supported by java, we can't just emit a goto here. * * labeled continues and breaks are supported in java, but only in certain * * cases. so, if we are within a loop, and we are trying to goto the * * CONTINUE statement of an enclosing loop, then we can just emit a labeled * * continue statement. --Keith * * * * I think I fixed a previous problem emitting gotos within nested * * simulated while loops by keeping track of all if statements rather than * * just the ones identified as while statements. 10/3/97 -- Keith * * * *****************************************************************************/ void goto_emit (JVM_METHOD *meth, AST * root) { JVM_CODE_GRAPH_NODE *goto_node; /* for bytecode, maintain a list of the gotos so that we can come back * later and resolve the branch targets. */ goto_node = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node, root->astnode.go_to.label); if(gendebug) printf("## setting branch_label of this node to %d\n", root->astnode.go_to.label); if(label_search(doloop, root->astnode.go_to.label) != NULL) { /* * we are inside a do loop and we are looking at a goto * statement to the 'continue' statement of an enclosing loop. * what we want to do here is just emit a 'labeled continue' */ /* * fprintf(curfp,"continue forloop%d;\n",root->astnode.go_to.label); */ /* well... in order to allow the continuation statement of the DO loop * to be any arbitrary statement, we cannot translate this to a labeled * continue because the statement must be executed before continuing * the loop (and JAva's continue statement will not do that for us). */ fprintf(curfp,"Dummy.go_to(\"%s\",%d);\n",cur_filename, root->astnode.go_to.label); } else if((!dl_empty(while_list)) && (dl_int_examine(while_list) == root->astnode.go_to.label )) { /* * we are inside a simulated while loop and we are looking at * a goto statement to the 'beginning' statement of the most * enclosing if statment. Since we are translating this to an * actual while loop, we ignore this goto statement */ fprintf(curfp,"// goto %d (end while)\n",root->astnode.go_to.label); } else { /* * otherwise, not quite sure what to do with this one, so * we'll just emit a dummy goto */ fprintf(curfp,"Dummy.go_to(\"%s\",%d);\n",cur_filename, root->astnode.go_to.label); } } /***************************************************************************** * * * computed_goto_emit * * * * This function generates code to implement fortran's computed * * GOTO statement. we simply use a series of if-else statements * * to implement the computed goto. * * * *****************************************************************************/ void computed_goto_emit(JVM_METHOD *meth, AST *root) { JVM_CODE_GRAPH_NODE *if_node, *goto_node; AST *temp; unsigned int lvar, count = 1; lvar = bc_get_next_local(meth, jvm_Int); fprintf(curfp,"{\n"); fprintf(curfp," int _cg_tmp = "); if(root->astnode.computed_goto.name->vartype != Integer) { fprintf(curfp,"(int)( "); expr_emit(meth, root->astnode.computed_goto.name); bc_append(meth, typeconv_matrix[root->astnode.computed_goto.name->vartype] [Integer]); fprintf(curfp,")"); } else expr_emit(meth, root->astnode.computed_goto.name); bc_gen_store_op(meth, lvar, jvm_Int); fprintf(curfp,";\n"); for(temp=root->astnode.computed_goto.intlist;temp!=NULL;temp=temp->nextstmt) { if(temp != root->astnode.computed_goto.intlist) fprintf(curfp,"else "); fprintf(curfp,"if (_cg_tmp == %d) \n", count); fprintf(curfp," Dummy.go_to(\"%s\",%s);\n", cur_filename, temp->astnode.constant.number); bc_gen_load_op(meth, lvar, jvm_Int); bc_push_int_const(meth, count); if_node = bc_append(meth, jvm_if_icmpne); goto_node = bc_append(meth, jvm_goto); bc_set_branch_label(goto_node, temp->astnode.constant.number); bc_set_branch_target(if_node, bc_append(meth, jvm_xxxunusedxxx)); count++; } fprintf(curfp,"}\n"); bc_release_local(meth, jvm_Int); } /***************************************************************************** * * * assigned_goto_emit * * * * This function generates code to implement fortran's assigned * * GOTO statement. we simply use a series of if-else statements * * to implement the assigned goto. * * * *****************************************************************************/ void assigned_goto_emit(JVM_METHOD *meth, AST *root) { JVM_CODE_GRAPH_NODE *if_node, *goto_node; AST *temp; unsigned int lvar; int i, count; char **labels; Dlist tmp; count = 0; /* if this assigned goto has an integer list of possible targets, e.g.: * GOTO x (10, 20, 30) * then root->astnode.computed_goto.intlist should be non-null and will * contain a list of AST nodes. * * if there is no list of targets, e.g.: * GOTO x * then we fall back on the list of all possible targets created during * parsing. * * Since these lists are stored in different data structures, we will * just convert them to an array of strings here so that we can just * write one loop to do the code generation. */ if(root->astnode.computed_goto.intlist) { for(temp=root->astnode.computed_goto.intlist;temp!=NULL;temp=temp->nextstmt) count++; } else { dl_traverse (tmp, cur_assign_list) count++; } if(count == 0) { fprintf(stderr, "Warning: didn't expect empty list of statement labels\n"); return; } labels = (char **) f2jalloc(count * sizeof(char *)); i = 0; if(root->astnode.computed_goto.intlist) { for(temp=root->astnode.computed_goto.intlist;temp!=NULL;temp=temp->nextstmt) labels[i++] = temp->astnode.constant.number; } else { dl_traverse (tmp, cur_assign_list) labels[i++] = ((AST *)dl_val(tmp))->astnode.constant.number; } /* Now the array of integer targets has been built. */ lvar = bc_get_next_local(meth, jvm_Int); fprintf(curfp,"{\n"); fprintf(curfp," int _cg_tmp = "); expr_emit(meth, root->astnode.computed_goto.name); bc_gen_store_op(meth, lvar, jvm_Int); fprintf(curfp,";\n"); for(i=0;iastnode.logicalif.conds != NULL) expr_emit (meth, root->astnode.logicalif.conds); if_node = bc_append(meth, jvm_ifeq); fprintf (curfp, ") {\n "); emit (root->astnode.logicalif.stmts); fprintf (curfp, "}\n "); /* create a dummy instruction node following the stmts so that * we have a branch target for the goto statement. it'll be * removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(if_node, next_node); } /***************************************************************************** * * * arithmeticif_emit * * * * This function generates code for arithmetic IF statements. * * * *****************************************************************************/ void arithmeticif_emit (JVM_METHOD *meth, AST * root) { JVM_CODE_GRAPH_NODE *if_node, *goto_node; unsigned int lvar; lvar = bc_get_next_local(meth, jvm_data_types[root->astnode.arithmeticif.cond->vartype]); fprintf (curfp, "{\n"); fprintf (curfp, " %s _arif_tmp = ", returnstring[root->astnode.arithmeticif.cond->vartype]); expr_emit(meth, root->astnode.arithmeticif.cond); bc_gen_store_op(meth, lvar, jvm_data_types[root->astnode.arithmeticif.cond->vartype]); fprintf (curfp, ";\n"); fprintf (curfp, "if (_arif_tmp < 0) \n "); fprintf(curfp," Dummy.go_to(\"%s\",%d);\n", cur_filename, root->astnode.arithmeticif.neg_label); fprintf (curfp, "else if (_arif_tmp == 0) \n "); fprintf(curfp," Dummy.go_to(\"%s\",%d);\n", cur_filename, root->astnode.arithmeticif.zero_label); fprintf (curfp, "else "); fprintf(curfp," Dummy.go_to(\"%s\",%d);\n", cur_filename, root->astnode.arithmeticif.pos_label); fprintf (curfp, "}\n"); /* arithmetic ifs may have an integer,real,or double expression. * since the conditionals are handled differently for integer, * we split the cases into integer and non-integer. */ if(root->astnode.arithmeticif.cond->vartype == Integer) { bc_gen_load_op(meth, lvar, jvm_Int); if_node = bc_append(meth, jvm_ifge); goto_node = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node, root->astnode.arithmeticif.neg_label); bc_set_branch_target(if_node, bc_gen_load_op(meth, lvar, jvm_Int)); } else { bc_gen_load_op(meth, lvar, jvm_data_types[root->astnode.arithmeticif.cond->vartype]); bc_append(meth, init_opcodes[root->astnode.arithmeticif.cond->vartype]); bc_append(meth, cmpg_opcode[root->astnode.arithmeticif.cond->vartype]); if_node = bc_append(meth, jvm_ifge); goto_node = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node, root->astnode.arithmeticif.neg_label); bc_set_branch_target(if_node, bc_gen_load_op(meth, lvar, jvm_data_types[root->astnode.arithmeticif.cond->vartype])); bc_append(meth, init_opcodes[root->astnode.arithmeticif.cond->vartype]); bc_append(meth, cmpg_opcode[root->astnode.arithmeticif.cond->vartype]); } if_node = bc_append(meth, jvm_ifne); goto_node = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node,root->astnode.arithmeticif.zero_label); goto_node = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node, root->astnode.arithmeticif.pos_label); bc_set_branch_target(if_node, goto_node); bc_release_local(meth, jvm_data_types[root->astnode.arithmeticif.cond->vartype]); } /***************************************************************************** * * * label_emit * * * * This function generates labels. We generate both a java label * * and a call to the Dummy.label() method for goto translation. * * * *****************************************************************************/ void label_emit (JVM_METHOD *meth, AST * root) { AST *loop; int num; num = root->astnode.label.number; if(gendebug) printf("looking at label %d\n", num); root->astnode.label.instr = bc_append(meth, jvm_xxxunusedxxx); /* if this continue statement corresponds with the most * recent DO loop, then this is the end of the loop - pop * the label off the doloop list. */ loop = dl_astnode_examine(doloop); if((loop != NULL) && (atoi(loop->astnode.forloop.Label->astnode.constant.number) == num)) { do { /* * finally pop this loop's label number off the stack and * emit the label (for experimental goto resolution) */ fprintf(curfp,"Dummy.label(\"%s\",%d);\n",cur_filename,num); dl_pop(doloop); if((root->astnode.label.stmt != NULL) && (root->astnode.label.stmt->nodetype != Format)) emit (root->astnode.label.stmt); fprintf(curfp, "} // Close for() loop. \n"); fprintf(curfp, "}\n"); forloop_end_bytecode(meth, loop); loop = dl_astnode_examine(doloop); } while((loop != NULL) && (atoi(loop->astnode.forloop.Label->astnode.constant.number) == num)); } else { /* this labeled statement is not associated with a DO loop */ fprintf (curfp, "label%d:\n ", num); fprintf(curfp,"Dummy.label(\"%s\",%d);\n",cur_filename, num); if((root->astnode.label.stmt != NULL) && (root->astnode.label.stmt->nodetype != Format)) { emit (root->astnode.label.stmt); } } bc_associate_integer_branch_label(meth, root->astnode.label.instr, root->astnode.label.number); } /***************************************************************************** * * * forloop_end_bytecode * * * * bytecode-only generation of the final components of a DO loop: * * - increment loop variable * * - decrement and check the iteration count * * * *****************************************************************************/ void forloop_end_bytecode(JVM_METHOD *meth, AST *root) { JVM_CODE_GRAPH_NODE *if_node, *iload_node; unsigned int icount; icount = root->astnode.forloop.localvar; set_bytecode_status(meth, JVM_ONLY); /* increment loop variable */ assign_emit(meth, root->astnode.forloop.incr_expr); /* decrement iteration count */ bc_gen_iinc(meth, icount, -1); iload_node = bc_gen_load_op(meth, icount, jvm_Int); bc_set_branch_target(root->astnode.forloop.goto_node, iload_node); if_node = bc_append(meth, jvm_ifgt); bc_set_branch_target(if_node, bc_get_next_instr(root->astnode.forloop.goto_node)); bc_release_local(meth, jvm_Int); set_bytecode_status(meth, JAVA_AND_JVM); } /***************************************************************************** * * * read_emit * * * * Emit a READ statement. Calls formatted_read_emit() or * * unformatted_read_emit(), depending on whether there is a * * corresponding FORMAT statement. * * * *****************************************************************************/ void read_emit (JVM_METHOD *meth, AST * root) { char *fmt_str, tmp[100]; HASHNODE *hnode; /* look for a format statement */ sprintf(tmp,"%d", root->astnode.io_stmt.format_num); if(gendebug) printf("***Looking for format statement number: %s\n",tmp); hnode = format_lookup(cur_format_table,tmp); if(hnode) fmt_str = format2str(hnode->variable->astnode.label.stmt); else if(root->astnode.io_stmt.fmt_list != NULL) fmt_str = strdup(root->astnode.io_stmt.fmt_list->astnode.constant.number); else fmt_str = NULL; if(fmt_str) formatted_read_emit(meth, root, fmt_str); else unformatted_read_emit(meth, root); } /***************************************************************************** * * * unformatted_read_emit * * * * This function generates unformatted READ statements. We generate calls * * to a Java class called EasyIn to perform the I/O. Also emit a try-catch * * to trap IOExceptions. * * * *****************************************************************************/ void unformatted_read_emit(JVM_METHOD *meth, AST * root) { JVM_CODE_GRAPH_NODE *goto_node1, *goto_node2, *try_start, *pop_node; JVM_EXCEPTION_TABLE_ENTRY *et_entry; AST *assign_temp; AST *temp; int c; try_start = NULL; /* if the READ statement has no args, just read a line and * ignore it. */ if(root->astnode.io_stmt.arg_list == NULL) { fprintf(curfp,"%s.readString(); // skip a line\n", F2J_STDIN); bc_gen_load_op(meth, stdin_lvar, jvm_Object); c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "readString", "()Ljava/lang/String;"); bc_append(meth, jvm_invokevirtual, c); return; } /* if the READ statement includes an END label, then we * use a try block to determine EOF. the catch block, emitted * below, just contains the GOTO. */ if(root->astnode.io_stmt.end_num > 0 ) { fprintf(curfp,"try {\n"); funcname = input_func_eof; try_start = bc_append(meth, jvm_xxxunusedxxx); } else funcname = input_func; assign_temp = addnode(); assign_temp->nodetype = Assignment; for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) { if(temp->nodetype == IoImpliedLoop) implied_loop_emit(meth, temp, read_implied_loop_bytecode_emit, read_implied_loop_sourcecode_emit); else if(temp->nodetype == Identifier) { temp->parent = assign_temp; assign_temp->astnode.assignment.lhs = temp; name_emit(meth, assign_temp->astnode.assignment.lhs); bc_gen_load_op(meth, stdin_lvar, jvm_Object); if( (temp->vartype == Character) || (temp->vartype == String) ) { int len; len = temp->astnode.ident.len < 0 ? 1 : temp->astnode.ident.len; fprintf(curfp," = %s.%s(%d);\n", F2J_STDIN, funcname[temp->vartype], len); bc_push_int_const(meth, len); } else { fprintf(curfp," = %s.%s();\n", F2J_STDIN, funcname[temp->vartype]); } c = bc_new_methodref(cur_class_file, EASYIN_CLASS, funcname[temp->vartype], input_descriptors[temp->vartype]); bc_append(meth, jvm_invokevirtual, c); LHS_bytecode_emit(meth, assign_temp); } else { fprintf(stderr,"Read list must consist of idents or implied loops\n"); fprintf(stderr," nodetype is %s\n", print_nodetype(temp)); continue; } } free_ast_node(assign_temp); fprintf(curfp,"%s.skipRemaining();\n", F2J_STDIN); bc_gen_load_op(meth, stdin_lvar, jvm_Object); c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "skipRemaining", "()V"); bc_append(meth, jvm_invokevirtual, c); /* Emit the catch block for when we hit EOF. We only care if * the READ statement has an END label. */ if(root->astnode.io_stmt.end_num > 0) { fprintf(curfp,"} catch (java.io.IOException e) {\n"); fprintf(curfp,"Dummy.go_to(\"%s\",%d);\n",cur_filename, root->astnode.io_stmt.end_num); fprintf(curfp,"}\n"); goto_node1 = bc_append(meth, jvm_goto); /* skip the exception handler */ /* following is the exception handler for IOException. this * implements Fortrans END specifier (eg READ(*,*,END=100)). * the exception handler just consists of a pop to get the stack * back to normal and a goto to branch to the label specified * in the END spec. */ pop_node = bc_append(meth, jvm_pop); /* artificially set stack depth at beginning of exception * handler to 1. */ bc_set_stack_depth(pop_node, 1); goto_node2 = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node2, root->astnode.io_stmt.end_num); bc_set_branch_target(goto_node1, bc_append(meth, jvm_xxxunusedxxx)); et_entry = (JVM_EXCEPTION_TABLE_ENTRY *) f2jalloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY)); et_entry->from = try_start; et_entry->to = pop_node; et_entry->target = pop_node; c = cp_find_or_insert(cur_class_file,CONSTANT_Class, IOEXCEPTION); et_entry->catch_type = c; bc_add_exception_handler(meth, et_entry); } } /***************************************************************************** * * * formatted_read_assign_emit * * * * Emits the assignment statement of an implied loop in a READ statement. * * If emit_source is TRUE, emits both bytecode and source code. * * * *****************************************************************************/ void formatted_read_assign_emit(JVM_METHOD *meth, AST *temp, int emit_source, int idx) { AST *assign_temp, *idx_temp = NULL; int c; assign_temp = addnode(); assign_temp->nodetype = Assignment; if(idx >= 0) { idx_temp = addnode(); idx_temp->token = INTEGER; idx_temp->nodetype = Constant; idx_temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); if(!idx_temp->astnode.constant.number) { fprintf(stderr, "malloc failed in formatted_read_assign_emit()\n"); exit(EXIT_FAILURE); } sprintf(idx_temp->astnode.constant.number, "%d", idx); idx_temp->vartype = Integer; idx_temp->nextstmt = NULL; temp->astnode.ident.arraylist = idx_temp; } temp->parent = assign_temp; assign_temp->astnode.assignment.lhs = temp; name_emit(meth, assign_temp->astnode.assignment.lhs); bc_gen_load_op(meth, iovec_lvar, jvm_Object); bc_append(meth, jvm_iconst_0); c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "remove", VEC_REMOVE_DESC); bc_append(meth, jvm_invokevirtual, c); if((temp->vartype == Character) || (temp->vartype == String)) { /* special case for string since we don't need to call any method * to get the value as with other primitive types (e.g. intValue, * doubleValue, etc). */ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, numeric_wrapper[temp->vartype]); bc_append(meth, jvm_checkcast, c); if(emit_source) fprintf(curfp," = (%s) %s.remove(0);\n", java_wrapper[temp->vartype], F2J_IO_VEC); } else if(temp->vartype == Logical) { /* special case for boolean since java.lang.Boolean can't be cast * to java.lang.Number. */ c = cp_find_or_insert(cur_class_file, CONSTANT_Class, numeric_wrapper[temp->vartype]); bc_append(meth, jvm_checkcast, c); if(emit_source) fprintf(curfp," = ((Boolean) %s.remove(0)).booleanValue();\n", F2J_IO_VEC); c = bc_new_methodref(cur_class_file, numeric_wrapper[temp->vartype], numericValue_method[temp->vartype], numericValue_descriptor[temp->vartype]); bc_append(meth, jvm_invokevirtual, c); } else { c = cp_find_or_insert(cur_class_file, CONSTANT_Class, JL_NUMBER); bc_append(meth, jvm_checkcast, c); if(emit_source) fprintf(curfp," = ((Number) %s.remove(0)).%s();\n", F2J_IO_VEC, numericValue_method[temp->vartype]); c = bc_new_methodref(cur_class_file, JL_NUMBER, numericValue_method[temp->vartype], numericValue_descriptor[temp->vartype]); bc_append(meth, jvm_invokevirtual, c); } LHS_bytecode_emit(meth, assign_temp); free_ast_node(assign_temp); if(idx_temp) { free_ast_node(idx_temp); temp->astnode.ident.arraylist = NULL; } } /***************************************************************************** * * * read_emit * * * * This function generates formatted READ statements. J.Paine's formatter * * is used behind the scenes. * * * *****************************************************************************/ void formatted_read_emit(JVM_METHOD *meth, AST *root, char *fmt_str) { AST *temp; int c; /* if the READ statement has no args, just read a line and * ignore it. */ if(root->astnode.io_stmt.arg_list == NULL) { fprintf(curfp,"%s.readString(); // skip a line\n", F2J_STDIN); bc_gen_load_op(meth, stdin_lvar, jvm_Object); c = bc_new_methodref(cur_class_file, EASYIN_CLASS, "readString", "()Ljava/lang/String;"); bc_append(meth, jvm_invokevirtual, c); return; } gen_clear_io_vec(meth); bc_push_string_const(meth, fmt_str); bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = bc_new_methodref(cur_class_file, UTIL_CLASS, "f77read", F77_READ_DESC); bc_append(meth, jvm_invokestatic, c); if(root->astnode.io_stmt.end_num > 0 ) { JVM_CODE_GRAPH_NODE *if_node, *goto_node; /* the READ statement includes an END label, so we * test the return value to determine EOF. */ fprintf(curfp, "if(Util.f77read(\"%s\", %s) <= 0)\n", fmt_str, F2J_IO_VEC); fprintf(curfp," Dummy.go_to(\"%s\",%d);\n",cur_filename, root->astnode.io_stmt.end_num); if_node = bc_append(meth, jvm_ifgt); goto_node = bc_append(meth, jvm_goto); bc_set_integer_branch_label(goto_node, root->astnode.io_stmt.end_num); bc_set_branch_target(if_node, bc_append(meth, jvm_xxxunusedxxx)); } else { fprintf(curfp, "Util.f77read(\"%s\", %s);\n", fmt_str, F2J_IO_VEC); /* return value is unused, so pop it off the stack */ bc_append(meth, jvm_pop); } for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) { HASHNODE *ht; if(temp->nodetype == IoImpliedLoop) implied_loop_emit(meth, temp, formatted_read_implied_loop_bytecode_emit, formatted_read_implied_loop_sourcecode_emit); else if((temp->nodetype == Identifier) && (ht=type_lookup(cur_array_table, temp->astnode.ident.name)) && (temp->astnode.ident.arraylist == NULL)) { if(ht->variable->astnode.ident.array_len == -1) { fprintf(stderr, "Warning: passing implied size array to formatted read.\n"); fprintf(stderr, " this won't work properly.\n"); formatted_read_assign_emit(meth, temp, TRUE, -1); } else { int i; for(i=0; i < ht->variable->astnode.ident.array_len; i++) { formatted_read_assign_emit(meth, temp, TRUE, i+1); } } } else if(temp->nodetype == Identifier) formatted_read_assign_emit(meth, temp, TRUE, -1); else { fprintf(stderr,"Read list must consist of idents or implied loops\n"); fprintf(stderr," nodetype is %s\n", print_nodetype(temp)); continue; } } } /***************************************************************************** * * * formatted_read_implied_loop_bytecode_emit * * * * This function generates code for implied DO loops contained in READ * * statements including FORMAT statements. * * * *****************************************************************************/ void formatted_read_implied_loop_bytecode_emit(JVM_METHOD *meth, AST *node) { AST *iot; for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt) { if(iot->nodetype != Identifier) { fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ", unit_name,print_nodetype(iot)); fprintf(stderr," in implied loop (read stmt)\n"); } else formatted_read_assign_emit(meth, iot, FALSE, -1); } } /***************************************************************************** * * * formatted_read_implied_loop_sourcecode_emit * * * * This function generates code for implied DO loops contained in READ * * statements including FORMAT statements. * * * *****************************************************************************/ void formatted_read_implied_loop_sourcecode_emit(JVM_METHOD *meth, AST *node) { AST *iot; fprintf(curfp,"{\n"); for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt) { if(iot->nodetype != Identifier) { fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ", unit_name,print_nodetype(iot)); fprintf(stderr," in implied loop (read stmt)\n"); } else { name_emit(meth, iot); if((iot->vartype == Character) || (iot->vartype == String)) fprintf(curfp," = (%s) %s.remove(0);\n", java_wrapper[iot->vartype], F2J_IO_VEC); else if(iot->vartype == Logical) fprintf(curfp," = ((Boolean) %s.remove(0)).booleanValue();\n", F2J_IO_VEC); else fprintf(curfp," = ((Number) %s.remove(0)).%s();\n", F2J_IO_VEC, numericValue_method[iot->vartype]); } } fprintf(curfp,"}\n"); } /***************************************************************************** * * * read_implied_loop_bytecode_emit * * * * This function generates code for implied DO loops contained in READ * * statements. We dont handle any FORMAT statements. * * * *****************************************************************************/ void read_implied_loop_bytecode_emit(JVM_METHOD *meth, AST *node) { AST *assign_temp, *temp, *iot; int c; for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt) { if(iot->nodetype != Identifier) { fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ", unit_name,print_nodetype(iot)); fprintf(stderr," in implied loop (read stmt)\n"); } else { fprintf(curfp," = %s.%s();\n", F2J_STDIN, funcname[iot->vartype]); assign_temp = addnode(); assign_temp->nodetype = Assignment; temp = iot; temp->parent = assign_temp; assign_temp->astnode.assignment.lhs = temp; name_emit(meth, assign_temp->astnode.assignment.lhs); bc_gen_load_op(meth, stdin_lvar, jvm_Object); if( (temp->vartype == Character) || (temp->vartype == String) ) { if(temp->astnode.ident.len < 0) bc_push_int_const(meth, 1); else bc_push_int_const(meth, temp->astnode.ident.len); } c = bc_new_methodref(cur_class_file, EASYIN_CLASS, funcname[temp->vartype], input_descriptors[temp->vartype]); bc_append(meth, jvm_invokevirtual, c); LHS_bytecode_emit(meth, assign_temp); } } } /***************************************************************************** * * * read_implied_loop_sourcecode_emit * * * * This function generates code for implied DO loops contained in READ * * statements. We dont handle any FORMAT statements. * * * *****************************************************************************/ void read_implied_loop_sourcecode_emit(JVM_METHOD *meth, AST *node) { AST *iot; fprintf(curfp,"{\n"); for(iot = node->astnode.forloop.Label; iot != NULL; iot = iot->nextstmt) { if(iot->nodetype != Identifier) { fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ", unit_name,print_nodetype(iot)); fprintf(stderr," in implied loop (read stmt)\n"); } else { name_emit(meth, iot); fprintf(curfp," = %s.%s();\n", F2J_STDIN, funcname[iot->vartype]); } } fprintf(curfp,"}\n"); } /***************************************************************************** * * * isArrayNoIdx * * * * returns TRUE if this is an array reference which is not indexed. * * * *****************************************************************************/ BOOL isArrayNoIdx(AST *var) { return( (var->token == NAME) && (type_lookup(cur_array_table, var->astnode.ident.name) != NULL) && (var->astnode.ident.arraylist == NULL) ); } /***************************************************************************** * * * format2str * * * * Converts a list of format items to a format string. * * * *****************************************************************************/ char * format2str(AST *node) { char buf[8192], *tmpstr; AST *temp; int i, j; buf[0] = 0; for(temp = node; temp; temp=temp->nextstmt) { switch(temp->token) { case EDIT_DESC: case NAME: strcat(buf, temp->astnode.ident.name); break; case STRING: /* escaping quotes in the string to be passed to the Formatter. * largest temp can be is 2 * len + 1 (if every char is a quote) */ tmpstr = malloc(2 * strlen(temp->astnode.constant.number) + 1); if(!tmpstr) return NULL; for(i = j = 0; i < strlen(temp->astnode.constant.number); i++) { if(temp->astnode.constant.number[i] == '\'') { tmpstr[j] = '\''; j++; tmpstr[j] = '\''; j++; } else { tmpstr[j] = temp->astnode.constant.number[i]; j++; } } tmpstr[j] = 0; strcat(buf, "'"); strcat(buf, tmpstr); strcat(buf, "'"); free(tmpstr); break; case INTEGER: strcat(buf, temp->astnode.constant.number); break; case REPEAT: tmpstr = format2str(temp->astnode.label.stmt); strcat(buf, "("); strcat(buf, tmpstr); strcat(buf, ")"); free(tmpstr); break; case CM: strcat(buf, ","); break; case DIV: strcat(buf, "/"); break; case CAT: strcat(buf, "//"); break; case COLON: strcat(buf, ":"); break; default: fprintf(stderr,"formatitem2str: Unknown token!!! %d (%s) - ", temp->token, tok2str(temp->token)); if(gendebug) printf("this node type %s\n",print_nodetype(temp)); break; } } return strdup(buf); } /***************************************************************************** * * * gen_clear_io_vec * * * * Generates code to clear the Vector used for formatted I/O calls. * * * *****************************************************************************/ void gen_clear_io_vec(JVM_METHOD *meth) { int c; fprintf(curfp, "%s.clear();\n", F2J_IO_VEC); bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "clear", "()V"); bc_append(meth, jvm_invokevirtual, c); } void write_argument_emit(JVM_METHOD *meth, AST *root) { HASHNODE *ht; int c; if((root->nodetype == Identifier) && (ht=type_lookup(cur_array_table, root->astnode.ident.name)) && (root->astnode.ident.arraylist == NULL)) { bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, ARRAY_SPEC_CLASS); bc_append(cur_method, jvm_new,c); bc_append(cur_method, jvm_dup); fprintf(curfp, " %s.addElement(new ArraySpec(", F2J_IO_VEC); if(ht->variable->astnode.ident.array_len == -1) { fprintf(stderr, "Warning: passing implied size array to formatted write\n"); fprintf(stderr, " only using first element\n"); root->parent->nodetype = Call; expr_emit(meth, root); root->parent->nodetype = Write; } else expr_emit(meth, root); fprintf(curfp, ", %d));\n", ht->variable->astnode.ident.array_len); bc_push_int_const(meth, ht->variable->astnode.ident.array_len); c = bc_new_methodref(cur_class_file, ARRAY_SPEC_CLASS, "", array_spec_descriptor[root->vartype]); bc_append(cur_method, jvm_invokespecial, c); c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "addElement", VEC_ADD_DESC); bc_append(meth, jvm_invokevirtual, c); } else { ht = type_lookup(cur_type_table, root->astnode.ident.name); if(ht && (root->vartype == String) && (root->astnode.ident.len == 1) && (root->astnode.ident.dim == 0) && (root->astnode.ident.arraylist == NULL) && (ht->variable->astnode.ident.startDim[2] != NULL)) { bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, ARRAY_SPEC_CLASS); bc_append(cur_method, jvm_new,c); bc_append(cur_method, jvm_dup); fprintf(curfp, " %s.addElement(new ArraySpec(", F2J_IO_VEC); expr_emit(meth, root); fprintf(curfp, "));\n"); c = bc_new_methodref(cur_class_file, ARRAY_SPEC_CLASS, "", "(Ljava/lang/String;)V"); } else { bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, numeric_wrapper[root->vartype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,numeric_wrapper[root->vartype], "", wrapper_descriptor[root->vartype]); fprintf(curfp, " %s.addElement(new %s(", F2J_IO_VEC, java_wrapper[root->vartype]); expr_emit(meth, root); fprintf(curfp,"));\n"); } bc_append(meth, jvm_invokespecial, c); c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "addElement", VEC_ADD_DESC); bc_append(meth, jvm_invokevirtual, c); } } /***************************************************************************** * * * write_emit * * * * This function handles WRITE statements. It is FAR from complete, * * but it is usually good enough to test the numerical routines. * * * *****************************************************************************/ void write_emit(JVM_METHOD *meth, AST * root) { char *fmt_str, tmp[100]; HASHNODE *hnode; AST *temp; int c; /* look for a format statement */ sprintf(tmp,"%d", root->astnode.io_stmt.format_num); if(gendebug) printf("***Looking for format statement number: %s\n",tmp); hnode = format_lookup(cur_format_table,tmp); if(hnode) fmt_str = format2str(hnode->variable->astnode.label.stmt); else if(root->astnode.io_stmt.fmt_list != NULL) fmt_str = strdup(root->astnode.io_stmt.fmt_list->astnode.constant.number); else fmt_str = NULL; gen_clear_io_vec(meth); for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) { if(temp->nodetype == IoImpliedLoop) { implied_loop_emit(meth, temp, write_implied_loop_bytecode_emit, write_implied_loop_sourcecode_emit); } else write_argument_emit(meth, temp); } if(fmt_str) { fprintf(curfp, "Util.f77write(\"%s\", %s);\n", fmt_str, F2J_IO_VEC); bc_push_string_const(meth, fmt_str); } else { fprintf(curfp, "Util.f77write(null, %s);\n", F2J_IO_VEC); bc_append(meth, jvm_aconst_null); } bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = bc_new_methodref(cur_class_file, UTIL_CLASS, "f77write", F77_WRITE_DESC); bc_append(meth, jvm_invokestatic, c); } /***************************************************************************** * * * implied_loop_emit * * * * This function generates code for implied DO loops in I/O statements. * * Dont worry about FORMAT statements. * * * *****************************************************************************/ void implied_loop_emit(JVM_METHOD *meth, AST *node, void loop_body_bytecode_emit(JVM_METHOD *, AST *), void loop_body_sourcecode_emit(JVM_METHOD *, AST *)) { JVM_CODE_GRAPH_NODE *if_node, *goto_node, *iload_node; AST *temp; unsigned int icount; temp = addnode(); temp->nodetype = Assignment; temp->astnode.assignment.lhs = node->astnode.forloop.counter; temp->astnode.assignment.lhs->parent = temp; temp->astnode.assignment.rhs = node->astnode.forloop.start; temp->astnode.assignment.rhs->parent = temp; set_bytecode_status(meth, JAVA_ONLY); fprintf(curfp,"for("); assign_emit(meth, temp); fprintf(curfp,"; "); expr_emit(meth, node->astnode.forloop.counter); fprintf(curfp," <= "); expr_emit(meth, node->astnode.forloop.stop); if(node->astnode.forloop.incr == NULL) { fprintf(curfp,"; "); expr_emit(meth, node->astnode.forloop.counter); fprintf(curfp,"++)\n"); } else { fprintf(curfp,"; "); expr_emit(meth, node->astnode.forloop.counter); fprintf(curfp," += "); expr_emit(meth, node->astnode.forloop.incr); fprintf(curfp,")\n"); } loop_body_sourcecode_emit(meth, node); set_bytecode_status(meth, JVM_ONLY); /* the rest of this code is only generated as bytecode. * first emit the initial assignment. */ assign_emit(meth, temp); /* now emit the expression to calculate the number of * iterations that this loop should make and store the result * into the next available local variable. */ expr_emit(meth, node->astnode.forloop.iter_expr); icount = bc_get_next_local(meth, jvm_Int); bc_gen_store_op(meth, icount, jvm_Int); /* goto the end of the loop where we test for completion */ goto_node = bc_append(meth, jvm_goto); loop_body_bytecode_emit(meth, node); /* increment loop variable */ assign_emit(meth, node->astnode.forloop.incr_expr); /* decrement iteration count */ bc_gen_iinc(meth, icount, -1); iload_node = bc_gen_load_op(meth, icount, jvm_Int); bc_set_branch_target(goto_node, iload_node); if_node = bc_append(meth, jvm_ifgt); bc_set_branch_target(if_node, bc_get_next_instr(goto_node)); bc_release_local(meth, jvm_Int); set_bytecode_status(meth, JAVA_AND_JVM); } /***************************************************************************** * * * write_implied_loop_sourcecode_emit * * * * this function emits the body of an implied loop (basically just the * * StringBuffer.append() method invocations. (Java source only) * * * *****************************************************************************/ void write_implied_loop_sourcecode_emit(JVM_METHOD *meth, AST *node) { AST *temp; fprintf(curfp,"{\n"); for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt) { if(temp->nodetype == Identifier) { write_argument_emit(meth, temp); } else if(temp->nodetype == Constant) { fprintf(curfp, " %s.addElement(new %s(", F2J_IO_VEC, java_wrapper[temp->vartype]); expr_emit(meth, temp); fprintf(curfp,"));\n"); } else { fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ", unit_name,print_nodetype(temp)); fprintf(stderr," in implied loop (write stmt). Exiting.\n"); exit(EXIT_FAILURE); } } fprintf(curfp,"}\n"); } /***************************************************************************** * * * write_implied_loop_bytecode_emit * * * * this function emits the body of an implied loop (basically just the * * StringBuffer.append() method invocations. (JVM bytecode only) * * * *****************************************************************************/ void write_implied_loop_bytecode_emit(JVM_METHOD *meth, AST *node) { AST *temp; int c; for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt) { /* emit loop body */ if(temp->nodetype == Identifier) { write_argument_emit(meth, temp); } else if(temp->nodetype == Constant) { bc_gen_load_op(meth, iovec_lvar, jvm_Object); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, numeric_wrapper[temp->vartype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,numeric_wrapper[temp->vartype], "", wrapper_descriptor[temp->vartype]); pushConst(meth, temp); bc_append(meth, jvm_invokespecial, c); c = bc_new_methodref(cur_class_file, VECTOR_CLASS, "addElement", VEC_ADD_DESC); bc_append(meth, jvm_invokevirtual, c); } else { fprintf(stderr,"unit %s:Cant handle this nodetype (%s) ", unit_name,print_nodetype(temp)); fprintf(stderr," in implied loop (write stmt). Exiting.\n"); exit(EXIT_FAILURE); } } } /***************************************************************************** * * * blockif_emit * * * * This function generates the code which implements fortran's * * block if. This could also be a simulated while loop, which * * is why we push this loop's number on the while_list. This * * way we can generate a java 'while' loop instead of the * * simulated while loop using gotos. * * * *****************************************************************************/ void blockif_emit (JVM_METHOD *meth, AST * root) { JVM_CODE_GRAPH_NODE *if_node, *next_node, *goto_node; AST *prev = root->prevstmt; int *tmp_int; Dlist gotos, lptr; AST *temp; /* in bytecode, each if-block and elseif-block must have a goto at * the end to branch to the statement following the end if. since we * cannot know the PC of that statement until we've generated all * the if-blocks, elseif-blocks, and else-block, we maintain a list * of the gotos so that we may go back and fill in the branch targets. */ gotos = make_dl(); /* first check if the if-block is NULL. if so, this cannot be a * simulated while loop because the existence of a goto would cause * the if-block to be non-null. */ if(root->astnode.blockif.stmts != NULL) { /* if the previous node was a label, this could be a simulated * while loop. */ if(prev != NULL) { if(prev->nodetype == Label) { tmp_int = (int*)f2jalloc(sizeof(int)); *tmp_int = root->prevstmt->astnode.label.number; /* push this while loop's number on the stack */ dl_insert_b(while_list, tmp_int); if(prev->astnode.label.stmt == NULL) if((root->astnode.blockif.elseifstmts == NULL) && (root->astnode.blockif.elsestmts == NULL)) { /* it appears that we are looking at a simulated while loop. * bypass all the statements in the body of this if block * and look at the last one. if it is a goto and the * target is the label of the current if statement, then * we generate a Java while loop. otherwise, we generate * an if statement. */ for ( temp=root->astnode.blockif.stmts; temp->nextstmt!=NULL; temp = temp->nextstmt ) ; /* do nothing */ if(temp->nodetype == Goto) if(temp->astnode.go_to.label == prev->astnode.label.number) { while_emit(meth, root); dl_delete_list(gotos); return; } } /* pop this while loop's label number off the stack */ tmp_int = (int *)dl_pop(while_list); f2jfree(tmp_int, sizeof(int)); } } } fprintf (curfp, "if ("); if(root->astnode.blockif.conds != NULL) expr_emit (meth, root->astnode.blockif.conds); if_node = bc_append(meth, jvm_ifeq); fprintf (curfp, ") {\n "); if(root->astnode.blockif.stmts != NULL) emit (root->astnode.blockif.stmts); fprintf (curfp, "}\n"); if(root->astnode.blockif.elseifstmts || root->astnode.blockif.elsestmts) { goto_node = bc_append(meth, jvm_goto); dl_insert_b(gotos, goto_node); /* create a dummy instruction node so that * we have a branch target for the goto statement. * it will be removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(if_node, next_node); for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt) { goto_node = elseif_emit (meth, temp); dl_insert_b(gotos, goto_node); } if(root->astnode.blockif.elsestmts != NULL) else_emit (root->astnode.blockif.elsestmts); next_node = bc_append(meth, jvm_xxxunusedxxx); dl_traverse(lptr, gotos) { goto_node = (JVM_CODE_GRAPH_NODE *) lptr->val; bc_set_branch_target(goto_node, next_node); } dl_delete_list(gotos); } else { /* Else there are no else or elseif blocks, so we do not need * any gotos to branch from the end of the blocks to the statement * following the block if. All we need to do is set the if_node * branch target to the opcode to which we should branch if the * conditional expression is false. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(if_node, next_node); } /* If the endif has a statement label, create a new Label node * and add it as the next statement. It will get emitted on the * next call to emit(). */ if(root->astnode.blockif.endif_label >= 0) { AST *newnode; newnode = addnode(); newnode->nodetype = Label; newnode->astnode.label.number = root->astnode.blockif.endif_label; newnode->astnode.label.stmt = NULL; newnode->nextstmt = root->nextstmt; root->nextstmt = newnode; } } /***************************************************************************** * * * while_emit * * * * while_emit() is called when an if statement has been identified * * as a simulated while loop, e.g.: * * * * 10 continue * * if(x < 10) then * * do something * * x = x+1 * * goto 10 * * * * this can be translated into java as: * * * * while(x<10) { * * do something * * x = x+1 * * } * * * * that gives us one less goto statement to worry about. --Keith * * * *****************************************************************************/ void while_emit(JVM_METHOD *meth, AST *root) { JVM_CODE_GRAPH_NODE *if_node, *next_node; fprintf(curfp, "while ("); if (root->astnode.blockif.conds != NULL) expr_emit (meth, root->astnode.blockif.conds); fprintf (curfp, ") {\n "); if_node = bc_append(meth, jvm_ifeq); emit (root->astnode.blockif.stmts); /* create a dummy instruction node so that * we have a branch target for the goto statement. * it will be removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(if_node, next_node); fprintf (curfp, "} // end while()\n"); } /***************************************************************************** * * * elseif_emit * * * * This function generates the code for the fortran 'else if' * * construct. * * * *****************************************************************************/ JVM_CODE_GRAPH_NODE * elseif_emit (JVM_METHOD *meth, AST * root) { JVM_CODE_GRAPH_NODE *if_node, *next_node, *goto_node; if(gendebug)printf("in else if\n"); fprintf (curfp, "else if ("); if (root->astnode.blockif.conds != NULL) expr_emit (meth, root->astnode.blockif.conds); if_node = bc_append(meth, jvm_ifeq); fprintf (curfp, ") {\n "); emit (root->astnode.blockif.stmts); fprintf (curfp, "} // Close else if()\n"); goto_node = bc_append(meth, jvm_goto); /* create a dummy instruction node so that we have a branch target * for the conditional statement. it will be removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(if_node, next_node); return goto_node; } /***************************************************************************** * * * else_emit * * * * This function generates the code for the fortran 'else' * * construct. * * * *****************************************************************************/ void else_emit (AST * root) { fprintf (curfp, "else {\n "); emit (root->astnode.blockif.stmts); fprintf (curfp, "} // Close else.\n"); } /***************************************************************************** * * * method_name_emit * * * * This function generates the correct method name for this function call. * * Depending on whether adapters are necessary, we may emit the name of the * * Fortran function, the name of a reflective method invocation, or an * * adapter method. * * * * Returns 1 if the Call is completely generated here, 0 otherwise. * * * *****************************************************************************/ int method_name_emit (JVM_METHOD *meth, AST *root, BOOL adapter) { char *tempname; HASHNODE *ht; AST *temp; int c; /* shouldn't be necessary to lowercase the name * lowercase (root->astnode.ident.name); */ tempname = strdup (root->astnode.ident.name); *tempname = toupper (*tempname); /* If this function was passed in as an argument, we call an * 'adapter' which performs the reflective method invocation.. */ if(type_lookup(cur_args_table, root->astnode.ident.name)) { if(gendebug) printf("@@ calling passed-in func %s\n",root->astnode.ident.name); /* if this function has no args, we can simplify the calling * process by not creating an argument array or calling a * method adapter. */ if((root->astnode.ident.arraylist == NULL) || (root->astnode.ident.arraylist->nodetype == EmptyArgList)) { /* no args. either function or subroutine. */ ht = type_lookup(cur_external_table, root->astnode.ident.name); if(!ht) { fprintf(stderr,"(2)Error: expected to find '%s' in external table.\n", root->astnode.ident.name); exit(EXIT_FAILURE); } bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object); bc_append(meth, jvm_aconst_null); bc_append(meth, jvm_aconst_null); c = bc_new_methodref(cur_class_file, METHOD_CLASS, "invoke", INVOKE_DESC); bc_append(meth, jvm_invokevirtual, c); if(root->nodetype == Call) { /* already called invoke(). for CALL, ignore the return value. */ bc_append(meth, jvm_pop); fprintf(curfp,"_%s_meth.invoke(null,null);\n", root->astnode.ident.name); } else { c = cp_find_or_insert(cur_class_file,CONSTANT_Class, numeric_wrapper[root->vartype]); bc_append(meth, jvm_checkcast, c); if((root->vartype == String) || (root->vartype == Character)) { fprintf(curfp,"(%s)_%s_meth.invoke(null,null)", java_wrapper[root->vartype], root->astnode.ident.name); } else { fprintf(curfp,"((%s)_%s_meth.invoke(null,null)).%s()", java_wrapper[root->vartype], root->astnode.ident.name, numericValue_method[root->vartype]); c = bc_new_methodref(cur_class_file, numeric_wrapper[root->vartype], numericValue_method[root->vartype], numericValue_descriptor[root->vartype]); bc_append(meth, jvm_invokevirtual, c); } } f2jfree(tempname, strlen(tempname)+1); return 1; } else if (root->nodetype == Call) { /* subroutine with args. */ unsigned int cnt = 0, arr_local; for( temp = root->astnode.ident.arraylist; temp; temp = temp->nextstmt) { cnt++; if((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist == NULL) && type_lookup(cur_array_table, temp->astnode.ident.name)) cnt++; } /* create object array to hold the args */ fprintf(curfp," Object [] _%s_args = new Object[%d];\n", root->astnode.ident.name, cnt); bc_push_int_const(meth, cnt); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, "java/lang/Object"); bc_append(meth, jvm_anewarray, c); arr_local = bc_get_next_local(meth, jvm_Object); bc_gen_store_op(meth, arr_local,jvm_Object); /* foreach arg, assign that arg to an element of the object array */ cnt = 0; for( temp = root->astnode.ident.arraylist; temp; temp = temp->nextstmt) { fprintf(curfp,"_%s_args[%d] = ", root->astnode.ident.name, cnt); bc_gen_load_op(meth, arr_local,jvm_Object); bc_push_int_const(meth, cnt); if((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist == NULL) && type_lookup(cur_array_table, temp->astnode.ident.name)) { expr_emit (meth, temp); bc_append(meth, jvm_aastore); fprintf(curfp,";\n"); fprintf(curfp,"_%s_args[%d] = new Integer(0);\n", root->astnode.ident.name, ++cnt); bc_gen_load_op(meth, arr_local,jvm_Object); bc_push_int_const(meth, cnt); /* incremented 2 lines above */ c = cp_find_or_insert(cur_class_file,CONSTANT_Class, numeric_wrapper[Integer]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,numeric_wrapper[Integer], "", wrapper_descriptor[Integer]); bc_push_int_const(meth, 0); bc_append(meth, jvm_invokespecial, c); } else { fprintf(curfp,"new %s(", java_wrapper[temp->vartype]); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, numeric_wrapper[temp->vartype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,numeric_wrapper[temp->vartype], "", wrapper_descriptor[temp->vartype]); expr_emit (meth, temp); fprintf(curfp,");\n"); bc_append(meth, jvm_invokespecial, c); } bc_append(meth, jvm_aastore); cnt++; } ht = type_lookup(cur_external_table, root->astnode.ident.name); if(!ht) { fprintf(stderr,"(3)Error: expected to find '%s' in external table.\n", root->astnode.ident.name); exit(EXIT_FAILURE); } bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object); bc_append(meth, jvm_aconst_null); bc_gen_load_op(meth, arr_local, jvm_Object); c = bc_new_methodref(cur_class_file, METHOD_CLASS, "invoke", INVOKE_DESC); bc_append(meth, jvm_invokevirtual, c); fprintf(curfp,"_%s_meth.invoke(null,_%s_args);\n", root->astnode.ident.name, root->astnode.ident.name); bc_release_local(meth, jvm_Object); bc_append(meth, jvm_pop); f2jfree(tempname, strlen(tempname)+1); return 1; } else /* function with args. */ { /* add this call to the list of calls which need adapters */ insert_methcall(methcall_list,root); /* no bytecode to be emitted here */ fprintf(curfp,"%s_methcall",root->astnode.ident.name); } } else if( adapter ) { /* we need to generate an 'adapter' which will simulate * passing array elements by reference. */ if(gendebug) printf("wow, guess we need an adapter for %s.\n", root->astnode.ident.name); insert_adapter(root); /* Assume all methods that are invoked are static. */ fprintf (curfp, "%s_adapter", root->astnode.ident.name); } else { JVM_METHODREF *mref = get_method_name(root, adapter); /* mref should always be non-null, though i guess it's * possible that the elements may be null. */ if((mref->classname != NULL) && (strlen(mref->classname) > 0)) { char *t; t = char_substitution(mref->classname, '/', '.'); fprintf (curfp, "%s.%s", t, root->astnode.ident.name); f2jfree(t, strlen(t)+1); } else fprintf (curfp, "%s.%s", tempname, root->astnode.ident.name); bc_free_fieldref(mref); } f2jfree(tempname, strlen(tempname)+1); return 0; } /***************************************************************************** * * * get_method_name * * * * the method that we call depends on whether this function needs an * * adapter, reflection, etc. this function determines the correct method * * name and returns it as a string. * * * *****************************************************************************/ JVM_METHODREF * get_method_name(AST *root, BOOL adapter) { char *buf, *tempname; char *tmpdesc; JVM_METHODREF *newmeth = NULL; tempname = strdup (root->astnode.ident.name); *tempname = toupper (*tempname); buf = (char *)f2jalloc( MAX((strlen(tempname) + strlen(root->astnode.ident.name)), (strlen(root->astnode.ident.name) + 9)) + 5); buf[0] = '\0'; if(type_lookup(cur_args_table, root->astnode.ident.name)) { if((root->astnode.ident.arraylist->nodetype == EmptyArgList) || (root->astnode.ident.arraylist == NULL)) { /* should not hit this */ } else if (root->nodetype == Call) { /* should not hit this */ } else { sprintf(buf,"%s_methcall",root->astnode.ident.name); newmeth = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF)); newmeth->classname = strdup(cur_filename); newmeth->methodname = strdup(buf); tmpdesc = get_desc_from_arglist(root->astnode.ident.arraylist); newmeth->descriptor = (char*)f2jalloc(strlen(tmpdesc) + strlen(METHOD_CLASS) + strlen(field_descriptor[root->vartype][0]) + 10); strcpy(newmeth->descriptor, "("); strcat(newmeth->descriptor, "L"); strcat(newmeth->descriptor, METHOD_CLASS); strcat(newmeth->descriptor, ";"); strcat(newmeth->descriptor, tmpdesc); strcat(newmeth->descriptor, ")"); strcat(newmeth->descriptor, field_descriptor[root->vartype][0]); f2jfree(tmpdesc, strlen(tmpdesc)+1); if(gendebug) printf("methcall descriptor = %s\n",newmeth->descriptor); } } else if(adapter) { HASHNODE *hashtemp; sprintf (buf, "%s_adapter", root->astnode.ident.name); newmeth = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF)); newmeth->classname = strdup(cur_filename); newmeth->methodname = strdup(buf); hashtemp = type_lookup(function_table, root->astnode.ident.name); if(hashtemp) { tmpdesc = get_adapter_desc(hashtemp->variable->astnode.source.descriptor, root->astnode.ident.arraylist); } else { JVM_METHODREF *mref; mref = find_method(root->astnode.ident.name, descriptor_table); if(mref) tmpdesc = get_adapter_desc(mref->descriptor, root->astnode.ident.arraylist); else { fprintf(stderr, "WARNING: could not find method descriptor\n"); tmpdesc = strdup("IIIIIII"); /* just some junk */ } } newmeth->descriptor = (char*)f2jalloc(strlen(tmpdesc) + strlen(field_descriptor[root->vartype][0]) + 10); strcpy(newmeth->descriptor, "("); strcat(newmeth->descriptor, tmpdesc); strcat(newmeth->descriptor, ")"); if(!type_lookup(cur_type_table, root->astnode.ident.name)) strcat(newmeth->descriptor, "V"); else strcat(newmeth->descriptor, field_descriptor[root->vartype][0]); f2jfree(tmpdesc, strlen(tmpdesc)+1); if(gendebug) printf("get_method_name: descriptor = '%s'\n",newmeth->descriptor); } else { newmeth = get_methodref(root); } f2jfree(buf, MAX((strlen(tempname) + strlen(root->astnode.ident.name)), (strlen(root->astnode.ident.name) + 9)) + 5); f2jfree(tempname, strlen(tempname)+1); return newmeth; } /***************************************************************************** * * * get_methodref * * * * looks for a method with the given name in the function table and returns * * a methodref with the appropriate class, method, and descriptor. * * * *****************************************************************************/ JVM_METHODREF * get_methodref(AST *node) { JVM_METHODREF *new_mref, *srch_mref; HASHNODE *ht; char *tempname = NULL; new_mref = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF)); /* first check the symbol table for information about this function. */ if( (ht = type_lookup(function_table, node->astnode.ident.name)) != NULL) { /* we found this method in the symbol table, so now we fill out the * methodref structure based on the symtable info. */ tempname = strdup (node->astnode.ident.name); *tempname = toupper (*tempname); new_mref->classname = bc_get_full_classname(tempname, package_name); new_mref->methodname = strdup(node->astnode.ident.name); if(ht->variable->astnode.source.descriptor == NULL) { fprintf(stderr, "Warning: null descriptor for %s...", new_mref->methodname); fprintf(stderr, "probably not declared EXTERNAL\n"); } else new_mref->descriptor = strdup(ht->variable->astnode.source.descriptor); } else { /* we cannot find this method in the symbol table, so now we look * in the descriptor table, which is generated from reading the .f2j * files. */ srch_mref = find_method(node->astnode.ident.name, descriptor_table); if(!srch_mref) { /* if we reach this, then we cannot find this method anywhere. * try to guess at the descriptor. Since the guess is likely to * be wrong, generate a warning message (unless this is a function * passed in as an argument). */ if(type_lookup(cur_args_table, node->astnode.ident.name) == NULL) { fprintf(stderr, "WARNING: could not resolve call to '%s'.\n", node->astnode.ident.name); fprintf(stderr, " This will probably result in incorrect code generation.\n"); fprintf(stderr, " Make sure the external function was compiled already and\n"); fprintf(stderr, " check the paths specified using the -c flag.\n"); } tempname = strdup (node->astnode.ident.name); *tempname = toupper (*tempname); new_mref->classname = bc_get_full_classname(tempname, package_name); new_mref->methodname = strdup(node->astnode.ident.name); f2jfree(tempname, strlen(tempname)+1); tempname = get_desc_from_arglist(node->astnode.ident.arraylist); new_mref->descriptor = (char *)f2jalloc(strlen(tempname) + 10); strcpy(new_mref->descriptor,"("); strcat(new_mref->descriptor,tempname); strcat(new_mref->descriptor,")V"); /* assume void return type */ } else { /* we may later free the mref, so dup the table entry */ new_mref->classname = strdup(srch_mref->classname); new_mref->methodname = strdup(srch_mref->methodname); new_mref->descriptor = strdup(srch_mref->descriptor); } } if(tempname != NULL) f2jfree(tempname, strlen(tempname)+1); return new_mref; } /***************************************************************************** * * * call_emit * * * * This procedure implements Lapack and Blas type methods. * * They are translated to static method invocations. * * This is not a portable solution, it is specific to * * routines generated by f2java. * * * *****************************************************************************/ void call_emit (JVM_METHOD *meth, AST * root) { BOOL adapter; JVM_METHODREF *mref; int c; assert (root != NULL); if(gendebug) printf("@##@ in call_emit, %s\n",root->astnode.ident.name); adapter = needs_adapter(root); /* if method_name_emit() already completely generated the call, return now */ if( method_name_emit(meth, root, adapter) ) return; if(gendebug) printf("call_emit, %s not already emitted\n",root->astnode.ident.name); if((root->astnode.ident.arraylist == NULL) || (root->astnode.ident.arraylist->nodetype == EmptyArgList)) { /* the arg list is empty, just emit "()" and return */ mref = get_method_name(root, adapter); if(gendebug) printf("call_emit (type: %s), got class = '%s', name = '%s'\n", returnstring[root->vartype], mref->classname, mref->methodname); c = bc_new_methodref(cur_class_file,mref->classname, mref->methodname, mref->descriptor); bc_append(meth, jvm_invokestatic, c); if(root->nodetype == Call) fprintf (curfp, "();\n"); else fprintf (curfp, "()"); bc_free_fieldref(mref); return; } fprintf (curfp, "("); /* for reflective method call adapters, the first paramter should * be the method to invoke. */ if(type_lookup(cur_args_table, root->astnode.ident.name)) { HASHNODE *ht; fprintf(curfp,"_%s_meth",root->astnode.ident.name); if(root->astnode.ident.arraylist != NULL) fprintf(curfp,","); ht = type_lookup(cur_external_table, root->astnode.ident.name); if(!ht) { fprintf(stderr,"(4)Error: expected to find '%s' in external table.\n", root->astnode.ident.name); exit(EXIT_FAILURE); } bc_gen_load_op(meth, ht->variable->astnode.ident.localvnum, jvm_Object); } emit_call_arguments(meth, root, adapter); mref = get_method_name(root, adapter); c = bc_new_methodref(cur_class_file,mref->classname, mref->methodname, mref->descriptor); bc_append(meth, jvm_invokestatic, c); /* * Problem here, depends on who called this procedure. * When this is used by the CALL keyword, it works as * written. When used to create an external function call, * it adds an extra ; and \n to the output. Might be * able to fix this by checking the nodetype. */ if(root->nodetype == Call) fprintf (curfp, ");\n"); else fprintf (curfp, ")"); if(gendebug)printf("leaving-call emit\n"); bc_free_fieldref(mref); } /* Close call_emit(). */ /***************************************************************************** * * * emit_call_arguments * * * * this function attempts to find the method descriptor for the fortran * * subroutine or function that we are calling. * * * *****************************************************************************/ void emit_call_arguments(JVM_METHOD *meth, AST *root, BOOL adapter) { JVM_METHODREF *mref; /* look up the function that we are calling so that we may compare * the parameters. */ mref = get_methodref(root); if(gendebug) printf("Looking up function name %s...%s\n", root->astnode.ident.name, mref ? "Found" : "Not found"); if(mref != NULL) emit_call_args_known(meth, root, mref->descriptor, adapter); else emit_call_args_unknown(meth, root); bc_free_fieldref(mref); } /***************************************************************************** * * * emit_call_args_known * * * * this function emits the arguments to a method call when we know the * * descriptor for the method. in this case we can determine whether each * * arg needs to be passed by reference or not. e.g. if you pass a constant * * to a method expecting an intW object, then the constant must be wrapped * * in an intW before calling the method. * * * *****************************************************************************/ void emit_call_args_known(JVM_METHOD *meth, AST *root, char *desc, BOOL adapter) { char *com_prefix, *dptr; AST *temp; if(gendebug) printf("emit_call_args_known: desc = '%s'\n", desc); temp = root->astnode.ident.arraylist; dptr = bc_next_desc_token(desc); for( ; temp != NULL; temp = temp->nextstmt) { com_prefix = get_common_prefix(temp->astnode.ident.name); /* * if the arg is an identifier AND * it looks like an array access AND * it is in the array table */ if((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist != NULL) && (type_lookup(cur_array_table, temp->astnode.ident.name)!=NULL)) { arrayacc_arg_emit(meth, temp, dptr, adapter); } /* * else if the arg is an identifier AND * it does not look like an array access AND * it is in the array table */ else if((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist == NULL) && type_lookup(cur_array_table, temp->astnode.ident.name) ) { arrayref_arg_emit(meth, temp, dptr); } /* * else if the arg is an identifier AND * it does not look like an array access AND * it is not in the array table */ else if(omitWrappers && ((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist == NULL) && !type_lookup(cur_array_table, temp->astnode.ident.name) )) { scalar_arg_emit(meth, temp, dptr, com_prefix); } else if(omitWrappers && (temp->nodetype == Constant)) { if(isPassByRef_desc(dptr) || (dptr[0] == '[')) { int c; fprintf(curfp,"new %s(", wrapper_returns[get_type_from_field_desc(dptr)]); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, full_wrappername[temp->vartype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,full_wrappername[temp->vartype], "", wrapper_descriptor[temp->vartype]); expr_emit (meth, temp); fprintf(curfp,")"); bc_append(meth, jvm_invokespecial, c); } else expr_emit(meth, temp); } else if( ((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist == NULL) ) || (temp->nodetype == Constant) ) { expr_emit(meth, temp); } else if(temp->nodetype != EmptyArgList) { wrapped_arg_emit(meth, temp, dptr); } /* if this arg is an array, then skip an extra token to compensate * for the additional integer offset arg. */ if(dptr[0] == '[') dptr = bc_next_desc_token(dptr); dptr = bc_next_desc_token(dptr); if(temp->nextstmt != NULL) fprintf(curfp, ","); f2jfree(com_prefix, strlen(com_prefix)+1); } } /***************************************************************************** * * * arrayacc_arg_emit * * * * this function emits an argument to a method call when the arg: * * - is an identifier AND * * - it looks like an array access AND * * - it is in the array table * * * *****************************************************************************/ void arrayacc_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr, BOOL adapter) { BOOL isarg, isext; struct var_info *vtemp; isarg = type_lookup(cur_args_table, temp->astnode.ident.name) != NULL; if(gendebug) printf("arrayacc_arg_emit() %s - %s\n", temp->astnode.ident.name, dptr); vtemp = push_array_var(meth, temp); if(dptr[0] == '[') /* it is expecting an array */ { func_array_emit(meth, temp->astnode.ident.arraylist, temp->astnode.ident.name, isarg, TRUE); } else /* it is not expecting an array */ { /* In this case we are passing the array element to the * adapter, so we dont wrap it in an object. */ if(omitWrappers) { if(adapter && isPassByRef_desc(dptr)) isext = TRUE; else isext = FALSE; } else { if(adapter) isext = TRUE; else isext = FALSE; } func_array_emit (meth, temp->astnode.ident.arraylist, temp->astnode.ident.name, isarg, isext); if(!isext) bc_gen_array_load_op(meth, jvm_data_types[temp->vartype]); } free_var_info(vtemp); } /***************************************************************************** * * * arrayref_arg_emit * * * * this function emits an argument to a method call when the arg: * * - the arg is an identifier AND * * - it does not look like an array access AND * * - it is in the array table * * * *****************************************************************************/ void arrayref_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr) { if(dptr[0] == '[') /* it is expecting an array */ { if(gendebug) printf("expecting array\n"); expr_emit(meth, temp); } else { struct var_info *vtemp; if(gendebug) printf("NOT expecting array\n"); vtemp = push_array_var(meth, temp); if(omitWrappers && !isPassByRef_desc(dptr)) { /* fprintf(curfp,"%s%s[0]",com_prefix, temp->astnode.ident.name); */ fprintf(curfp,"[0]"); bc_push_int_const(meth, 0); bc_gen_array_load_op(meth, jvm_data_types[temp->vartype]); } else { /* in this case, the array has no index and the corresponding * parameter is pass-by-reference, so we assume an index of 0 * which would be the behavior of fortran. */ bc_push_int_const(meth, 0); fprintf(curfp,",0"); /* * fprintf(curfp,"new %s(", * wrapper_returns[get_type_from_field_desc(dptr)]); * fprintf(curfp,"%s%s[0]", com_prefix,temp->astnode.ident.name); * fprintf(curfp,")"); */ } free_var_info(vtemp); } } /***************************************************************************** * * * scalar_arg_emit * * * * this function emits an argument to a method call when the arg: * * - the arg is an identifier AND * * - it does not look like an array access AND * * - it is not in the array table * * * *****************************************************************************/ void scalar_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr, char *com_prefix) { if(gendebug) { printf("scalar_arg_emit: "); printf("name = %s (pass by ref = %s), dptr = %s (pass by ref = %s)\n", temp->astnode.ident.name, cgPassByRef(temp->astnode.ident.name)? "yes" : "no", dptr, isPassByRef_desc(dptr) ? "yes" : "no"); } if(isPassByRef_desc(dptr) != cgPassByRef(temp->astnode.ident.name)) { if(cgPassByRef(temp->astnode.ident.name)) { struct var_info *ainf; if(dptr[0] == '[') fprintf(curfp,"%s%s",com_prefix,temp->astnode.ident.name); else fprintf(curfp,"%s%s.val",com_prefix,temp->astnode.ident.name); ainf = get_var_info(temp); if(dptr[0] == '[') pushVar(cur_class_file, meth, temp->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, FALSE); else pushVar(cur_class_file, meth, temp->vartype, ainf->is_arg, ainf->class, ainf->name, ainf->desc, ainf->localvar, TRUE); free_var_info(ainf); } else if(type_lookup(cur_external_table, temp->astnode.ident.name)) { external_emit(meth, temp); } else fprintf(stderr,"Internal error: %s should not be primitive\n", temp->astnode.ident.name); } else { if( temp->vartype != get_type_from_field_desc(dptr) ) fprintf(curfp,"(%s) ( ",returnstring[get_type_from_field_desc(dptr)]); expr_emit(meth, temp); if( temp->vartype != get_type_from_field_desc(dptr) ) { fprintf(curfp,")"); bc_append(meth, typeconv_matrix[temp->vartype] [get_type_from_field_desc(dptr)]); } } } /***************************************************************************** * * * wrapped_arg_emit * * * * this function emits an argument to a method call when the arg does not * * really fall into the other categories. * * * *****************************************************************************/ void wrapped_arg_emit(JVM_METHOD *meth, AST *temp, char *dptr) { enum returntype vtype = get_type_from_field_desc(dptr); int c = 0; /* * Otherwise, use wrappers. */ if(omitWrappers) { if(isPassByRef_desc(dptr)) { fprintf(curfp,"new %s(", wrapper_returns[vtype]); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, full_wrappername[temp->vartype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,full_wrappername[temp->vartype], "", wrapper_descriptor[temp->vartype]); } } else { fprintf(curfp,"new %s(", wrapper_returns[vtype]); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, full_wrappername[temp->vartype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); c = bc_new_methodref(cur_class_file,full_wrappername[temp->vartype], "", wrapper_descriptor[temp->vartype]); } if(gendebug) { printf("emitting wrapped expr...\n"); printf(" wrapper type is %s\n",wrapper_returns[vtype]); printf(" data type is %s\n",returnstring[temp->vartype]); } /* emit a cast if necessary */ if( temp->vartype != vtype ) fprintf(curfp,"(%s) ( ",returnstring[vtype]); expr_emit(meth, temp); if( temp->vartype != vtype ) { fprintf(curfp,")"); bc_append(meth, typeconv_matrix[temp->vartype][vtype]); } if(omitWrappers) { if(isPassByRef_desc(dptr)) { fprintf(curfp,")"); bc_append(meth, jvm_invokespecial, c); } } else { fprintf(curfp,")"); bc_append(meth, jvm_invokespecial, c); } } /***************************************************************************** * * * emit_call_args_unknown * * * * this function emits the arguments to a method call when the descriptor * * of the method is unknown. in this case, we must guess at the appropriate * * types - sometimes we are correct but most of the time, there is an error. * * * *****************************************************************************/ void emit_call_args_unknown(JVM_METHOD *meth, AST *root) { AST *temp; temp = root->astnode.ident.arraylist; for( ; temp != NULL; temp = temp->nextstmt) { if(((temp->nodetype == Identifier) && (temp->astnode.ident.arraylist == NULL)) || (temp->nodetype == Constant)) { expr_emit (meth, temp); } else { if(omitWrappers) { expr_emit (meth, temp); } else { fprintf(curfp,"new %s(", wrapper_returns[temp->vartype]); expr_emit (meth, temp); fprintf(curfp,")"); } } if(temp->nextstmt != NULL) fprintf(curfp, ","); } } /***************************************************************************** * * * insert_methcall * * * * Insert this method call into the list. We are keeping track of * * the method calls in order to generate adapter functions later. * * * *****************************************************************************/ void insert_methcall(Dlist mlist, AST *root) { Dlist new, p, tmplist; AST *temp; char * root_name; if(gendebug) printf("MTH: here i am in insert_methcall. name = %s\n", root->astnode.ident.name); /* if the list of lists is empty, create a new list to * hold this node and insert it in the main list. */ if(dl_empty(mlist)) { if(gendebug) printf("MTH: list is empty, create new one.\n"); new = make_dl(); dl_insert_b(new,root); dl_insert_b(mlist,new); return; } /* otherwise we must determine whether there is already * a call to this function in the current program unit. * if not, we create a new list which hangs off the main * list. This new list contains pointers to all the calls * to that function. if there is already a list corresponding * to the function, we insert this node into that list. * the reason we keep _all_ the calls is because we cannot * know the parameters of some function that is passed in * as an argument. So we must guess (we also have to guess * at its return type). therefore, we keep around as many * calls as possible to help clear up any ambiguity. for * example, if the fortran source contains a call like: * x = func(12) * we must assume that since the constant is an integer, func * must take an integer parameter. however, if there is * another call to func later on in the program like this: * x = func(y) * then we can resolve the ambiguity by assuming that func's * parameter should have the same type as the variable y. */ root_name = root->astnode.ident.name; dl_traverse(p,mlist) { tmplist = (Dlist) dl_val(p); temp = dl_val(dl_first(tmplist)); if(gendebug) printf("MTH: temp name is %s.\n", temp->astnode.ident.name); if(!strcmp(temp->astnode.ident.name,root_name)) { /* found another function call... insert this node * into the current list. */ if(gendebug) printf("MTH: found %s...inserting.\n", temp->astnode.ident.name); dl_insert_b(tmplist,root); return; } } /* we did not find another call to this function. create * a new list for it. */ if(gendebug) printf("MTH: could not find %s.\n", root->astnode.ident.name); new = make_dl(); dl_insert_b(new,root); dl_insert_b(mlist,new); } /***************************************************************************** * * * needs_adapter * * * * This function compares the expressions in the function call with * * the arguments of the function to find one specific case: attempting * * to pass an array element to a function that expects a scalar. If * * we find such a case, we must generate an adapter that allows * * pass by reference of the array element. Returns 1 if this function * * call needs an adapter. If no adapter is needed or if we dont have * * enough info to determine whether one is needed, this function * * returns 0. * * * *****************************************************************************/ int needs_adapter(AST *root) { HASHNODE *hashtemp; JVM_METHODREF *mtmp; AST *temp; char *dptr, *current_descriptor; /* first, check for a null parameter list. if there are no parameters, * we certainly wont need an adapter. */ if((root->astnode.ident.arraylist->nodetype == EmptyArgList) || (root->astnode.ident.arraylist == NULL)) return 0; if(gendebug) printf("in needs_adapter: Looking up function name %s..\n", root->astnode.ident.name); if((hashtemp=type_lookup(function_table, root->astnode.ident.name)) != NULL) current_descriptor = hashtemp->variable->astnode.source.descriptor; else if((mtmp=find_method(root->astnode.ident.name,descriptor_table))!=NULL) current_descriptor = mtmp->descriptor; else return 0; /* if for some reason current_descriptor is null, just return false now */ if(!current_descriptor) return 0; if(gendebug) printf("needs_adapter: got descriptor '%s'\n", current_descriptor); dptr = bc_next_desc_token(current_descriptor); temp = root->astnode.ident.arraylist; for( ; temp != NULL; temp = temp->nextstmt) { if(dptr == NULL) break; /* * if the arg is an identifier AND * it is in the array table AND * the function is not expecting an array */ if(omitWrappers) { if((temp->nodetype == Identifier) && type_lookup(cur_array_table, temp->astnode.ident.name) && (dptr[0] != '[') && isPassByRef_desc(dptr)) return 1; } else { if((temp->nodetype == Identifier) && type_lookup(cur_array_table, temp->astnode.ident.name) && (dptr[0] != '[')) return 1; } /* * if the arg is an identifier AND * it is in the array table AND * the function is expecting an array AND * the data types are different */ if((temp->nodetype == Identifier) && type_lookup(cur_array_table, temp->astnode.ident.name) && (dptr[0] == '[') && (get_type_from_field_desc(dptr+1) != temp->vartype)) { fprintf(stderr, "Warning: in unit '%s', in call to '%s':\n", unit_name, root->astnode.ident.name); fprintf(stderr, " Array argument '%s' has wrong type.\n", temp->astnode.ident.name); fprintf(stderr, " A dummy array of the correct type will be passed.\n"); fprintf(stderr, " This should be ok for passing workspace arrays.\n"); fprintf(stderr, " Otherwise, there could be problems.\n"); return 1; } /* * otherwise... * if the arg is NOT in the array table AND * the function IS expecting an array */ if( ! type_lookup(cur_array_table, temp->astnode.ident.name) && dptr[0] == '[') return 1; /* consume the offset arg if necessary */ if(dptr[0] == '[') dptr = bc_next_desc_token(dptr); dptr = bc_next_desc_token(dptr); } if(gendebug) printf("needs_adapter:returning 0\n"); return 0; } /***************************************************************************** * * * assign_emit * * * * This function generates the code for assignment statements. * * If it looks like the lhs and rhs have different types, we * * try to provide the appropriate cast, but in some cases the * * resulting code may need to be modified slightly. * * * * to generate an assignment statement in bytecode, we consider * * three cases: * * 1. LHS is a scalar, not wrapped in an object (e.g. a = expr) * * in this case, the RHS should be emitted first, followed by * * a store instruction to the LHS (unlike Java source where we * * generate the LHS followed by the RHS). * * 2. LHS is a scalar, wrapped in an object (e.g. a.val = expr) * * in this case, we push a reference to the LHS on the stack * * then emit the RHS as usual, followed by a putfield opcode * * to store the value to the 'val' field. * * 3. LHS is an array access (e.g. a[x] = expr) * * in this case, we push a reference to the LHS then emit the * * index expression. next emit the RHS and generate an * * array store instruction (e.g. iastore). * * * *****************************************************************************/ void assign_emit (JVM_METHOD *meth, AST * root) { enum returntype ltype, rtype; int c; HASHNODE *hashtemp; /* this used to be a pretty simple procedure: * emit LHS * print = * emit RHS * and that was it. but it turns out that Fortran doesn't really * care much if the LHS and RHS are different types. However, Java * doesn't like that, so we have to insert the appropriate cast or * conversion if the types do not agree. */ hashtemp = type_lookup(cur_type_table, root->astnode.assignment.lhs->astnode.ident.name); if(hashtemp) root->astnode.assignment.lhs->vartype = hashtemp->variable->vartype; hashtemp = type_lookup(cur_type_table, root->astnode.assignment.rhs->astnode.ident.name); if(hashtemp) root->astnode.assignment.rhs->vartype = hashtemp->variable->vartype; ltype = root->astnode.assignment.lhs->vartype; rtype = root->astnode.assignment.rhs->vartype; if(gendebug) { printf("## ## codegen: ltype = %s (%d)\n",returnstring[ltype], ltype); printf("## ## codegen: rtype = %s (%d)\n",returnstring[rtype], rtype); } /* handle lhs substring operations elsewhere */ if(root->astnode.assignment.lhs->nodetype == Substring) { substring_assign_emit(meth, root); } else if((root->astnode.assignment.lhs->vartype == String) && root->astnode.assignment.lhs->astnode.ident.arraylist && !root->astnode.assignment.lhs->astnode.ident.arraylist->nextstmt && !type_lookup(cur_array_table, root->astnode.assignment.lhs->astnode.ident.name)) { /* this handles cases like: * character a(1) * a(1) = 'x' * which technically isn't a substring operation, but we treat it as such. */ root->astnode.assignment.lhs->astnode.ident.startDim[1] = root->astnode.assignment.lhs->astnode.ident.arraylist; substring_assign_emit(meth, root); } else { name_emit (meth, root->astnode.assignment.lhs); fprintf (curfp, " = "); if(ltype != rtype) /* lhs and rhs have different types */ { if((ltype != String) && ((rtype == String)||(rtype==Character))) { /* non-String = String */ fprintf(curfp,"%s.valueOf(",java_wrapper[ltype]); expr_emit (meth, root->astnode.assignment.rhs); fprintf(curfp,").%sValue()",returnstring[ltype]); c = bc_new_methodref(cur_class_file,numeric_wrapper[ltype], "valueOf", wrapper_valueOf_descriptor[ltype]); bc_append(meth, jvm_invokestatic, c); c = bc_new_methodref(cur_class_file,numeric_wrapper[ltype], numericValue_method[ltype], numericValue_descriptor[ltype]); bc_append(meth, jvm_invokevirtual, c); } else if( (ltype == Logical) && (rtype != String) ) { JVM_CODE_GRAPH_NODE *if_node = NULL, *goto_node = NULL, *iconst_node = NULL, *next_node = NULL; /* boolean = numeric value */ expr_emit (meth, root->astnode.assignment.rhs); fprintf(curfp," == 0 ? false : true"); if(rtype == Integer) { if_node = bc_append(meth, jvm_ifeq); bc_append(meth, jvm_iconst_1); goto_node = bc_append(meth, jvm_goto); iconst_node = bc_append(meth, jvm_iconst_0); } else if(rtype == Float) { bc_append(meth, jvm_fconst_0); bc_append(meth, jvm_fcmpl); if_node = bc_append(meth, jvm_ifne); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); iconst_node = bc_append(meth, jvm_iconst_1); } else if(rtype == Double) { bc_append(meth, jvm_dconst_0); bc_append(meth, jvm_dcmpl); if_node = bc_append(meth, jvm_ifne); bc_append(meth, jvm_iconst_0); goto_node = bc_append(meth, jvm_goto); iconst_node = bc_append(meth, jvm_iconst_1); } else fprintf(stderr,"WARNING: unsupported cast.\n"); bc_set_branch_target(if_node, iconst_node); /* create a dummy instruction node following the iconst so that * we have a branch target for the goto statement. it'll be * removed later. */ next_node = bc_append(meth, jvm_xxxunusedxxx); bc_set_branch_target(goto_node, next_node); } else { if(typeconv_matrix[rtype][ltype] == jvm_nop) { if((ltype != String && ltype != Character) || (rtype != String && rtype != Character)) fprintf(stderr,"WARNING: unable to handle cast (%s->%s)!\n", returnstring[rtype], returnstring[ltype]); } /* numeric value = numeric value of some other type */ fprintf(curfp,"(%s)(",returnstring[ltype]); expr_emit (meth, root->astnode.assignment.rhs); fprintf(curfp,")"); bc_append(meth, typeconv_matrix[rtype][ltype]); } } else /* lhs and rhs have same types, everything is cool */ expr_emit (meth, root->astnode.assignment.rhs); } LHS_bytecode_emit(meth, root); if(gendebug)printf("leaving-assign emit\n"); } /***************************************************************************** * * * LHS_bytecode_emit * * * * emit the store op(s) required to store a value to the LHS of some * * assignment statement. note: this has no effect on Java source... * * this is only for bytecode since we have to emit a store op after the * * RHS (and possibly a LHS array ref). * * * *****************************************************************************/ void LHS_bytecode_emit(JVM_METHOD *meth, AST *root) { char *name, *class, *desc, *com_prefix; HASHNODE *isArg, *typenode, *ht; int c; name = root->astnode.assignment.lhs->astnode.ident.name; if((typenode = type_lookup(cur_type_table, name)) != NULL) desc = getVarDescriptor(typenode->variable); else desc = "asdf"; /* get the name of the common block class file, if applicable */ com_prefix = get_common_prefix(name); isArg = type_lookup(cur_args_table,name); if(com_prefix[0] != '\0') { char *idx; /* if this is a COMMON variable, find out the merged * name, if any, that we should use instead. Names are * merged when different declarations of a common * block use different variable names. */ ht = type_lookup(cur_type_table,name); if (ht == NULL) fprintf(stderr,"assign_emit:Cant find %s in type_table\n", name); else if(ht->variable->astnode.ident.merged_name != NULL) name = ht->variable->astnode.ident.merged_name; class = strdup(com_prefix); while( (idx = strchr(class, '.')) != NULL ) *idx = '/'; class[strlen(class)-1] = '\0'; } else { /* want to be able to free() class later, so we must assign malloc'd * memory to it in both cases. */ class = strdup(cur_filename); } if(gendebug) printf("in assign_emit, class = %s, name = %s, desc = %s\n", class, name, desc); if((root->astnode.assignment.lhs->astnode.ident.arraylist == NULL) || (root->astnode.assignment.lhs->nodetype == Substring)) { /* LHS is not an array reference (note that the variable may be * an array, but it isn't being indexed here). for bytecode, * we now generate a store or putfield instruction, depending * on whether the variable is wrapped or not. */ if(omitWrappers && !cgPassByRef(root->astnode.assignment.lhs->astnode.ident.name)) { /* we know that this cannot be a local variable because otherwise it * would be pass by reference, given that it is the LHS of an * assignment. thus, we generate a putstatic instruction. */ if(gendebug) { printf("generating LHS...\n"); printf("lhs descriptor = %s\n",desc); printf("isArg = %s\n",isArg?"Yes":"No"); printf("local var #%d\n", root->astnode.assignment.lhs->astnode.ident.localvnum); } storeVar(cur_class_file, meth, root->astnode.assignment.lhs->vartype, (BOOL)isArg, class, name, desc, typenode->variable->astnode.ident.localvnum, FALSE); } else { int vt = root->astnode.assignment.lhs->vartype; /* this is a wrapped primitive. the objectref and value should * already be sitting on the stack, so now we generate a putfield * instruction. */ c = bc_new_fieldref(cur_class_file, full_wrappername[vt], "val", val_descriptor[vt]); bc_append(meth, jvm_putfield, c); } } else { /* the LHS is an array access. currently the stack holds a reference * to the array, the array index, and the RHS expression. all we need * to do now is generate an array store instruction (e.g. iastore). */ bc_gen_array_store_op(meth, jvm_data_types[root->astnode.assignment.lhs->vartype]); } f2jfree(com_prefix, strlen(com_prefix)+1); f2jfree(class, strlen(class)+1); } /***************************************************************************** * * * substring_assign_emit * * * * once upon a time, we generated some funky inline code to handle substring * * ops on the LHS of an assignment. we moved that code to a method in * * org.netlib.util.Util called insertString(), which takes the LHS string, * * the RHS string, and the substring indices and returns the altered string. * * * *****************************************************************************/ void substring_assign_emit(JVM_METHOD *meth, AST *root) { AST *lhs = root->astnode.assignment.lhs; AST *rhs = root->astnode.assignment.rhs; int c, single_sub = 0; if(gendebug) printf("substring_assign_emit\n"); /* check if this is a single character array reference, e.g.: * character x(10) * x(3) = 'f' */ if((lhs->astnode.ident.startDim[0] == NULL) && (lhs->astnode.ident.endDim[0] == NULL) && (lhs->astnode.ident.startDim[1] != NULL)) single_sub = 1; lhs->nodetype = Substring; name_emit(meth, lhs); fprintf(curfp,"= Util.stringInsert("); /* we want to call name_emit() on lhs again, but in this * case we don't want it treated like an lvalue, so we'll * just set root->astnode.assignment.lhs = NULL here * and call scalar_emit() directly instead. */ root->astnode.assignment.lhs = NULL; scalar_emit(meth, lhs, NULL); fprintf(curfp,","); /* now reset the value just in case we need it later. */ root->astnode.assignment.lhs = lhs; if(rhs->vartype == Character) { /* * Java's Character class doesn't have a static toString * method, so we have to create a new character object first. * * currently I dont think we ever hit this case, so the code * here may be superfluous and is definitely untested. */ /* * c = cp_find_or_insert(cur_class_file,CONSTANT_Class, * "java/lang/Character"); * * bc_append(jvm_new,c); * bc_append(jvm_dup); * * c = bc_new_methodref(cur_class_file,"java/lang/Character", * "", "(C)V"); * * fprintf(curfp,"new Character("); * expr_emit(rhs); * bc_append(jvm_invokespecial, c); * fprintf(curfp,").toString(),"); * c = bc_new_methodref(cur_class_file,"java/lang/Character", "toString", * "()Ljava/lang/String;"); * bc_append(jvm_invokestatic, c); */ /* code above is broken, use code for STring */ expr_emit(meth, rhs); fprintf(curfp,","); } else if(rhs->vartype == String) { expr_emit(meth, rhs); fprintf(curfp,","); } else { fprintf(curfp,"%s.toString(", java_wrapper[rhs->vartype]); expr_emit(meth, rhs); c = bc_new_methodref(cur_class_file,numeric_wrapper[rhs->vartype], "toString", toString_descriptor[rhs->vartype]); bc_append(meth, jvm_invokestatic, c); fprintf(curfp,"),"); } if(single_sub) { expr_emit(meth, lhs->astnode.ident.startDim[1]); } else { if(lhs->astnode.ident.startDim[0]) expr_emit(meth, lhs->astnode.ident.startDim[0]); else emit_default_substring_start(meth, lhs); fprintf(curfp,","); if(lhs->astnode.ident.endDim[0]) expr_emit(meth, lhs->astnode.ident.endDim[0]); else emit_default_substring_end(meth, lhs); } fprintf(curfp,")"); if(single_sub) c = bc_new_methodref(cur_class_file, UTIL_CLASS, "stringInsert", SINGLE_INS_DESC); else c = bc_new_methodref(cur_class_file, UTIL_CLASS, "stringInsert", INS_DESC); bc_append(meth, jvm_invokestatic, c); } /***************************************************************************** * * * dl_int_examine * * * * This function returns the last item in a dlist of integers. * * * *****************************************************************************/ int dl_int_examine(Dlist l) { return ( *( (int *) dl_val(dl_last(l)) ) ); } /***************************************************************************** * * * dl_astnode_examine * * * * This function returns the last item in a dlist of astnodes. * * * *****************************************************************************/ AST * dl_astnode_examine(Dlist l) { if(dl_empty(l)) return NULL; return ( (AST *) dl_val(dl_last(l)) ); } /***************************************************************************** * * * label_search * * * * searches a list of Forloop nodes for the one corresponding to the given * * label (val). returns NULL if the node is not found. * * * *****************************************************************************/ AST * label_search(Dlist l, int val) { Dlist p; AST *v; dl_traverse(p,l) { v = (AST *) p->val; if( atoi( v->astnode.forloop.Label->astnode.constant.number ) == val ) return v; } return NULL; } /***************************************************************************** * * * dl_name_search * * * * This function searches for a value in a dlist of * * AST nodes. Returns the node if it is found, NULL * * otherwise. * * * *****************************************************************************/ AST * dl_name_search(Dlist l, char *name) { Dlist p; dl_traverse(p,l) if( !strcmp(((AST *)p->val)->astnode.ident.name,name) ) return p->val; return NULL; } /***************************************************************************** * * * insert_adapter * * * * Insert this method call into the list. We are keeping track of * * the method calls in order to generate adapter functions later. * * * *****************************************************************************/ void insert_adapter(AST *node) { HASHNODE *ht; JVM_METHODREF *tmp; AST *ptr; Dlist p; /* if there is not an adapter for this function call already in the list, * insert it now */ if(gendebug) { printf("** here we are in insert_adapter\n"); printf("** \n"); } dl_traverse(p, adapter_list ) { ptr = (AST *) dl_val(p); if( !strcmp(ptr->astnode.ident.name, node->astnode.ident.name) ) { /* this function call is already in the list. now we must determine * whether the prototypes of the adapters would be the same. If so, * there's no need to insert this node in the adapter list. If the * prototypes would be different, then we must insert this node. */ if(gendebug) printf("** %s is already in adapter_list. now checking args.\n", node->astnode.ident.name); if((ht=type_lookup(function_table, node->astnode.ident.name)) != NULL) { if(!adapter_insert_from_descriptor(node,ptr, ht->variable->astnode.source.descriptor)) { if(gendebug) printf("** found an equivalent adapter. no need to insert.\n"); return; } } else { tmp = find_method(node->astnode.ident.name, descriptor_table); if(tmp) adapter_insert_from_descriptor(node, ptr, tmp->descriptor); else { if(gendebug) printf("** cant find prototype...returning.\n"); } /* cant find the prototype. normally, I dont think */ return; /* this case will be reached. */ } } } if(gendebug) printf("** inserting '%s' into adapter_list now.\n", node->astnode.ident.name); dl_insert_b(adapter_list,node); } /***************************************************************************** * * * adapter_insert_from_descriptor * * * * this function determines whether the call pointed to by node is different * * from the call pointed to by ptr. * * * *****************************************************************************/ BOOL adapter_insert_from_descriptor(AST *node, AST *ptr, char *desc) { int this_arg_is_arrayacc, other_arg_is_arrayacc, i; int this_arg_is_scalar, other_arg_is_scalar; AST *this_call, *other_call; BOOL diff; char *dptr; if(gendebug) printf("adapter_insert_from_descriptor: desc = '%s'\n", desc); this_call = node->astnode.ident.arraylist; other_call = ptr->astnode.ident.arraylist; dptr = bc_next_desc_token(desc); diff = FALSE; for(i=0 ; this_call != NULL; this_call = this_call->nextstmt, i++) { if(dptr == NULL) break; if( other_call == NULL ) { fprintf(stderr,"2:Function calls to %s in unit %s ", node->astnode.ident.name, unit_name); fprintf(stderr,"don't have same number of params\n"); return TRUE; } this_arg_is_arrayacc = (this_call->nodetype == Identifier) && /* (this_call->astnode.ident.arraylist != NULL) && */ type_lookup(cur_array_table, this_call->astnode.ident.name); other_arg_is_arrayacc = (other_call->nodetype == Identifier) && /* (other_call->astnode.ident.arraylist != NULL) && */ type_lookup(cur_array_table, other_call->astnode.ident.name); if( (dptr[0] == 'L') && (this_arg_is_arrayacc != other_arg_is_arrayacc )) { diff = TRUE; } this_arg_is_scalar = !type_lookup(cur_array_table, this_call->astnode.ident.name); other_arg_is_scalar = !type_lookup(cur_array_table, other_call->astnode.ident.name); if( (dptr[0] == '[') && (this_arg_is_scalar != other_arg_is_scalar )) { diff = TRUE; } other_call = other_call->nextstmt; dptr = bc_next_desc_token(dptr); } return diff; } /***************************************************************************** * * * emit_adapters * * * * This function generates any adapters necessary to * * allow functions to pass array elements by reference. * * * *****************************************************************************/ void emit_adapters() { char *tmpdesc, *ret_desc, *cur_name = NULL, *cur_desc=NULL; JVM_METHOD *adapter_method; HASHNODE *hashtemp; JVM_METHODREF *mref; Dlist p; AST *cval; dl_traverse(p,adapter_list) { cval = (AST *)dl_val(p); cur_name=(char *)f2jrealloc(cur_name,strlen(cval->astnode.ident.name)+10); strcpy(cur_name, cval->astnode.ident.name); strcat(cur_name, "_adapter"); adapter_method = bc_new_method(cur_class_file, cur_name, NULL, F2J_ADAPTER_ACC); hashtemp = type_lookup(function_table, cval->astnode.ident.name); if(hashtemp) { char *tempname; mref = (JVM_METHODREF *)f2jalloc(sizeof(JVM_METHODREF)); tmpdesc = get_adapter_desc(hashtemp->variable->astnode.source.descriptor, cval->astnode.ident.arraylist); if(hashtemp->variable->nodetype == Function) ret_desc = field_descriptor[hashtemp->variable->astnode.source.returns][0]; else ret_desc = "V"; cur_desc = (char *)f2jrealloc(cur_desc, strlen(tmpdesc) + strlen(ret_desc) + 10); strcpy(cur_desc,"("); strcat(cur_desc,tmpdesc); strcat(cur_desc,")"); strcat(cur_desc,ret_desc); tempname = strdup( cval->astnode.ident.name ); *tempname = toupper(*tempname); mref->classname = bc_get_full_classname(tempname, package_name); mref->methodname = strdup( hashtemp->variable->astnode.source.name->astnode.ident.name); mref->descriptor = strdup(hashtemp->variable->astnode.source.descriptor); adapter_emit_from_descriptor(adapter_method, mref, cval); bc_free_fieldref(mref); f2jfree(tmpdesc, strlen(tmpdesc)+1); f2jfree(tempname, strlen(tempname)+1); } else { if(gendebug) printf("looking up descriptor for %s\n",cval->astnode.ident.name); mref = find_method(cval->astnode.ident.name, descriptor_table); if(mref) { char *ret = get_return_type_from_descriptor(mref->descriptor); if(gendebug) printf("--- ret is '%s'\n", ret); if(ret[0] == 'V') ret_desc = "V"; else ret_desc = field_descriptor[get_type_from_field_desc(ret)][0]; /* tmpdesc = get_desc_from_arglist(cval->astnode.ident.arraylist); */ tmpdesc = get_adapter_desc(mref->descriptor, cval->astnode.ident.arraylist); cur_desc = (char *)f2jrealloc(cur_desc, strlen(tmpdesc) + strlen(ret_desc) + 10); strcpy(cur_desc,"("); strcat(cur_desc,tmpdesc); strcat(cur_desc,")"); strcat(cur_desc,ret_desc); adapter_emit_from_descriptor(adapter_method, mref, cval); f2jfree(tmpdesc, strlen(tmpdesc)+1); f2jfree(ret, strlen(ret)+1); } else { fprintf(stderr,"Could not generate adapter for '%s'\n", cval->astnode.ident.name); /* assume that since cur_name was already allocated strlen(var)+10 * bytes and "BAD_ADAP" requires less than 10 bytes, there's no need * to realloc here. but if we hit this case, then cur_desc may not * have any memory allocated yet, so call realloc here. */ strcpy(cur_name, "BAD_ADAP"); cur_desc=(char *)f2jrealloc(cur_name,4); strcpy(cur_desc, "()V"); } } fprintf(indexfp,"%s:%s:%s\n",cur_filename, cur_name, cur_desc); /* Now we know the descriptor for this adapter, so set the field in * the method struct accordingly. */ bc_set_method_descriptor(adapter_method, cur_desc); } if(cur_desc) f2jfree(cur_desc, strlen(cur_desc)+1); if(cur_name) f2jfree(cur_name, strlen(cur_name)+1); } /***************************************************************************** * * * adapter_emit_from_descriptor * * * * This function generates an adapters, in situations where the prototype * * cannot be found in the symbol table. instead, we look for the descriptor * * in any .f2j files in F2J_SEARCH_PATH. * * * *****************************************************************************/ void adapter_emit_from_descriptor(JVM_METHOD *meth, JVM_METHODREF *mref, AST *node) { enum returntype ret_type; char *ret; int lv_temp, retval_varnum = 0; ret_type = Integer; /* init just to quiet a compiler warning */ fprintf(curfp,"// adapter for %s%s\n", node->astnode.ident.name, mref->descriptor); ret = get_return_type_from_descriptor(mref->descriptor); if((ret == NULL) || (ret[0] == '[') || (ret[0] == 'L')) { fprintf(stderr,"Not expecting NULL, reference, or array return type "); fprintf(stderr,"for adapter '%s'\n", node->astnode.ident.name); f2jfree(ret,strlen(ret)+1); return; } if(ret[0] == 'V') fprintf(curfp,"private static void %s_adapter(", node->astnode.ident.name); else { fprintf(curfp,"private static %s %s_adapter(", returnstring[get_type_from_field_desc(ret)], node->astnode.ident.name); ret_type = get_type_from_field_desc(ret); } adapter_args_emit_from_descriptor(meth, node->astnode.ident.arraylist, mref->descriptor); fprintf(curfp,")\n{\n"); lv_temp = meth->cur_local_number; adapter_temps_emit_from_descriptor(meth, node->astnode.ident.arraylist, mref->descriptor); adapter_methcall_emit_from_descriptor(meth, node, lv_temp, mref, ret); if(ret[0] != 'V') { retval_varnum = bc_get_next_local(meth, jvm_data_types[ret_type]); bc_gen_store_op(meth, retval_varnum, jvm_data_types[ret_type]); } adapter_assign_emit_from_descriptor(meth, node->astnode.ident.arraylist, lv_temp, mref->descriptor); if(ret[0] != 'V') { fprintf(curfp,"\nreturn %s_retval;\n", node->astnode.ident.name); bc_gen_load_op(meth, retval_varnum, jvm_data_types[ret_type]); bc_append(meth, return_opcodes[ret_type]); } else bc_append(meth, jvm_return); fprintf(curfp,"}\n\n"); f2jfree(ret,strlen(ret)+1); } /***************************************************************************** * * * adapter_args_emit_from_descriptor * * * * this function generates the argument list for an adapter, when the * * prototype cannot be found in the symbol table. * * * *****************************************************************************/ void adapter_args_emit_from_descriptor(JVM_METHOD *meth, AST *arg, char *desc) { enum returntype ctype; char *dptr; int i, lvnum; dptr = bc_next_desc_token(desc); lvnum = 0; for(i = 0; arg != NULL ; arg = arg->nextstmt, i++) { arg->astnode.ident.localvnum = lvnum; if(dptr == NULL) { fprintf(stderr,"adapter_args_emit_from_descriptor():"); fprintf(stderr,"mismatch between adapter call and prototype\n"); break; } ctype = get_type_from_field_desc(dptr); if(gendebug) printf("adapter_args.. arg=%s dptr = '%s'\n", arg->astnode.ident.name,dptr); if(dptr[0] == '[') { if(type_lookup(cur_array_table,arg->astnode.ident.name)) { if(get_type_from_field_desc(dptr+1) == arg->vartype) { fprintf(curfp,"%s [] arg%d , int arg%d_offset ", returnstring[get_type_from_field_desc(dptr+1)], i, i); lvnum += 2; } else { fprintf(curfp,"%s [] arg%d , int arg%d_offset ", returnstring[arg->vartype], i, i); lvnum += 2; } } else { fprintf(curfp,"%s arg%d ", wrapper_returns[get_type_from_field_desc(dptr+1)], i); lvnum++; } /* consume the offset arg */ dptr = bc_next_desc_token(dptr); } else if ( (arg->nodetype == Identifier) && /* (arg->astnode.ident.arraylist != NULL) && */ type_lookup(cur_array_table,arg->astnode.ident.name) && (dptr[0] != '[') ) { if(omitWrappers && !isPassByRef_desc(dptr)) { fprintf(curfp,"%s arg%d ", returnstring[ctype], i); if(ctype == Double) lvnum += 2; else lvnum++; } else { fprintf(curfp,"%s [] arg%d , int arg%d_offset ", returnstring[ctype], i, i); lvnum += 2; } } else if( type_lookup(cur_external_table, arg->astnode.ident.name) ) { fprintf(curfp,"Object arg%d ", i); lvnum++; } else { if(omitWrappers && !isPassByRef_desc(dptr)) { fprintf(curfp,"%s arg%d ", returnstring[ctype], i); if(ctype == Double) lvnum += 2; else lvnum++; } else { fprintf(curfp,"%s arg%d ", wrapper_returns[ctype], i); lvnum++; } } dptr = bc_next_desc_token(dptr); if(arg->nextstmt != NULL) fprintf(curfp,","); } /* set current local variable number to compensate for the method's * arguments. */ bc_set_cur_local_num(meth, lvnum); } /***************************************************************************** * * * adapter_tmp_assign_emit * * * * this function generates the bytecode for the assignment to a temp * * variable in the adapter. for example: * * _f2j_tmp3 = new intW(arg3[arg3_offset]) * * * *****************************************************************************/ void adapter_tmp_assign_emit(JVM_METHOD *meth, int arglocal, enum returntype argtype) { int c; char *classname, *desc; classname = full_wrappername[argtype]; desc = wrapper_descriptor[argtype]; c = cp_find_or_insert(cur_class_file,CONSTANT_Class, classname); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); /* emit arg%d[arg%d_offset] */ bc_gen_load_op(meth, arglocal, jvm_Object); bc_gen_load_op(meth, arglocal + 1, jvm_Int); bc_gen_array_load_op(meth, jvm_data_types[argtype]); c = bc_new_methodref(cur_class_file, classname, "", desc); bc_append(meth, jvm_invokespecial, c); /* now assign value to next local */ bc_gen_store_op(meth, bc_get_next_local(meth, jvm_Object), jvm_Object); } /***************************************************************************** * * * adapter_tmp_array_assign_emit * * * * this function generates the bytecode for the assignment to a temp * * variable in the adapter. for example: * * int [] _f2j_tmp3 = new int[1]; * * * *****************************************************************************/ void adapter_tmp_array_assign_emit(JVM_METHOD *meth, int arglocal, enum returntype argtype) { int c; bc_append(meth, jvm_iconst_1); newarray_emit(meth, argtype); bc_append(meth, jvm_dup); bc_append(meth, jvm_iconst_0); bc_gen_load_op(meth, arglocal, jvm_Object); c = bc_new_fieldref(cur_class_file, full_wrappername[argtype], "val", val_descriptor[argtype]); bc_append(meth, jvm_getfield, c); bc_gen_array_store_op(meth, jvm_data_types[argtype]); bc_gen_store_op(meth, bc_get_next_local(meth, jvm_Object), jvm_Object); } /***************************************************************************** * * * adapter_tmp_array_new_emit * * * * this function generates the bytecode for the assignment to a temp * * variable in the adapter. for example: * * int [] _f2j_tmp3 = new int[arg3.length]; * * * *****************************************************************************/ void adapter_tmp_array_new_emit(JVM_METHOD *meth, int arglocal, enum returntype argtype) { bc_gen_load_op(meth, arglocal, jvm_Object); bc_append(meth, jvm_arraylength); newarray_emit(meth, argtype); bc_gen_store_op(meth, bc_get_next_local(meth, jvm_Object), jvm_Object); } /***************************************************************************** * * * adapter_temps_emit_from_descriptor * * * * this function generates the temporary variable declarations for an * * adapter, when the prototype cannot be found in the symbol table. * * * *****************************************************************************/ void adapter_temps_emit_from_descriptor(JVM_METHOD *meth, AST *arg, char *desc) { char *dptr, *wrapper; int i; dptr = bc_next_desc_token(desc); for(i = 0; arg != NULL ; arg = arg->nextstmt, i++) { if(dptr == NULL) break; if((arg->nodetype == Identifier) && /* (arg->astnode.ident.arraylist != NULL) && */ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) && (dptr[0] != '[')) { wrapper = get_wrapper_from_desc(dptr); if(omitWrappers) { if(isPassByRef_desc(dptr)) { fprintf(curfp,"%s _f2j_tmp%d = new %s(arg%d[arg%d_offset]);\n", wrapper, i, wrapper, i, i); adapter_tmp_assign_emit(meth, arg->astnode.ident.localvnum, get_type_from_field_desc(dptr)); } } else { fprintf(curfp,"%s _f2j_tmp%d = new %s(arg%d[arg%d_offset]);\n", wrapper, i, wrapper, i, i); adapter_tmp_assign_emit(meth, arg->astnode.ident.localvnum, get_type_from_field_desc(dptr)); } f2jfree(wrapper, strlen(wrapper)+1); } else if(dptr[0] == '[') { if(! type_lookup(cur_array_table,arg->astnode.ident.name)) { enum returntype ctype = get_type_from_field_desc(dptr); fprintf(curfp,"%s [] _f2j_tmp%d = { arg%d.val };\n", returnstring[ctype], i, i); adapter_tmp_array_assign_emit(meth, arg->astnode.ident.localvnum, ctype); } else if(get_type_from_field_desc(dptr+1) != arg->vartype) { enum returntype ctype = get_type_from_field_desc(dptr); fprintf(curfp,"%s [] _f2j_tmp%d = new %s[arg%d.length];\n", returnstring[ctype], i, returnstring[ctype], i); adapter_tmp_array_new_emit(meth, arg->astnode.ident.localvnum, ctype); } dptr = bc_next_desc_token(dptr); } dptr = bc_next_desc_token(dptr); } } /***************************************************************************** * * * adapter_methcall_emit_from_descriptor * * * * this function generates the actual method call within the adapter. * * used in the case when the prototype is not found in the symbol table. * * * *****************************************************************************/ void adapter_methcall_emit_from_descriptor(JVM_METHOD *meth, AST *node, int lv_temp, JVM_METHODREF *mref, char *ret) { char *tempname, *dptr; int c; AST *arg; int i; if((mref->classname != NULL) && (strlen(mref->classname) > 0)) tempname = char_substitution(mref->classname, '/', '.'); else { tempname = strdup( node->astnode.ident.name ); *tempname = toupper(*tempname); } if(ret[0] == 'V') fprintf(curfp,"\n%s.%s(",tempname, node->astnode.ident.name ); else { fprintf(curfp,"%s %s_retval;\n\n", ret, node->astnode.ident.name); fprintf(curfp,"%s_retval = %s.%s(", node->astnode.ident.name, tempname, node->astnode.ident.name ); } dptr = bc_next_desc_token(mref->descriptor); arg = node->astnode.ident.arraylist; for(i = 0; arg != NULL ; arg = arg->nextstmt, i++) { if(dptr == NULL) break; lv_temp = adapter_methcall_arg_emit(meth, arg, i, lv_temp, dptr); /* skip extra field desc to compensate for offset arg */ if(dptr[0] == '[') dptr = bc_next_desc_token(dptr); dptr = bc_next_desc_token(dptr); if(arg->nextstmt != NULL) fprintf(curfp,","); } fprintf(curfp,");\n\n"); c = bc_new_methodref(cur_class_file, mref->classname, mref->methodname,mref->descriptor); bc_append(meth, jvm_invokestatic, c); f2jfree(tempname, strlen(tempname)+1); } /***************************************************************************** * * * adapter_methcall_arg_emit * * * * emit the argument to an adapter methodcall. * * * *****************************************************************************/ int adapter_methcall_arg_emit(JVM_METHOD *meth, AST *arg, int i, int lv, char *dptr) { if((arg->nodetype == Identifier) && /* (arg->astnode.ident.arraylist != NULL) && */ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) && (dptr[0] != '[')) { if(omitWrappers && !isPassByRef_desc(dptr)) { fprintf(curfp,"arg%d",i); bc_gen_load_op(meth, arg->astnode.ident.localvnum, jvm_data_types[get_type_from_field_desc(dptr)]); } else { fprintf(curfp,"_f2j_tmp%d",i); bc_gen_load_op(meth, lv++, jvm_Object); } } else if( ! type_lookup(cur_array_table,arg->astnode.ident.name) && (dptr[0] == '[')) { fprintf(curfp,"_f2j_tmp%d, 0",i); bc_gen_load_op(meth, lv++, jvm_Object); bc_append(meth, jvm_iconst_0); } else if((arg->nodetype == Identifier) && (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) && (dptr[0] == '[')) { if(get_type_from_field_desc(dptr+1) == arg->vartype) { fprintf(curfp,"arg%d, arg%d_offset",i,i); bc_gen_load_op(meth, arg->astnode.ident.localvnum, jvm_Object); bc_gen_load_op(meth, arg->astnode.ident.localvnum+1, jvm_Int); } else { fprintf(curfp,"_f2j_tmp%d, arg%d_offset",i,i); bc_gen_load_op(meth, lv++, jvm_Object); bc_gen_load_op(meth, arg->astnode.ident.localvnum+1, jvm_Int); } } else { fprintf(curfp,"arg%d",i); if(isPassByRef_desc(dptr)) bc_gen_load_op(meth, arg->astnode.ident.localvnum, jvm_Object); else bc_gen_load_op(meth, arg->astnode.ident.localvnum, jvm_data_types[get_type_from_field_desc(dptr)]); } return lv; } /***************************************************************************** * * * adapter_assign_emit_from_descriptor * * * * this function emits the final assignments back to the array elements * * after the call (when we cannot find the prototype in the sybmol table). * * * *****************************************************************************/ void adapter_assign_emit_from_descriptor(JVM_METHOD *meth, AST *arg, int lv_temp, char *desc) { char *dptr; int i; dptr = bc_next_desc_token(desc); for(i = 0; arg != NULL ; arg = arg->nextstmt, i++) { if(dptr == NULL) break; if((arg->nodetype == Identifier) && /* (arg->astnode.ident.arraylist != NULL) && */ (type_lookup(cur_array_table,arg->astnode.ident.name) != NULL) && (dptr[0] != '[')) { if(omitWrappers) { if(isPassByRef_desc(dptr)) adapter_assign_emit(meth, i,arg->astnode.ident.localvnum,lv_temp++,dptr); } else { adapter_assign_emit(meth, i,arg->astnode.ident.localvnum,lv_temp++,dptr); } } else if(dptr[0] == '[') { if( !type_lookup(cur_array_table,arg->astnode.ident.name) ) { adapter_array_assign_emit(meth, i,arg->astnode.ident.localvnum, lv_temp++,dptr); } else if(get_type_from_field_desc(dptr+1) != arg->vartype) { lv_temp++; } /* skip extra field desc to compensate for offset arg */ dptr = bc_next_desc_token(dptr); } dptr = bc_next_desc_token(dptr); } } /***************************************************************************** * * * adapter_assign_emit * * * * emit the assignment back to the array element. * * * *****************************************************************************/ void adapter_assign_emit(JVM_METHOD *meth, int i, int argvnum, int lv, char *dptr) { enum returntype vt; int c; fprintf(curfp,"arg%d[arg%d_offset] = _f2j_tmp%d.val;\n",i,i,i); vt = get_type_from_field_desc(dptr); bc_gen_load_op(meth, argvnum, jvm_Object); bc_gen_load_op(meth, argvnum+1, jvm_Int); bc_gen_load_op(meth, lv, jvm_Object); c = bc_new_fieldref(cur_class_file, full_wrappername[vt], "val", val_descriptor[vt]); bc_append(meth, jvm_getfield, c); bc_gen_array_store_op(meth, jvm_data_types[vt]); } /***************************************************************************** * * * adapter_array_assign_emit * * * * emit the assignment back to the wrapper from the array element. * * * * arg3.val = _f2j_tmp3[0]; * * * *****************************************************************************/ void adapter_array_assign_emit(JVM_METHOD *meth, int i, int argvnum, int lv, char *dptr) { enum returntype vt; int c; fprintf(curfp,"arg%d.val = _f2j_tmp%d[0];\n",i,i); if(gendebug) printf("#@@# calling get_type_from_field_desc(%s) = ", dptr); vt = get_type_from_field_desc(dptr); if(gendebug) printf(" '%s'\n", returnstring[vt]); bc_gen_load_op(meth, argvnum, jvm_Object); bc_gen_load_op(meth, lv, jvm_Object); bc_append(meth, jvm_iconst_0); bc_gen_array_load_op(meth, jvm_data_types[vt]); c = bc_new_fieldref(cur_class_file, full_wrappername[vt], "val", val_descriptor[vt]); bc_append(meth, jvm_putfield, c); } /***************************************************************************** * * * get_desc_from_arglist * * * * this function generates the argument descriptors based on an the list * * of arguments. note that the descriptor returned does not include the * * parens or return type because in some cases, we need to prepend or append * * args to the descriptor. * * * *****************************************************************************/ char * get_desc_from_arglist(AST *list) { struct _str * temp_desc = NULL; HASHNODE *ht; AST *arg; char *p; int dim; for(arg = list; arg != NULL; arg = arg->nextstmt) { dim = 0; if(omitWrappers) { if( arg->nodetype == Identifier ) { ht = type_lookup(cur_type_table,arg->astnode.ident.name); if(ht) { dim = ht->variable->astnode.ident.dim > 0; temp_desc = strAppend(temp_desc, field_descriptor[ht->variable->vartype][dim]); } else { dim = arg->astnode.ident.dim > 0; temp_desc = strAppend(temp_desc, field_descriptor[arg->vartype][dim]); } } else if( arg->nodetype == Constant ) temp_desc = strAppend(temp_desc, field_descriptor[get_type(arg->astnode.constant.number)][0]); else temp_desc = strAppend(temp_desc, field_descriptor[arg->vartype][0]); } else { if( arg->nodetype == Identifier ) { ht = type_lookup(cur_type_table,arg->astnode.ident.name); if(ht) { dim = ht->variable->astnode.ident.dim > 0; temp_desc = strAppend(temp_desc, wrapped_field_descriptor[ht->variable->vartype][dim]); } else { dim = arg->astnode.ident.dim > 0; temp_desc = strAppend(temp_desc, wrapped_field_descriptor[arg->vartype][dim]); } } else if( arg->nodetype == Constant ) temp_desc = strAppend(temp_desc, wrapped_field_descriptor[get_type(arg->astnode.constant.number)][0]); else temp_desc = strAppend(temp_desc, wrapped_field_descriptor[arg->vartype][0]); } if(dim) temp_desc = strAppend(temp_desc, "I"); } p = temp_desc->val; f2jfree(temp_desc, sizeof(struct _str)); return p; } /***************************************************************************** * * * emit_invocations * * * * This function generates adapter functions which use reflection to * * call another method. This is used to implement passing functions as * * arguments. * * * *****************************************************************************/ void emit_invocations() { JVM_METHOD *meth; Dlist p, tmplist; int count, obj_array_varnum; char *cur_name=NULL, *cur_desc=NULL, *tmpdesc; int c; AST *temp; dl_traverse(p,methcall_list) { tmplist = (Dlist) dl_val(p); temp = (AST *) dl_val(dl_first(tmplist)); /* allocate enough space for the name + "_methcall" and null-term */ cur_name = (char *)f2jrealloc(cur_name, strlen(temp->astnode.ident.name) + 10); strcpy(cur_name, temp->astnode.ident.name); strcat(cur_name, "_methcall"); fprintf(curfp,"// reflective method invocation for %s\n", temp->astnode.ident.name); fprintf(curfp,"private static %s %s(", returnstring[temp->vartype], cur_name); fprintf(curfp,"java.lang.reflect.Method _funcptr"); tmpdesc = get_desc_from_arglist(temp->astnode.ident.arraylist); cur_desc = (char *)f2jrealloc(cur_desc, strlen(tmpdesc) + strlen(METHOD_CLASS) + strlen(field_descriptor[temp->vartype][0]) + 10); strcpy(cur_desc, "("); strcat(cur_desc, "L"); strcat(cur_desc, METHOD_CLASS); strcat(cur_desc, ";"); strcat(cur_desc, tmpdesc); strcat(cur_desc, ")"); strcat(cur_desc, field_descriptor[temp->vartype][0]); meth = bc_new_method(cur_class_file, cur_name, cur_desc, F2J_ADAPTER_ACC); bc_add_method_exception(meth, "java.lang.reflect.InvocationTargetException"); bc_add_method_exception(meth, "java.lang.IllegalAccessException"); count = methcall_arglist_emit(temp); fprintf(curfp,")\n throws java.lang.reflect.InvocationTargetException,\n"); fprintf(curfp," java.lang.IllegalAccessException\n{\n"); fprintf(curfp,"Object [] _funcargs = new Object [%d];\n", count); fprintf(curfp,"%s _retval;\n", returnstring[temp->vartype]); /* create a new object array and store it in the first local var */ bc_push_int_const(meth, count); c = cp_find_or_insert(cur_class_file, CONSTANT_Class, "java/lang/Object"); bc_append(meth, jvm_anewarray, c); obj_array_varnum = bc_get_next_local(meth, jvm_Object); bc_gen_store_op(meth, obj_array_varnum, jvm_Object); methcall_obj_array_emit(meth, temp, obj_array_varnum); fprintf(curfp, "_retval = ( (%s) _funcptr.invoke(null,_funcargs)).%sValue();\n", java_wrapper[temp->vartype], returnstring[temp->vartype]); /* load _funcptr, which should always be local var 0 */ bc_gen_load_op(meth, 0, jvm_Object); bc_append(meth, jvm_aconst_null); bc_gen_load_op(meth, obj_array_varnum, jvm_Object); c = bc_new_methodref(cur_class_file, METHOD_CLASS, "invoke", INVOKE_DESC); bc_append(meth, jvm_invokevirtual, c); c = cp_find_or_insert(cur_class_file,CONSTANT_Class, numeric_wrapper[temp->vartype]); bc_append(meth, jvm_checkcast, c); c = bc_new_methodref(cur_class_file,numeric_wrapper[temp->vartype], numericValue_method[temp->vartype], numericValue_descriptor[temp->vartype]); bc_append(meth, jvm_invokevirtual, c); bc_append(meth, return_opcodes[temp->vartype]); fprintf(curfp,"return _retval;\n"); fprintf(curfp,"}\n"); fprintf(indexfp,"%s:%s:%s\n",cur_filename, cur_name, cur_desc); f2jfree(tmpdesc, strlen(tmpdesc)+1); } if(cur_name) f2jfree(cur_name, strlen(cur_name)+1); if(cur_desc) f2jfree(cur_desc, strlen(cur_desc)+1); } /***************************************************************************** * * * methcall_arglist_emit * * * * This function generates the list of arguments to the method adapter. * * the return value is an integer representing the number of arguments. * * * *****************************************************************************/ int methcall_arglist_emit(AST *temp) { enum returntype rtype; HASHNODE *ht; int count=0, dim; AST *arg; for(arg = temp->astnode.ident.arraylist; arg != NULL; arg = arg->nextstmt) { fprintf(curfp,","); dim = arg->astnode.ident.dim; if(omitWrappers) { if( arg->nodetype == Identifier ) { ht = type_lookup(cur_type_table,arg->astnode.ident.name); if(ht) { rtype = ht->variable->vartype; dim = ht->variable->astnode.ident.dim; } else rtype = arg->vartype; } else if( arg->nodetype == Constant ) rtype = get_type(arg->astnode.constant.number); else rtype = arg->vartype; if(dim >0) fprintf(curfp," %s [] _arg%d ", returnstring[rtype], count); else fprintf(curfp," %s _arg%d ", returnstring[rtype], count); } else { if( arg->nodetype == Identifier ) { ht = type_lookup(cur_type_table,arg->astnode.ident.name); if(ht) { rtype = ht->variable->vartype; dim = ht->variable->astnode.ident.dim; } else rtype = arg->vartype; } else if( arg->nodetype == Constant ) rtype = get_type(arg->astnode.constant.number); else rtype = arg->vartype; if(dim >0) fprintf(curfp," %s [] _arg%d ", wrapper_returns[rtype], count); else fprintf(curfp," %s _arg%d ", wrapper_returns[rtype], count); } if(dim > 0) { fprintf(curfp,", int _arg%d_offset ", count); /* normally, we'd increment count by two, but i'm hacking this * a bit so that the lapack tester works correctly. */ /* count += 2; */ } count++; } return count; } /***************************************************************************** * * * methcall_obj_array_emit * * * * This function generates the initialization of the object array which we * * must pass to the reflective invoke call. * * * *****************************************************************************/ void methcall_obj_array_emit(JVM_METHOD *meth, AST *temp, int lv) { enum returntype rtype; HASHNODE *ht; int ai = 0, vi = 1, dim; AST *arg; rtype = Integer; /* just here to quiet a compiler warning */ for(arg=temp->astnode.ident.arraylist;arg!=NULL;arg=arg->nextstmt,ai++,vi++) { dim = arg->astnode.ident.dim; if(omitWrappers) { if( arg->nodetype == Identifier ) { ht = type_lookup(cur_type_table,arg->astnode.ident.name); if(ht) { rtype = ht->variable->vartype; dim = ht->variable->astnode.ident.dim; } else rtype = arg->vartype; } else if( arg->nodetype == Constant ) rtype = get_type(arg->astnode.constant.number); else rtype = arg->vartype; fprintf(curfp," _funcargs[%d] = new %s(", ai,java_wrapper[rtype]); if(dim > 0) { fprintf(curfp,"_arg%d[_arg%d_offset]);\n", ai, ai); arg_array_assign_emit(cur_class_file, meth, lv, ai, vi, rtype); vi++; } else { fprintf(curfp,"_arg%d);\n", ai); arg_assignment_emit(cur_class_file, meth, lv, ai, vi, TRUE, rtype); } } else { if(dim > 0) { fprintf(curfp," _funcargs[%d] = _arg%d[_arg%d_offset];\n",ai,ai,ai); arg_array_assign_emit(cur_class_file, meth, lv, ai, vi, rtype); vi++; } else { fprintf(curfp," _funcargs[%d] = _arg%d;\n",ai,ai); arg_assignment_emit(cur_class_file, meth, lv, ai, vi, FALSE, rtype); } } if((rtype == Double) && (dim == 0)) vi++; } } /***************************************************************************** * * * arg_array_assign_emit * * * * this function emits the bytecode for an assignment of an argument to the * * object array (e.g. _funcargs[%d] = _arg%d[_arg%d_offset]). * * * *****************************************************************************/ void arg_array_assign_emit(JVM_CLASS *cclass, JVM_METHOD *meth, int array_vnum, int array_idx, int arg_vnum, enum returntype argtype) { int c; bc_gen_load_op(meth, array_vnum, jvm_Object); bc_push_int_const(meth, array_idx); c = cp_find_or_insert(cclass,CONSTANT_Class, numeric_wrapper[argtype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); bc_gen_load_op(meth, arg_vnum, jvm_Object); bc_gen_load_op(meth, arg_vnum + 1, jvm_Int); bc_gen_array_load_op(meth, jvm_data_types[argtype]); c = bc_new_methodref(cclass, numeric_wrapper[argtype], "", wrapper_descriptor[argtype]); bc_append(meth, jvm_invokespecial, c); bc_gen_array_store_op(meth, jvm_data_types[Object]); } /***************************************************************************** * * * arg_assignment_emit * * * * this function emits the bytecode for an assignment of an argument to the * * object array (e.g. _funcargs[%d] = _arg%d). * * * *****************************************************************************/ void arg_assignment_emit(JVM_CLASS *cclass, JVM_METHOD *meth, int array_vnum, int array_idx, int arg_vnum, BOOL wrap, enum returntype argtype) { int c; bc_gen_load_op(meth, array_vnum, jvm_Object); bc_push_int_const(meth, array_idx); if(wrap) { c = cp_find_or_insert(cclass,CONSTANT_Class, numeric_wrapper[argtype]); bc_append(meth, jvm_new,c); bc_append(meth, jvm_dup); bc_gen_load_op(meth, arg_vnum, jvm_data_types[argtype]); c = bc_new_methodref(cclass, numeric_wrapper[argtype], "", wrapper_descriptor[argtype]); bc_append(meth, jvm_invokespecial, c); } else bc_gen_load_op(meth, arg_vnum, jvm_data_types[argtype]); bc_append(meth, jvm_aastore); } /***************************************************************************** * * * char_substitution * * * * this function substitutes every occurrence of 'from_char' with 'to_char' * * typically this is used to convert package names: * * * * e.g. "java.lang.whatever" -> "java/lang/whatever" * * * *****************************************************************************/ char * char_substitution(char *str, int from_char, int to_char) { char *newstr = strdup(str); char *idx; while( (idx = strchr(newstr, from_char)) != NULL ) *idx = to_char; return newstr; } #ifdef VCG_CONTROL_FLOW /***************************************************************************** * * * cfg_emit * * * * this function generates a VCG (visualization of compiler graphs) file * * containing a representation of the control flow graph. * * * *****************************************************************************/ void cfg_emit(Dlist cgraph, char *mname) { JVM_CODE_GRAPH_NODE *val; char *filename, *warn; char node_label[200]; FILE *v; Dlist tmp; filename = (char *)f2jalloc(strlen(cur_filename) + strlen(mname) + 10); sprintf(filename, "%s_%s.cfg", cur_filename, mname); v = fopen(filename,"w"); if(v) { print_vcg_header(v, "Control Flow Graph"); dl_traverse(tmp,cgraph) { val = (JVM_CODE_GRAPH_NODE *) tmp->val; if(!val->visited) warn = "(UNVISITED!!)"; else warn = ""; sprintf(node_label,"%d: %s %s\nstack_pre: %d", val->pc, jvm_opcode[val->op].op, warn, val->stack_depth); print_vcg_node(v, val->pc, node_label); if((val->next != NULL) && (val->op != jvm_goto) && (val->op != jvm_goto_w)) print_vcg_nearedge(v, val->pc, val->next->pc); if(val->branch_target != NULL) print_vcg_edge(v, val->pc, val->branch_target->pc); } print_vcg_trailer(v); fclose(v); } else fprintf(stderr, "couldn't open vcg file: '%s'\n",filename); } #endif /***************************************************************************** * * * assign_varnums_to_arguments * * * * This routine numbers the local variables for generating bytecode. * * * * Horribly kludged routines with massive loop of * * duplicated code. * * * * ...cleaned this routine up somewhat. --kgs 5/5/00 * * * *****************************************************************************/ int assign_varnums_to_arguments(AST * root) { AST * locallist; HASHNODE * hashtemp, * ht2; int localnum = 0; /* if root is NULL, this is probably a PROGRAM (no args) */ if(root == NULL) return 1; /* This loop takes care of the stuff coming in from the * argument list. */ for (locallist = root ; locallist; locallist = locallist->nextstmt) { if(gendebug) printf("assign_varnums_to_arguments(%s): arg list name: %s, local varnum: %d\n", cur_filename, locallist->astnode.ident.name, localnum); hashtemp = type_lookup(cur_type_table, locallist->astnode.ident.name); if(hashtemp == NULL) { ht2=type_lookup(cur_args_table, locallist->astnode.ident.name); if(ht2) { if(gendebug) printf("assign_varnums_to_arguments(%s):%s in args table, set lvnum: %d\n", cur_filename, locallist->astnode.ident.name, localnum); ht2->variable->astnode.ident.localvnum = localnum; localnum++; continue; } else { fprintf(stderr,"Type table is screwed in assign locals.\n"); fprintf(stderr,"could not find %s\n", locallist->astnode.ident.name); exit(EXIT_FAILURE); } } hashtemp->variable->astnode.ident.localvnum = localnum; /* Check to see if it is a double or if it is an array declaration. * Doubles take up two stack entries, so we increment by 2. Arrays * only take up one stack entry, but we add an integer offset * parameter which takes up an additional entry. * * also check whether this is pass by reference, because objects * always occupy 1 stack entry, even if the data type is double. */ if(gendebug) printf("assign_varnums_to_arguments(%s): name: %s, pass by ref: %s\n", cur_filename, locallist->astnode.ident.name, hashtemp->variable->astnode.ident.passByRef ? "yes" : "no"); if((hashtemp->variable->vartype == Double || hashtemp->variable->astnode.ident.arraylist != NULL) && (!hashtemp->variable->astnode.ident.passByRef)) localnum += 2; else localnum++; if(gendebug) printf("ARG %s %d\n", hashtemp->variable->astnode.ident.name, hashtemp->variable->astnode.ident.localvnum); } return localnum; } /* Close assign_varnums_to_arguments(). */ /***************************************************************************** * * * print_nodetype * * * * This is primarily a debugging tool. Given a node, it returns a * * string containing the node type. * * * *****************************************************************************/ char * print_nodetype (AST *root) { static char temp[100]; if(root == NULL) { return("print_nodetpe: NULL root"); } switch (root->nodetype) { case Source: return("Source"); case Progunit: return("Progunit"); case Subroutine: return("Subroutine"); case Function: return("Function"); case Program: return("Program"); case Blockif: return("Blockif"); case Common: return("Common"); case CommonList: return("CommonList"); case DataStmt: return("DataStmt"); case DataList: return("DataList"); case Elseif: return("Elseif"); case Else: return("Else"); case Forloop: return("Forloop"); case Format: return("Format"); case Constant: return("Constant"); case Method: return("Method"); case Identifier: return("Identifier"); case Label: return("Label"); case Logicalif: return("Logicalif"); case Typedec: return("Typedec"); case Assignment: return("Assignment"); case Expression: return("Expression"); case Return: return("Return"); case Goto: return("Goto"); case Call: return("Call"); case Statement: return("Statement"); case Relationalop: return("Relationalop"); case Logicalop: return("Logicalop"); case Binaryop: return("Binaryop"); case Power: return("Power"); case Unaryop: return("Unaryop"); case Save: return("Save"); case Specification: return("Specification"); case Substring: return("Substring"); case End: return("End"); case Write: return("Write"); case Stop: return("Stop"); case Pause: return("Pause"); case ComputedGoto: return("ComputedGoto"); case ArrayAccess: return("ArrayAccess"); case ArrayDec: return("ArrayDec"); case Read: return("Read"); case EmptyArgList: return("EmptyArgList"); case IoExplist: return("IoExplist"); case IoImpliedLoop: return("IoImpliedLoop"); case DataImpliedLoop: return("DataImpliedLoop"); case Unimplemented: return("Unimplemented"); case Equivalence: return("Equivalence"); case Comment: return("Comment"); case MainComment: return("MainComment"); case Dimension: return("Dimension"); default: sprintf(temp, "print_nodetype(): Unknown Node: %d", root->nodetype); return(temp); } } /***************************************************************************** * * * get_return_type_from_descriptor * * * * given a method descriptor, this function returns the string representing * * the return type of the method. * * * *****************************************************************************/ char * get_return_type_from_descriptor(char *desc) { char *dptr; dptr = desc; /* skip characters until we hit the closing paren, making sure that * we dont go beyond the end of hte string. */ while(*dptr != ')') { if((*dptr == '\0') || (*(dptr+1) == '\0')) { fprintf(stderr,"Could not determine return type for descriptor '%s'\n", desc); return NULL; } dptr++; } /* now skip over the closing paren and return the remaining portion * of the descriptor */ return strdup(dptr+1); } /***************************************************************************** * * * get_retstring_from_field_desc * * * * given a field descriptor, this function returns the string representation * * of the appropriate java data type. * * * *****************************************************************************/ enum returntype get_type_from_field_desc(char * fd) { enum returntype rt = Integer; char * wrap; switch(fd[0]) { case 'B': rt = Integer; break; case 'C': rt = Character; break; case 'D': rt = Double; break; case 'F': rt = Float; break; case 'I': rt = Integer; break; case 'J': rt = Integer; break; case 'S': rt = Integer; break; case 'Z': rt = Logical; break; case 'V': rt = Object; /* no void in the array, so use object instead */ break; case '[': rt = get_type_from_field_desc(fd+1); break; case 'L': wrap = get_wrapper_from_desc(fd); if(!strcmp(wrap, "StringW")) rt = String; else if(!strcmp(wrap, "complexW")) rt = Complex; else if(!strcmp(wrap, "intW")) rt = Integer; else if(!strcmp(wrap, "doubleW")) rt = Double; else if(!strcmp(wrap, "floatW")) rt = Float; else if(!strcmp(wrap, "booleanW")) rt = Logical; else if(!strcmp(wrap, "String")) rt = String; else if(!strcmp(wrap, "Object")) rt = Object; else fprintf(stderr,"get_type_from_field_desc() hit default case '%s'!!\n", fd); f2jfree(wrap, strlen(wrap)+1); break; default: fprintf(stderr,"get_type_from_field_desc() hit default case '%s'!!\n", fd); rt = Integer; } return rt; } /***************************************************************************** * * * get_wrapper_from_desc * * * * given the descriptor of one of the numeric wrappers, return just the * * last part (e.g. Integer, Double, etc). assume that desc points to the * * initial 'L' of the field descriptor, but may contain extraneous chars * * after the final ';'. * * * *****************************************************************************/ char * get_wrapper_from_desc(char *desc) { char *ls, *dptr, *new; ls = dptr = desc; while( *dptr != ';' ) { if(*dptr == '\0') return desc; if(*dptr == '/') ls = dptr; dptr++; } new = strdup(ls+1); new[(int)(dptr-ls-1)] = '\0'; return new; } /***************************************************************************** * * * get_field_desc_from_ident * * * * given the AST node of some identifier, return the appropriate field * * descriptor. * * * *****************************************************************************/ char * get_field_desc_from_ident(AST *node) { char *fdesc; int isArray = node->astnode.ident.dim > 0; if(omitWrappers && !node->astnode.ident.passByRef) fdesc = field_descriptor[node->vartype][isArray]; else fdesc = wrapped_field_descriptor[node->vartype][isArray]; return fdesc; } /***************************************************************************** * * * get_adapter_desc * * * * given a pointer to the function arg list, this function returns the * * corresponding descriptor. * * * *****************************************************************************/ char * get_adapter_desc(char *dptr, AST *arg) { struct _str * temp_desc = NULL; char *p; int i; dptr = bc_next_desc_token(dptr); for(i = 0; arg != NULL ; arg = arg->nextstmt, i++) { if(dptr == NULL) { fprintf(stderr,"get_adapter_desc():"); fprintf(stderr,"mismatch between adapter call and prototype\n"); break; } if(dptr[0] == '[') { if(!type_lookup(cur_array_table,arg->astnode.ident.name)) { temp_desc = strAppend(temp_desc, wrapped_field_descriptor[get_type_from_field_desc(dptr+1)][0]); } else { if(arg->vartype == get_type_from_field_desc(dptr+1)) { temp_desc = strAppend(temp_desc, field_descriptor[get_type_from_field_desc(dptr+1)][1]); temp_desc = strAppend(temp_desc, "I"); } else { temp_desc = strAppend(temp_desc, field_descriptor[arg->vartype][1]); temp_desc = strAppend(temp_desc, "I"); } } dptr = bc_next_desc_token(dptr); } else if ( (arg->nodetype == Identifier) && type_lookup(cur_array_table,arg->astnode.ident.name)) { if(omitWrappers && !isPassByRef_desc(dptr)) { temp_desc = strAppend(temp_desc, field_descriptor[get_type_from_field_desc(dptr)][0]); } else { temp_desc = strAppend(temp_desc, field_descriptor[get_type_from_field_desc(dptr)][1]); temp_desc = strAppend(temp_desc, "I"); } } else if( type_lookup(cur_external_table, arg->astnode.ident.name) ) { temp_desc = strAppend(temp_desc, field_descriptor[Object][0]); } else { if(omitWrappers && !isPassByRef_desc(dptr)) { temp_desc = strAppend(temp_desc, field_descriptor[get_type_from_field_desc(dptr)][0]); } else { temp_desc = strAppend(temp_desc, wrapped_field_descriptor[get_type_from_field_desc(dptr)][0]); } } dptr = bc_next_desc_token(dptr); } p = temp_desc->val; f2jfree(temp_desc, sizeof(struct _str)); return p; } /***************************************************************************** * * * cast_data_stmt * * * * function prints a cast for a data statement and returns the token * * vartype to be pushed onto the stack. * * * * called from: data_scalar_emit * *****************************************************************************/ int cast_data_stmt(AST *LHS, int no_change){ int tok = no_change; if(LHS->vartype == Integer) tok = INTEGER; else if(LHS->vartype == Float) tok = FLOAT; else if(LHS->vartype == Double) tok = DOUBLE; fprintf(curfp, "(%s) ", returnstring[LHS->vartype]); return tok; } /** ** below are functions that we might want to move to the bytecode library ** but the dependency on returntype enum would have to be eliminated. **/ /***************************************************************************** * * * pushVar * * * * pushes a local variable or field onto the stack. * * * *****************************************************************************/ void pushVar(JVM_CLASS *cclass, JVM_METHOD *meth, enum returntype vt, BOOL isArg, char *class, char *name, char *desc, int lv, BOOL deref) { int c; if(gendebug) { /* printf("in pushvar, vartype is %s\n", returnstring[vt]); */ printf(" desc is %s\n", desc); printf(" local varnum is %d\n", lv); } if(isArg || (lv != -1)) { /* for reference types, always use aload */ if((desc[0] == 'L') || (desc[0] == '[')) bc_gen_load_op(meth, lv, jvm_Object); else bc_gen_load_op(meth, lv, jvm_data_types[vt]); } else { c = bc_new_fieldref(cclass, class, name, desc); bc_append(meth, jvm_getstatic, c); } if(deref) { c = bc_new_fieldref(cclass, full_wrappername[vt], "val", val_descriptor[vt]); bc_append(meth, jvm_getfield, c); } } /***************************************************************************** * * * storeVar * * * * stores a value from the stack to a local variable. * * * *****************************************************************************/ void storeVar(JVM_CLASS *cclass, JVM_METHOD *meth, enum returntype vt, BOOL isArg, char *class, char *name, char *desc, int lv, BOOL deref) { int c; if(gendebug) { /* printf("in store, vartype is %s\n", returnstring[vt]); */ printf(" desc is %s\n", desc); printf(" local varnum is %d\n", lv); } if(isArg || (lv != -1)) { /* for reference types, always use aload */ if((desc[0] == 'L') || (desc[0] == '[')) bc_gen_store_op(meth, lv, jvm_Object); else bc_gen_store_op(meth, lv, jvm_data_types[vt]); } else { c = bc_new_fieldref(cclass, class, name, desc); bc_append(meth, jvm_putstatic, c); } if(deref) { c = bc_new_fieldref(cclass, full_wrappername[vt], "val", val_descriptor[vt]); bc_append(meth, jvm_putfield, c); } } /***************************************************************************** * * * escape_double_quotes * * * * Adds backslash escapes to strings that are to be emitted in Java source. * * For example, 'string "with" quotes' -> 'string \"with\" quotes' * * * *****************************************************************************/ char * escape_double_quotes(char *str) { char *newstr; int i, ni; newstr = (char *)malloc(strlen(str) * 2 + 1); if(!newstr) return NULL; ni = 0; for(i=0;i #include #include #include #include"f2j.h" #include"y.tab.h" #include"codegen.h" #include"f2jmem.h" /***************************************************************************** * Following are some fully-qualified class names and method descriptors * * for commonly used methods. * * * * JL_STRING is the fully-qualified name of the String class * * STR_CONST_DESC is the descriptor for the String constructor * * TRIM_DESC is the descriptor for java.lang.String.trim() * * STREQV_DESC is the descriptor for java.lang.String.equalsIgnoreCase() * * SUBSTR_DESC is the descriptor for java.lang.String.substring(int,int) * * F2J_UTIL defines the default name of the f2java utility package. * * UTIL_CLASS is where the insertString() method is defined. * * STRICT_UTIL_CLASS is an fp strict version of UTIL_CLASS. * * INS_DESC is the desc for insertString, used for LHS substring assignments * * JL_SYSTEM is the fully-qualified name of the System class, for System.out * * OUT_DESC is the desc for System.out, the standard output stream. * * STRBUF_DESC is the desc for StringBuffer's constructor. * * * *****************************************************************************/ #define JL_STRING "java/lang/String" #define JL_CHAR "java/lang/Character" #define JL_OBJECT "java/lang/Object" #define JL_NUMBER "java/lang/Number" #define STR_CONST_DESC "(Ljava/lang/String;)V" #define CHAR_ARRAY_DESC "([C)V" #define TRIM_DESC "()Ljava/lang/String;" #define STREQV_DESC "(Ljava/lang/String;)Z" #define SUBSTR_DESC "(II)Ljava/lang/String;" #define STRLEN_DESC "()I" #define F77_READ_DESC "(Ljava/lang/String;Ljava/util/Vector;)I" #define F77_WRITE_DESC "(Ljava/lang/String;Ljava/util/Vector;)V" #define F2J_UTIL "org/netlib/util" #define UTIL_CLASS "org/netlib/util/Util" #define ARRAY_SPEC_CLASS "org/netlib/util/ArraySpec" #define STRICT_UTIL_CLASS "org/netlib/util/StrictUtil" #define INS_DESC "(Ljava/lang/String;Ljava/lang/String;II)Ljava/lang/String;" #define SINGLE_INS_DESC "(Ljava/lang/String;Ljava/lang/String;I)Ljava/lang/String;" #define JL_SYSTEM "java/lang/System" #define PRINTSTREAM "java/io/PrintStream" #define OUT_DESC "Ljava/io/PrintStream;" #define STRINGBUFFER "java/lang/StringBuffer" #define STRBUF_DESC "(Ljava/lang/String;)V" #define REGIONMATCHES_DESC "(ILjava/lang/String;II)Z" #define TOSTRING_DESC "()Ljava/lang/String;" #define VEC_ADD_DESC "(Ljava/lang/Object;)V" #define VEC_REMOVE_DESC "(I)Ljava/lang/Object;" #define CHARAT_DESC "(I)C" #define COMPARE_DESC "(Ljava/lang/String;)I" #define VECTOR_CLASS "java/util/Vector" #define VECTOR_DESC "()V" #define EASYIN_CLASS "org/netlib/util/EasyIn" #define EASYIN_DESC "()V" #define ETIME_CLASS "org/netlib/util/Etime" #define ETIME_DESC "()V" #define SECOND_CLASS "org/netlib/util/Second" #define IOEXCEPTION "java/io/IOException" #define METHOD_CLASS "java/lang/reflect/Method" #define GETMETHODS_DESC "()[Ljava/lang/reflect/Method;" #define JL_CLASS "java/lang/Class" #define GETCLASS_DESC "()Ljava/lang/Class;" #define INVOKE_DESC "(Ljava/lang/Object;[Ljava/lang/Object;)Ljava/lang/Object;" #define THROWABLE_CLASS "java/lang/Throwable" #define GETMSG_DESC "()Ljava/lang/String;" #define TOLOWER_DESC "()Ljava/lang/String;" #define STRCHARAT_DESC "(Ljava/lang/String;I)Ljava/lang/String;" #define EXIT_DESC "(I)V" #define PAUSE_DESC "(Ljava/lang/String;)V" #define PAUSE_NOARG_DESC "()V" #define INVOKE_EXCEPTION "java/lang/reflect/InvocationTargetException" #define ACCESS_EXCEPTION "java/lang/IllegalAccessException" #define F2J_STDIN "__f2j_stdin" #define F2J_IO_VEC "__io_vec" #define THREEARG_MAX_FUNC "Util.max" #define THREEARG_MAX_FUNC_STRICT "StrictUtil.max" #define THREEARG_MIN_FUNC "Util.min" #define THREEARG_MIN_FUNC_STRICT "StrictUtil.min" #define CB_PREFIX "common_block/" #define CB_DELIMITER '|' #define CB_SEPARATOR ',' #define MAX(a, b) (((a) > (b)) ? (a) : (b)) /***************************************************************************** * comment out the following line to disable the generation of VCG control * * flow graphs. * *****************************************************************************/ /* #define VCG_CONTROL_FLOW */ /***************************************************************************** * Definitions of code generation status. These are used to set the target * * language that f2java is currently generating. * *****************************************************************************/ #define JAVA_ONLY 1 #define JVM_ONLY 2 #define JAVA_AND_JVM 3 #define MAX_CODE_LEN 65535 /***************************************************************************** * Function prototypes: * *****************************************************************************/ #ifdef VCG_CONTROL_FLOW void cfg_emit(Dlist, char *); #endif char * tok2str(int), * format2str(AST *), * lowercase(char *), * escape_double_quotes(char *), * get_common_prefix(char *), * getVarDescriptor(AST *), * char_substitution(char *, int, int), * get_return_type_from_descriptor(char *), * get_wrapper_from_desc(char *), * get_field_desc_from_ident(AST *), * get_desc_from_arglist(AST *), * get_adapter_desc(char *, AST *), * getNameFromCommonDesc(char *, int), * getFieldDescFromCommonDesc(char *, int), * getMergedName(AST *), * getMergedDescriptor(AST *, enum returntype), * getCommonVarName(AST *); METHODTAB * methodscan (METHODTAB * , char * ); void pushConst(JVM_METHOD *, AST *), pushVar(JVM_CLASS *, JVM_METHOD *, enum returntype, BOOL, char *, char *, char *, int, BOOL), storeVar(JVM_CLASS *, JVM_METHOD *, enum returntype, BOOL, char *, char *, char *, int, BOOL), arg_array_assign_emit(JVM_CLASS *, JVM_METHOD *, int, int, int, enum returntype), arg_assignment_emit(JVM_CLASS *, JVM_METHOD *, int, int, int, BOOL, enum returntype), read_implied_loop_bytecode_emit(JVM_METHOD *, AST *), formatted_read_implied_loop_bytecode_emit(JVM_METHOD *, AST *), write_implied_loop_bytecode_emit(JVM_METHOD *, AST *), forloop_bytecode_emit(JVM_METHOD *, AST *), forloop_end_bytecode(JVM_METHOD *, AST *), LHS_bytecode_emit(JVM_METHOD *, AST *), stop_emit(JVM_METHOD *, AST *), pause_emit(JVM_METHOD *, AST *), external_emit(JVM_METHOD *, AST *), maxmin_intrinsic_emit(JVM_METHOD *, AST *, METHODTAB *, char *, char *), max_intrinsic_emit (JVM_METHOD *, AST *, METHODTAB *), min_intrinsic_emit (JVM_METHOD *, AST *, METHODTAB *), while_emit(JVM_METHOD *, AST *), substring_assign_emit(JVM_METHOD *, AST *), dint_intrinsic_emit(JVM_METHOD *, AST *, METHODTAB *), emit_call_args_known(JVM_METHOD *, AST *, char *, BOOL), emit_call_args_unknown(JVM_METHOD *, AST *), emit_call_arguments(JVM_METHOD *, AST *, BOOL), aint_intrinsic_emit(JVM_METHOD *, AST *, METHODTAB *), intrinsic_arg_emit(JVM_METHOD *, AST *, enum returntype), intrinsic0_call_emit(JVM_METHOD *, AST *, METHODTAB *), intrinsic_call_emit(JVM_METHOD *, AST *, METHODTAB *, enum returntype), intrinsic2_call_emit(JVM_METHOD *, AST *, METHODTAB *, enum returntype), intrinsic_lexical_compare_emit(JVM_METHOD *, AST *, METHODTAB *), intrinsic_emit(JVM_METHOD *, AST *), implied_loop_emit(JVM_METHOD *, AST *, void (*)(JVM_METHOD *, AST *), void (*)(JVM_METHOD *, AST*)), read_implied_loop_sourcecode_emit(JVM_METHOD *, AST *), formatted_read_implied_loop_sourcecode_emit(JVM_METHOD *, AST *), scalar_emit(JVM_METHOD *, AST *, HASHNODE *), write_implied_loop_sourcecode_emit(JVM_METHOD *, AST *), array_emit(JVM_METHOD *, AST *), emit_interface(AST *), substring_emit(JVM_METHOD *, AST *), subcall_emit(JVM_METHOD *, AST *), emit_methcall(FILE *, AST *), name_emit (JVM_METHOD *, AST *), print_eqv_list(AST *, FILE *), open_output_file(AST *, char *), print_string_initializer(JVM_METHOD *, AST *), typedec_emit_all_static(JVM_METHOD *, AST *), vardec_emit(JVM_METHOD *, AST *, enum returntype, char *), assign_varnums_to_locals(JVM_METHOD *, AST *), local_emit(JVM_METHOD *, AST *), emit_adapters(void), newarray_emit(JVM_METHOD *, enum returntype), constructor (AST *), typedec_emit (JVM_METHOD *, AST *), data_emit(JVM_METHOD *, AST *), equiv_emit (JVM_METHOD *, AST *), call_emit (JVM_METHOD *, AST *), forloop_emit (JVM_METHOD *, AST *), blockif_emit (JVM_METHOD *, AST *), logicalif_emit (JVM_METHOD *, AST *), arithmeticif_emit (JVM_METHOD *, AST *), goto_emit (JVM_METHOD *, AST *), computed_goto_emit (JVM_METHOD *, AST *), assigned_goto_emit (JVM_METHOD *, AST *), label_emit (JVM_METHOD *, AST *), write_emit (JVM_METHOD *, AST *), common_emit(AST *), read_emit (JVM_METHOD *, AST *), unformatted_read_emit(JVM_METHOD *, AST *), formatted_read_emit(JVM_METHOD *, AST *, char *), emit_invocations(void), merge_equivalences(AST *), print_equivalences(AST *), emit_prolog_comments(AST *), emit_javadoc_comments(AST *), prepare_comments(AST *), insert_fields(AST *), return_emit(JVM_METHOD *), end_emit(JVM_METHOD *), emit (AST *), field_emit(AST *), invoke_constructor(JVM_METHOD *, char *, AST *, char *), set_bytecode_status(JVM_METHOD *, int), inline_format_emit(JVM_METHOD *, AST *, BOOL), assign_emit (JVM_METHOD *, AST *), expr_emit(JVM_METHOD *, AST *), substring_expr_emit(JVM_METHOD *, AST *), relationalop_emit(JVM_METHOD *, AST *), logicalop_emit(JVM_METHOD *, AST *), constant_expr_emit(JVM_METHOD *, AST *), unaryop_emit(JVM_METHOD *, AST *), binaryop_emit(JVM_METHOD *, AST *), power_emit(JVM_METHOD *, AST *), parenthesized_expr_emit(JVM_METHOD *, AST *), else_emit (AST *), insert_adapter(AST *), insert_methcall(Dlist, AST *), reflect_declarations_emit(JVM_METHOD *, AST *), data_scalar_emit(JVM_METHOD *, enum returntype, AST *, AST *, int), func_array_emit(JVM_METHOD *, AST *, char *, int, int), methcall_obj_array_emit(JVM_METHOD *, AST *, int), adapter_emit_from_descriptor(JVM_METHOD *, JVM_METHODREF *, AST *), adapter_args_emit_from_descriptor(JVM_METHOD *, AST *, char *), adapter_temps_emit_from_descriptor(JVM_METHOD *, AST *, char *), adapter_methcall_emit_from_descriptor(JVM_METHOD *, AST *, int, JVM_METHODREF *, char *), adapter_assign_emit_from_descriptor(JVM_METHOD *, AST *, int, char *), adapter_tmp_assign_emit(JVM_METHOD *, int, enum returntype), adapter_assign_emit(JVM_METHOD *, int, int, int, char *), adapter_array_assign_emit(JVM_METHOD *, int, int, int, char *), arrayacc_arg_emit(JVM_METHOD *, AST *, char *, BOOL), arrayref_arg_emit(JVM_METHOD *, AST *, char *), scalar_arg_emit(JVM_METHOD *, AST *, char *, char *), wrapped_arg_emit(JVM_METHOD *, AST *, char *), gen_clear_io_vec(JVM_METHOD *), initialize_lists(void), free_lists(); int assign_varnums_to_arguments(AST *), cast_data_stmt(AST *, int), cgPassByRef(char *), dl_int_examine(Dlist), needs_adapter(AST *), idxNeedsDecr(AST *), method_name_emit (JVM_METHOD *, AST *, BOOL), data_repeat_emit(JVM_METHOD *, AST *, AST *, unsigned int), methcall_arglist_emit(AST *), num_locals_in_descriptor(char *), adapter_methcall_arg_emit(JVM_METHOD *, AST *, int, int, char *), determine_var_length(HASHNODE *); double eval_const_expr(AST *); HASHNODE * format_lookup(SYMTABLE *, char *); JVM_CODE_GRAPH_NODE * elseif_emit (JVM_METHOD *, AST *); AST * label_search(Dlist, int), * dl_astnode_examine(Dlist), * dl_name_search(Dlist, char *), * addnode(void), * data_var_emit(JVM_METHOD *, AST *, AST *, HASHNODE *, int), * data_implied_loop_emit(JVM_METHOD *, AST * , AST *), * data_array_emit(JVM_METHOD *, int , AST *, AST *), * data_string_emit(JVM_METHOD *, int , AST *, AST *), * format_item_emit(JVM_METHOD *, AST *, AST **); enum returntype get_type_from_field_desc(char *), get_type(char *); JVM_METHODREF * get_method_name(AST *, BOOL), * get_methodref(AST *), * find_commonblock(char *, Dlist), * find_method(char *, Dlist); BOOL adapter_insert_from_descriptor(AST *, AST *, char *), is_static(AST *), is_local(AST *), isArrayNoIdx(AST *); struct var_info * get_var_info(AST *), * push_array_var(JVM_METHOD *, AST *); #endif f2j-0.8.1/src/dlist.c0000600000077700002310000000373211031241063014321 0ustar seymourgraduate/* Jim Plank's dlist routines. Contact plank@cs.utk.edu */ #include /* Basic includes and definitions */ #include #include "dlist.h" #include "f2jmem.h" /*---------------------------------------------------------------------* * PROCEDURES FOR MANIPULATING DOUBLY LINKED LISTS * Each list contains a sentinal node, so that * the first item in list l is l->flink. If l is * empty, then l->flink = l->blink = l. *---------------------------------------------------------------------*/ Dlist make_dl() { Dlist d; d = (Dlist) f2jalloc (sizeof(struct dlist)); d->flink = d; d->blink = d; d->val = (void *) 0; return d; } void dl_insert_b(node, val) /* Inserts to the end of a list */ Dlist node; void *val; { Dlist last_node, new; new = (Dlist) f2jalloc (sizeof(struct dlist)); new->val = val; last_node = node->blink; node->blink = new; last_node->flink = new; new->blink = last_node; new->flink = node; } void dl_insert_list_b(Dlist node, Dlist list_to_insert) { Dlist last_node, f, l; if (dl_empty(list_to_insert)) { free(list_to_insert); return; } f = list_to_insert->flink; l = list_to_insert->blink; last_node = node->blink; node->blink = l; last_node->flink = f; f->blink = last_node; l->flink = node; free(list_to_insert); } void dl_delete_node(item) /* Deletes an arbitrary iterm */ Dlist item; { item->flink->blink = item->blink; item->blink->flink = item->flink; free(item); } void dl_delete_list(l) Dlist l; { Dlist d, next_node; if(l == NULL) return; d = l->flink; while(d != l) { next_node = d->flink; free(d); d = next_node; } free(d); } void * dl_val(l) Dlist l; { return l->val; } void* dl_pop(li) Dlist li; { Dlist item = dl_last(li); void *tmp; if(item == NULL) return NULL; item->flink->blink = item->blink; item->blink->flink = item->flink; tmp = dl_val(item); f2jfree(item, sizeof(Dlist)); return tmp; } f2j-0.8.1/src/dlist.h0000600000077700002310000000306111031241063014321 0ustar seymourgraduate/* Jim Plank's dlist routines. Contact plank@cs.utk.edu */ #ifndef _DLIST_H #define _DLIST_H typedef struct dlist { struct dlist *flink; struct dlist *blink; void *val; } *Dlist; /* Nil, first, next, and prev are macro expansions for list traversal * primitives. */ #define dl_nil(l) (l) #define dl_first(l) (l->flink) #define dl_last(l) (l->blink) #define dl_next(n) (n->flink) #define dl_prev(n) (n->blink) /* These are the routines for manipluating lists */ extern Dlist make_dl(void); extern void dl_insert_b(Dlist, void *); /* Makes a new node, and inserts it before the given node -- if that node is the head of the list, the new node is inserted at the end of the list */ #define dl_insert_a(n, val) dl_insert_b(n->flink, val) extern void dl_delete_node(Dlist); /* Deletes and free's a node */ extern void dl_delete_list(Dlist); /* Deletes the entire list from existance */ extern void *dl_val(Dlist); /* Returns node->val (used to shut lint up) */ extern void *dl_pop(Dlist); /* returns the first node and removes it from the list */ extern void dl_insert_list_b(Dlist, Dlist); #define dl_traverse(ptr, list) \ for (ptr = dl_first(list); ptr != dl_nil(list); ptr = dl_next(ptr)) #define dl_traverse_b(ptr, list) \ for (ptr = dl_last(list); ptr != dl_nil(list); ptr = dl_prev(ptr)) #define dl_empty(list) (list->flink == list) #endif f2j-0.8.1/src/f2j-config.h0000600000077700002310000000022111031241063015121 0ustar seymourgraduate/* * $Source: $ * $Revision: $ * $Date: $ * $Author: $ */ #ifndef _F2J_CONFIG_H #define _F2J_CONFIG_H #define F2J_VERSION "0.8.1" #endif f2j-0.8.1/src/f2j.h0000600000077700002310000007052611031241063013675 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2j.h,v $ * $Revision: 1.90 $ * $Date: 2007/12/12 21:47:41 $ * $Author: keithseymour $ */ #ifndef _F2J_H #define _F2J_H /***************************************************************************** * f2j.h * * * * Header file for the Fortran-to-Java translator. * * * *****************************************************************************/ #include #include #include"symtab.h" #include"dlist.h" #include"bytecode.h" #include"opcodes.h" #define FALSE 0 #define TRUE 1 #define F2J_CLASS_ACC (JVM_ACC_PUBLIC | JVM_ACC_FINAL | JVM_ACC_SUPER) #define F2J_NORMAL_ACC (JVM_ACC_PUBLIC | JVM_ACC_STATIC) #define F2J_STRICT_ACC (JVM_ACC_STRICT | F2J_NORMAL_ACC) #define F2J_ADAPTER_ACC (JVM_ACC_PRIVATE | JVM_ACC_STATIC) #define F2J_INIT_ACC (JVM_ACC_PUBLIC) #define MIN(x,y) ((x)<(y)?(x):(y)) /* the minimum of two numbers */ /***************************************************************************** * Define VCG as 1 if VCG output is desired (VCG == Visualization of * * Compiler Graphs) * *****************************************************************************/ #define VCG 0 /***************************************************************************** * Defines for optimization of the use of object wrappers: * * NOT_VISITED - f2j has not started optimizing this routine * * VISITED - f2j has started optimizing, but has not finished * * FINISHED - optimization is complete for this routine * *****************************************************************************/ #define NOT_VISITED 0 #define VISITED 1 #define FINISHED 2 /***************************************************************************** * Definitions for intrinsic variable names. At certain pts in the parser, we * * do not know whether this intrinsic name represents an intrinsic call, * * function call, array name, or a regular variable. * *****************************************************************************/ #define INTRIN_NOT_NAMED 0 #define INTRIN_NAMED_VARIABLE 1 #define INTRIN_NAMED_ARRAY 2 #define INTRIN_NAMED_ARRAY_OR_FUNC_CALL 3 /***************************************************************************** * Definitions for an expandable string structure. STR_INIT is the initial * * size of the string, while STR_CHUNK is the number of bytes by which we * * increment the string when it is too small. * *****************************************************************************/ #define STR_INIT 50 #define STR_CHUNK 20 #define MAX_CONST_LEN 80 /***************************************************************************** * BIGBUFF is the maximum size in characters of an input line (including) * * continuations. Had a segfault on a very long continued line * * in a lapack routine. This is a hack, should * * reallaoc when buffer overflows instead. * * * * YYTEXTLEN is the maximum size in characters of the token string. * *****************************************************************************/ #define BIGBUFF 2000 #define YYTEXTLEN 2000 struct _str { unsigned int size; char *val; }; /***************************************************************************** * this structure holds information about an array access, including the * * full name of the array, local variable number, etc. * *****************************************************************************/ struct var_info { char *name; /* name of variable incl common prefix if appropriate */ char *desc; /* field descriptor of variable */ char *class; /* class name of variable */ int localvar; /* local variable num of this variable, if appropriate */ BOOL is_arg; /* is this variable an arg to the current prog unit? */ }; /***************************************************************************** * This struct retains information about included files that are on the * * stack (so we can keep track of which line number we were on when we * * started the included file. * *****************************************************************************/ typedef struct _include_file_info { char *name; int line_num; FILE *fp; } INCLUDED_FILE; /***************************************************************************** * This struct defines an entry in the implicit table, which holds info * * about any IMPLICIT statements and the mapping between first letter and * * data type. * *****************************************************************************/ typedef struct _itab_entry { enum returntype type; int len; int declared; } ITAB_ENTRY; /***************************************************************************** * F2J_PATH_VAR defines the environment variable used to specify the search * * path for .f2j method/descriptor files. * *****************************************************************************/ #define F2J_PATH_VAR "F2J_SEARCH_PATH" /***************************************************************************** * bitfields representing the valid arguments to intrinsics. the generic * * intrinsics may take many different valid types, so we OR them together in * * some cases. * *****************************************************************************/ #define STRING_ARG 64 #define CHAR_ARG 32 #define COMPLEX_ARG 16 #define DOUBLE_ARG 8 #define REAL_ARG 4 #define INT_ARG 2 #define LOGICAL_ARG 1 #define NO_ARG 0 #define IRDC_ARGS (INT_ARG | REAL_ARG | DOUBLE_ARG | COMPLEX_ARG) #define IRD_ARGS (INT_ARG | REAL_ARG | DOUBLE_ARG) #define IR_ARGS (INT_ARG | REAL_ARG) #define RD_ARGS (REAL_ARG | DOUBLE_ARG) #define RDC_ARGS (REAL_ARG | DOUBLE_ARG | COMPLEX_ARG) #define CS_ARGS (STRING_ARG | CHAR_ARG) /***************************************************************************** * MAX_ARRAY_DIM is the maximum number of dimensions allowed in an array. * *****************************************************************************/ #define MAX_ARRAY_DIM 7 /***************************************************************************** * MAIN_DESCRIPTOR is the descriptor required for a main() method in Java. * *****************************************************************************/ #define MAIN_DESCRIPTOR "([Ljava/lang/String;)V" /***************************************************************************** * If DEBUGGEM is defined as 1, yyparse produces voluminous, detailed * * output to stderr during parsing. * *****************************************************************************/ #define DEBUGGEM 0 /* Enumeration of the different kinds of Specification statements */ enum spectype { External, Intrinsic, Implicit, Parameter }; /* Represents whether an expression is on the lhs or rhs. */ enum _expr_side { left, right }; /* Enumeration of all the different kinds of nodes in the AST */ enum _nodetype { Source = 1, Progunit, Subroutine, Function, Program, Blockif, Comment, MainComment, Common, CommonList, DataStmt, DataList, Dimension, Elseif, Else, Forloop, Format, Constant, Method, Identifier, Label, Logicalif, Arithmeticif, Typedec, Assignment, Expression, Equivalence, Return, Goto, Call, Statement, Relationalop, Logicalop, Binaryop, Power, Unaryop, Save, Specification, Substring, End, Write, Read, Stop, Pause, ComputedGoto, AssignedGoto, ArrayAccess, ArrayDec, ArrayIdxRange, EmptyArgList, IoExplist, DataImpliedLoop, IoImpliedLoop, StmtLabelAssign, Unimplemented }; /***************************************************************************** * Structure for program units (program, function, subroutine). * *****************************************************************************/ struct _source { enum returntype returns; /* The return type of this program unit */ struct ast_node *name, /* node representing this unit's name */ *progtype, /* type of unit (e.g. PROGRAM, FUNCTION) */ *typedecs, /* type declarations */ *statements, /* executable statements */ *args, /* argument list */ *equivalences, /* list of equivalences */ *prologComments, /* comments preceding unit header */ *javadocComments; /* comm. to be emitted in javadoc format */ SYMTABLE *type_table, /* general symbol table for this unit */ *external_table, /* external funcs called from this unit */ *intrinsic_table, /* intrinsic funcs called from this unit */ *args_table, /* table of this unit's arguments */ *array_table, /* variables that are declared as arrays */ *format_table, /* FORMAT statements */ *data_table, /* variables declared in a DATA stmt */ *save_table, /* variables declared in a SAVE stmt */ *common_table, /* variables declared in a COMMON stmt */ *parameter_table, /* variables declared as PARAMETERS */ *equivalence_table; /* variables that are equivalenced */ Dlist stmt_assign_list, /* labels used in ASSIGN TO statements */ constants_table; /* constant_pool info for bytecode gen. */ BOOL needs_input, /* does this unit read any data */ needs_output, /* does this unit write any data */ needs_reflection, /* does this unit call a passed-in func */ needs_blas; /* does this unit call any BLAS routines */ int scalarOptStatus, /* status of optimization on this unit */ save_all; /* is there a SAVE stmt without var list */ JVM_CLASS *class; /* class file for this program unit */ char * descriptor; /* method descriptor for this prog unit */ }; /***************************************************************************** * Structure for expressions and assignment statements. * *****************************************************************************/ struct _assignment { BOOL parens; /* used only by expr nodes. TRUE if the */ /* expression is enclosed by parens */ char minus, /* unary sign of this expression */ optype; /* kind of operation (e.g. +, -, *, etc) */ struct ast_node *lhs, /* left-hand side of expr or assignment */ *rhs; /* right-hand side of expr or assignment */ }; /***************************************************************************** * This structure represents variable declarations. * *****************************************************************************/ struct _typeunit { enum spectype specification; /* what kind of declaration this is */ enum returntype returns; /* the data type of this declaration */ struct ast_node *declist; /* list of variables being declared */ }; /***************************************************************************** * This structure represents DO loops. * *****************************************************************************/ struct _forloop { unsigned int localvar; /* local var holding iteration count */ struct ast_node *counter, /* the loop variable */ *Label, /* label of the CONTINUE for this loop */ *start, /* initial loop assignment (e.g. i = 0) */ *stop, /* stop when counter equals stop */ *incr, /* amount to increment each iteration */ *iter_expr, /* expression to calc # of iterations */ *incr_expr; /* expression to calc increment */ JVM_CODE_GRAPH_NODE *goto_node; /* graph node of initial loop goto op */ }; /***************************************************************************** * This structure represents constants. * *****************************************************************************/ struct _constant { int cp_index; /* constant pool index of this constant */ char *opcode, /* e.g., iconst_1, bipush 121.23 */ *number; /* the constant */ }; /***************************************************************************** * This structure represents labels. * *****************************************************************************/ struct _label { int number; /* the label number */ JVM_CODE_GRAPH_NODE *instr; /* bytecode instruction with this label */ struct ast_node *stmt; /* the statement after this label */ }; /***************************************************************************** * This structure represents identifiers. An identifier can be a scalar * * variable, array variable, function name, or subroutine name. * *****************************************************************************/ struct _ident { int dim, /* number of dimensions (for arrays) */ position, /* ident's position in COMMON block */ len, /* size of ident (e.g. CHARACTER*8 = 8) */ array_len, /* num elements in array (if not implied)*/ localvnum, /* local variable number (for bytecode) */ which_implicit; /* default 0, array 1, var 2, lfunc 3, intrin 4 */ BOOL passByRef, /* is this ident pass by reference */ needs_declaration, /* does this ident need a declaration */ explicit; /* true is explicitly declared */ struct ast_node *startDim[MAX_ARRAY_DIM], /* start expression for each dimension */ /* also used as start exp idx for substr */ *endDim[MAX_ARRAY_DIM], /* ending expression for each dimension */ /* also used as end exp idx for substr */ *arraylist; /* expression representing array size */ char *leaddim, /* leading dimension variable or const */ *opcode, /* A string records the appropriate * * method to invoke on the stack when * * opcode is emitted. * * e.g., opcode = strdup("iload_1"); */ *commonBlockName, /* name of COMMON block this ident is in */ name[MAX_CONST_LEN], /* this ident's name */ *merged_name, /* this ident's merged name (e.g. in * * cases of equivalence or COMMON) */ *descriptor; /* constant pool descriptor of the ident */ }; /***************************************************************************** * This structure represents Logical IF statements and Block IF statements. * * A logical if is a one-line IF statement with no ELSE or ELSE IF. * * For example, * * IF(a.eq.b) x=12 * * * * A Block if is an IF-THEN statement with optional ELSE and ELSE IF * * blocks. For example, * * IF(a.eq.b) THEN * * x=12 * * ELSE * * x=0 * * END IF * *****************************************************************************/ struct _logicalif { int endif_label; /* label of ENDIF stmt if present */ struct ast_node *conds, /* the conditional expression to test */ *stmts, /* statements to execute if expr is TRUE */ *elseifstmts, /* list of ELSE IF statements */ *elsestmts; /* stmts to exectue if no IF or ELSE IF * * expression was TRUE */ }; /***************************************************************************** * This structure represents the Arithmetic IF. The arithmetic IF consists * * of an expression and three labels. If the expression evaluates to a * * negative value, control goes to the statement corresponding to the first * * label. If the expression is 0, jump to the second label. If the * * expression is positive, jump to the third label. * *****************************************************************************/ struct _arithmeticif { struct ast_node *cond; /* the conditional expression */ int neg_label, /* branch to this label if expr < 0 */ zero_label, /* branch to this label if expr == 0 */ pos_label; /* branch to this label if expr > 0 */ }; /***************************************************************************** * This structure represents the GOTO statement. * *****************************************************************************/ struct _goto { int label; /* which label to branch to */ }; /***************************************************************************** * This structure represents IO statements (READ and WRITE). * *****************************************************************************/ struct _io { int io_type, /* is this a READ or WRITE statement */ file_desc, /* file descriptor (not currently used) */ format_num, /* FORMAT desc for this statement */ end_num; /* where to branch on error */ struct ast_node *fmt_list, /* inline FORMAT info (w/ WRITE) */ *arg_list; /* list of expressions to read or write */ }; /***************************************************************************** * This structure represents DATA statements. * *****************************************************************************/ struct _data_stmt { struct ast_node *nlist, /* list of variable initializations */ *clist; /* list of values to initialize with */ }; /***************************************************************************** * This structure represents COMMON blocks. * *****************************************************************************/ struct _commonblock { char *name; /* the name of the common block */ struct ast_node *nlist; /* list of variables in this block */ }; /***************************************************************************** * This structure represents the computed GOTO. The computed GOTO consists * * of a list of labels followed by an expression. The expression is * * evaluated and control flows to the Nth label in the list, where N is the * * integer value of the expression. For example, * * X = 3 * * GOTO (10, 20, 30, 40) X * *****************************************************************************/ struct _computed_goto { struct ast_node *name, /* expr that determines where to branch */ *intlist; /* list of labels (targets) */ }; /***************************************************************************** * The main data structure, a "tagged union". This represents a node * * of the AST. * *****************************************************************************/ typedef struct ast_node { int token; /* this node's token (from lexer) */ enum returntype vartype; /* data type of this node */ struct ast_node *nextstmt, /* statement or item following this one */ *prevstmt, /* statement or item preceding this one */ *parent; /* parent of this node */ enum _expr_side expr_side; /* which side this node is on */ enum _nodetype nodetype; /* what kind of node this is */ /* * For any given node, one of the following structures should apply, * depending on the node type. */ union { struct _goto go_to; /* goto is a reserved word! */ struct _io io_stmt; struct _label label; struct _ident ident; struct _source source; struct _forloop forloop; struct _typeunit typeunit; struct _constant constant; struct _commonblock common; struct _data_stmt data, equiv; struct _arithmeticif arithmeticif; struct _computed_goto computed_goto; struct _logicalif logicalif, blockif; struct _assignment assignment, expression; } astnode; } AST; /***************************************************************************** * keyword lookup table. * *****************************************************************************/ typedef struct _kwdtab { char *kwd; /* text of the keyword */ int ktok; /* token code */ int klex; /* lexical value */ } KWDTAB; /***************************************************************************** * Java intrinsic methods. * *****************************************************************************/ enum _intrinsics { ifunc_INT, ifunc_IFIX, ifunc_IDINT, ifunc_REAL, ifunc_FLOAT, ifunc_SNGL, ifunc_DBLE, ifunc_CMPLX, ifunc_ICHAR, ifunc_CHAR, ifunc_AINT, ifunc_DINT, ifunc_ANINT, ifunc_DNINT, ifunc_NINT, ifunc_IDNINT, ifunc_ABS, ifunc_IABS, ifunc_DABS, ifunc_CABS, ifunc_MOD, ifunc_AMOD, ifunc_DMOD, ifunc_SIGN, ifunc_ISIGN, ifunc_DSIGN, ifunc_DIM, ifunc_IDIM, ifunc_DDIM, ifunc_DPROD, ifunc_MAX, ifunc_MAX0, ifunc_AMAX1, ifunc_DMAX1, ifunc_AMAX0, ifunc_MAX1, ifunc_MIN, ifunc_MIN0, ifunc_AMIN1, ifunc_DMIN1, ifunc_AMIN0, ifunc_MIN1, ifunc_LEN, ifunc_INDEX, ifunc_AIMAG, ifunc_CONJG, ifunc_SQRT, ifunc_DSQRT, ifunc_CSQRT, ifunc_EXP, ifunc_DEXP, ifunc_CEXP, ifunc_LOG, ifunc_ALOG, ifunc_DLOG, ifunc_CLOG, ifunc_LOG10, ifunc_ALOG10, ifunc_DLOG10, ifunc_SIN, ifunc_DSIN, ifunc_CSIN, ifunc_COS, ifunc_DCOS, ifunc_CCOS, ifunc_TAN, ifunc_DTAN, ifunc_ASIN, ifunc_DASIN, ifunc_ACOS, ifunc_DACOS, ifunc_ATAN, ifunc_DATAN, ifunc_ATAN2, ifunc_DATAN2, ifunc_SINH, ifunc_DSINH, ifunc_COSH, ifunc_DCOSH, ifunc_TANH, ifunc_DTANH, ifunc_LGE, ifunc_LGT, ifunc_LLE, ifunc_LLT, ifunc_ETIME, ifunc_SECOND }; typedef struct method_tab { enum _intrinsics intrinsic; /* id of this intrinsic */ char *fortran_name; /* name of the Fortran intrinsic */ /* for Java source generation: */ char *java_method; /* name of the corresponding Java func */ char *strict_java_method; /* strict version (e.g. StrictMath.abs) */ /* for bytecode generation: */ char *class_name; /* fully qualified Java class name */ char *strict_class_name; /* strict version of the class name */ char *method_name; /* method name */ char *descriptor; /* corresponding Java func descriptor */ char args; /* bitfield of valid args to intrinsic */ enum returntype ret; /* return type of this intrinsic */ } METHODTAB; /***************************************************************************** * Enumeration of the relational operators. * *****************************************************************************/ enum relops { rel_eq = 1, /* equals */ rel_ne, /* not equal */ rel_lt, /* less than */ rel_le, /* less than or equal */ rel_gt, /* greater than */ rel_ge /* greater than or equal */ }; /***************************************************************************** * This structure represents a 'substitution'. This associates an integer * * value with a variable name. * *****************************************************************************/ typedef struct { char *name; /* variable name */ unsigned int val; /* value */ } SUBSTITUTION; /***************************************************************************** * Function prototypes to keep the compiler from complaining. * *****************************************************************************/ void javaheader (FILE *, char *), initialize(void), uppercase(char *), print_vcg_header(FILE *, char *), print_vcg_trailer(FILE *), print_vcg_node(FILE *, int, char *), print_vcg_nearedge(FILE *, int, int), print_vcg_edge(FILE *, int, int), print_vcg_typenode(FILE *, int, char *), add_implicit_to_tree(AST *); Dlist build_method_table(char *); char * get_method_descriptor(AST *, SYMTABLE *, SYMTABLE *, SYMTABLE *), * print_nodetype ( AST * ); struct _str * strAppend(struct _str *, char *); int isPassByRef(char *, SYMTABLE *, SYMTABLE *, SYMTABLE *); BOOL isPassByRef_desc(char *); double mypow(double, double); AST *clone_ident(AST *); #endif f2j-0.8.1/src/f2j_externs.h0000600000077700002310000000707711031241063015446 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2j_externs.h,v $ * $Revision: 1.9 $ * $Date: 2007/07/30 20:52:25 $ * $Author: keithseymour $ */ extern int lineno, /* current line number */ statementno, /* current statement number */ func_stmt_num, /* current statement number within this function */ ignored_formatting, /* number of format statements ignored */ bad_format_count; /* number of invalid format stmts encountered */ extern FILE *ifp, /* input file pointer */ *vcgfp, /* VCG output file pointer */ *indexfp; /* method and descriptor index for all prog units */ extern char *inputfilename, /* name of the input file */ *package_name, /* what to name the package, e.g. org.netlib.blas */ *output_dir, /* path to which f2java should store class files */ line_buffer[]; /* copy of the fortran line */ extern BOOL strictFp, /* should we declare generated code as strictfp */ strictMath, /* should we use Java's strict fp math mode */ omitWrappers, /* should we try to optimize use of wrappers */ genInterfaces, /* should we generate simplified interfaces */ genJavadoc, /* should we generate javadoc-compatible comments */ noOffset, /* should we generate offset args in interfaces */ f2j_arrays_static, /* force all arrays to be declared static */ save_all_override; /* force all variables to be declared static */ extern SYMTABLE *type_table, /* General symbol table */ *external_table, /* external functions */ *intrinsic_table, /* intrinsic functions */ *args_table, /* arguments to the current unit */ *array_table, /* array variables */ *format_table, /* format statements */ *data_table, /* variables contained in DATA statements */ *save_table, /* variables contained in SAVE statements */ *common_table, /* variables contained in COMMON statements */ *parameter_table, /* PARAMETER variables */ *function_table, /* table of functions */ *java_keyword_table, /* table of Java reserved words */ *blas_routine_table, /* table of BLAS routines */ *common_block_table, /* COMMON blocks */ *global_func_table, /* Global function table */ *global_common_table, /* Global COMMON table */ *generic_table; /* table of the generic intrinsic functions */ extern Dlist constants_table, /* constants (for bytecode constant pool gen.) */ include_paths, /* list of paths to search for included files */ descriptor_table; /* list of method descriptors from *.f2j files */ extern INCLUDED_FILE *current_file_info; /* lexer information about the current file */ #ifdef _WIN32 #define FILE_DELIM "\\" #define PATH_DELIM ";" #else #define FILE_DELIM "/" #define PATH_DELIM ":" #endif f2j-0.8.1/src/f2jlex.c0000600000077700002310000015525011031241063014377 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2jlex.c,v $ * $Revision: 1.75 $ * $Date: 2007/12/12 21:47:41 $ * $Author: keithseymour $ */ /***************************************************************************** * f2jlex.c * * * * This is a lexer for a Fortran front-end written to * * translate Fortran numerical linear algebra code into * * Java. The lexer interacts with a yacc generated parser * * and implements a subset of the commands used by the * * flex scanner. Due to the nature of yacc (uses globals) * * the scanner takes no arguments, but examines the globally * * declared input source buffer. It returns a single token * * and it's associated lexical value at each call. EOF * * condition passes control back to main() for program * * termination. * * * *****************************************************************************/ #include #include #include #include #include"initialize.h" #include"f2jmem.h" #include"f2j_externs.h" /***************************************************************************** * Set lexdebug TRUE for debugging output from the lexer routines. * *****************************************************************************/ int lexdebug = FALSE; char line_buffer[BIGBUFF]; char yytext[YYTEXTLEN]; /* token text */ /***************************************************************************** * Stuff for Sale's algorithm when I get around to it. * * They need to be global for now to set contexts. It is * * probably possible to rewrite in terms of a struct to * * pass around in the lexer, the contexts will have to be * * global for the parser to use. * * * * I am setting these in the `collapse_white_space() * * routine. * *****************************************************************************/ BOOL letterseen; /* we have seen a letter in this line */ BOOL equalseen; /* we have seen an equals in this line */ BOOL commaseen; /* we have seen a comma in this line */ /***************************************************************************** * a couple of buffers for manipulating the text of the current line. * *****************************************************************************/ typedef struct _buffer { char stmt[BIGBUFF]; char text[BIGBUFF]; } BUFFER; /***************************************************************************** * Function prototypes: * *****************************************************************************/ int yylex (void), prelex (BUFFER *); char *tok2str(int), *f2j_fgets(char *, int, FILE *); FILE *open_included_file(char *); int name_scan (BUFFER *), keyscan (register KWDTAB *, BUFFER *), number_scan (BUFFER *, int, int), string_or_char_scan (BUFFER *); void truncate_bang_comments(BUFFER *), check_continued_lines (FILE *, char *), collapse_white_space (BUFFER *); METHODTAB * methodscan (METHODTAB *, char *); extern Dlist file_stack; /***************************************************************************** * STANDALONE is defined in the makefile when compiling the * * lex file as a stand alone program for debugging the lexer. * *****************************************************************************/ #ifdef STANDALONE union yylval_ { struct ast_node *ptnode; /* pointer to AST node */ int tok; /* token ID */ enum returntype type; /* data type */ char lexeme[30]; /* text token */ }yylval; /***************************************************************************** * This main function is used for testing the lexer. It is only compiled * * if STANDALONE is defined. * *****************************************************************************/ main (int argc, char **argv) { extern FILE *ifp; int token = 1; ifp = fopen (argv[1], "rb"); while (token != 0) { token = yylex (); /* This prints out some random int on the EOF * condition. */ if(lexdebug) { printf ("From main: %d\n", token); printf ("yytext: %s\n\n", yytext); } } if(lexdebug) printf ("EOF\n"); } /* Close main(). */ #endif /* STANDALONE */ /***************************************************************************** * * * yylex * * * * yylex() has to call prelex() to take of all the * * fortran nasties such as initial whitespace, unreserved * * keywords, context sensitivity, etc. prelex() returns * * a "card image" of characters to be tokenized. * *****************************************************************************/ int yylex () { static int tokennumber; static int firsttoken; static int parencount = 0; static int format_stmt; /* are we lexing a format statement */ int token = 0; /* yyparse() makes a call to yylex() each time it needs a * token. To get a statement to parse, yylex() calls * prelex() with the statement buffer. This occurs * when the value of the statement buffer is 0. * Since we don't want the statement to change between * calls, we declare it static, and initialize it to * null at the start of the program. We may also need * the actual text of the fortran input, so we grab * that also. */ static BUFFER buffer = { {0}, /* Token string. */ {0} /* Text string. */ }; /* Test so that yylex will know when to call prelex to get * another character string. */ if (buffer.stmt[0] == '\0') { if(lexdebug) printf("calling prelex\n"); token = prelex (&buffer); /* No more tokens? Get another statement. */ if(token == INCLUDE) { INCLUDED_FILE *newfile; FILE *tempfp; Dlist lp; int tmplen; buffer.stmt[0] = '\n'; buffer.stmt[1] = '\0'; buffer.text[0] = '\n'; buffer.text[1] = '\0'; /* check for cycle in the include stack */ dl_traverse(lp, file_stack) { newfile = (INCLUDED_FILE *)dl_val(lp); if( !strcmp(newfile->name, yylval.lexeme) ) { fprintf(stderr,"Warning: loop in include (not including %s)\n", yylval.lexeme); strcpy(yylval.lexeme,"Include error\n"); return COMMENT; } } tempfp = open_included_file(yylval.lexeme); /* add the newline since we will send a COMMENT token back * to the parser, with yylval containing the file name. the * parser expects all comments to be terminated with \n\0. */ tmplen = strlen(yylval.lexeme); yylval.lexeme[ tmplen ] = '\n'; yylval.lexeme[ tmplen + 1] = '\0'; if(!tempfp) { fprintf(stderr,"Error: could not open include file %s", yylval.lexeme); return COMMENT; } current_file_info->line_num = lineno+1; newfile = (INCLUDED_FILE *)f2jalloc(sizeof(INCLUDED_FILE)); /* for internal use, strip the newline from the file name */ newfile->name = strdup(yylval.lexeme); newfile->name[strlen(newfile->name)-1] = '\0'; newfile->line_num = 0; newfile->fp = tempfp; dl_insert_b(file_stack, current_file_info); ifp = tempfp; current_file_info = newfile; lineno = 0; return COMMENT; } if(token == COMMENT) { if(lexdebug) printf("0.1: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); buffer.stmt[0] = '\n'; buffer.stmt[1] = '\0'; buffer.text[0] = '\n'; buffer.text[1] = '\0'; return COMMENT; } tokennumber = 0; /* Reset for each statement. */ parencount = 0; /* Reset for each statement. */ format_stmt = 0; /* Reset for each statement. */ firsttoken = 0; /* Reset for each statement. */ } if(lexdebug) printf("here in yylex(), buffer.stmt = \"%s\"\n",buffer.stmt); /* Check for end of file condition. */ if (*buffer.stmt == '\0') { /* I am not sure exactly what is going on here... * I may later comment this out to investigate the * behavior. If this does work, it is confusing with * what I said above. */ if(lexdebug) printf("(first): lexer returning 0 \n"); return 0; } /* All the context handling will need to be handled * before keyscanning. Contexts will include `if' * and `do' statements. This is "Sale's algorithm" * stuff. The global vars commaseen, letterseen and * equalseen are boolean flags set in the * `collapse_white_space()' procedure. */ /* This section of code has grown to the point where it needs * to broken into one or two smaller procedures. It * is getting difficult to follow. -dmd 9/26/97 */ #define SALES 1 #if SALES /* Fortran statements begin with a keyword except under * certain very specific circumstances (detailed in * technical report. */ if (tokennumber == 0) { if (commaseen == FALSE && equalseen == TRUE && letterseen == FALSE) { if (isalpha ( (int) *buffer.stmt)) token = name_scan (&buffer); if (token) { tokennumber++; if(lexdebug) printf("1: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } /* Trap errors. */ } else /* Other three cases. */ { if(lexdebug) printf("keyscanning %s, ",buffer.stmt); token = keyscan (tab_type, &buffer); if(lexdebug) printf("token = %d\n",token); if (token) { firsttoken = token; tokennumber++; if(lexdebug) printf("2: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } token = keyscan (tab_stmt, &buffer); if (token) { firsttoken = token; tokennumber++; if(token == END) func_stmt_num = 0; yylval.lexeme[0] = '\0'; if(lexdebug) printf("3: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } /* Scan for a labeled (numbered) statement. */ if (isdigit ((int) *buffer.stmt)) token = number_scan (&buffer, format_stmt, tokennumber); if (token) { firsttoken = token; tokennumber++; /* this is really a hack. I'm trying to sniff out * labeled else/elseif/endif statements and avoid * passing the integer token back to the parser. * I was getting several shift/reduce conflicts and * didn't want to sort them out, especially since * the label is ignored for else and elseif. For * endif, we let the label get passed back to the * parser in yylval.lexeme. */ if(!strncasecmp(buffer.stmt, "else", 4) || !strncasecmp(buffer.stmt, "elseif", 6) || !strncasecmp(buffer.stmt, "endif", 5)) { token = keyscan(tab_stmt, &buffer); if(!token) { fprintf(stderr, "Error: expected keyword token.\n"); exit(-1); } if(lexdebug) printf("3.9: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } if(lexdebug) printf("4: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } /* Should probably trap errors here. */ } /* Should probably trap errors here. */ } /* Close if (firsttoken == 0). */ if(lexdebug) printf("func_stmt_num = %d, firsttoken = %d, and tokennumber = %d\n", func_stmt_num,firsttoken,tokennumber); if((func_stmt_num == 1) && ((firsttoken == ARITH_TYPE) || (firsttoken == CHAR_TYPE)) && (tokennumber ==1)) { token = keyscan (tab_stmt, &buffer); if (token) { tokennumber++; if(lexdebug) printf("5: lexer returns %s (%s)\n",tok2str(token), buffer.stmt); return token; } } /* If we're tokenizing an IMPLICIT statement, then we need to check * whether we're inside the parens or not. If not, then this must * be a type (integer, real, etc). If inside the parens, then this * must be a letter or hyphen. We pass the letter as a NAME token. */ if(firsttoken == IMPLICIT) { if(lexdebug) printf("first tok is IMPLICIT, parentcount = %d\n",parencount); if(parencount > 0) { if (isalpha ( (int) *buffer.stmt)) token = name_scan (&buffer); } else { token = keyscan (tab_type, &buffer); } if(token) { tokennumber++; if(lexdebug) printf("5.1: lexer returns %s (%s)\n",tok2str(token), buffer.stmt); return token; } } /* Since we are tracking parentheses, we need to * scan for miscellaneous tokens. We are really * sniffing for parens... */ token = keyscan (tab_toks, &buffer); /* if we found no keyword and this is a READ statement, * check for an END keyword */ if(!token && (firsttoken == READ)) token = keyscan (read_toks, &buffer); if(!token && (firsttoken == OPEN)) token = keyscan (open_toks, &buffer); if (token) { if (token == OP) parencount++; if (token == CP) parencount--; tokennumber++; if(lexdebug) printf("6: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } /* Now check context again. This should be the only other * place necessary to scan for keywords. The keywords we * expect to find are THEN, CONTINUE, and logical if * statement keywords. */ if ((letterseen == TRUE && (firsttoken == IF || firsttoken == ELSEIF) && parencount == 0) || /* Takes care of labeled (numbered) statements, * i.e. 10 CONTINUE. */ firsttoken == INTEGER) { if (equalseen == TRUE) { char *stmt_copy = strdup(buffer.stmt); char *text_copy = strdup(buffer.text); /*Changed on 2/27/01 added if statement to catch if variable*/ token = keyscan (tab_stmt, &buffer); if( ((token == DO) || (token == IF)) && /* (((tokennumber != 1) && (firsttoken != INTEGER)) || */ (((tokennumber != 0) && (firsttoken != INTEGER)) || ((tokennumber != 1) && (firsttoken == INTEGER))) ) { if(lexdebug) printf("got incorrect DO or IF keyword, restoring buffer\n"); strcpy(buffer.stmt,stmt_copy); strcpy(buffer.text,text_copy); } else{ /* First, look for labeled DO statement */ strcpy(buffer.stmt,stmt_copy); strcpy(buffer.text,text_copy); if((token = keyscan (tab_stmt, &buffer)) == DO) { if(lexdebug) printf("7.1: lexer returns %s (%s)\n",tok2str(token),buffer.stmt); f2jfree(stmt_copy, strlen(stmt_copy)+1); f2jfree(text_copy, strlen(text_copy)+1); return token; } strcpy(buffer.stmt,stmt_copy); strcpy(buffer.text,text_copy); if((token = keyscan (tab_stmt, &buffer)) == IF) { if(lexdebug) printf("7.1.2: lexer returns %s (%s)\n", tok2str(token), buffer.stmt); return token; } } strcpy(buffer.stmt,stmt_copy); strcpy(buffer.text,text_copy); if (isalpha ((int) *buffer.stmt)) token = name_scan (&buffer); if (token) { tokennumber++; if(lexdebug) { printf("7.2: lexer returns %s (%s)\n",tok2str(token),buffer.stmt); if(token == NAME) printf("7.2: ...and the name is %s\n",yylval.lexeme); } f2jfree(stmt_copy, strlen(stmt_copy)+1); f2jfree(text_copy, strlen(text_copy)+1); return token; } f2jfree(stmt_copy, strlen(stmt_copy)+1); f2jfree(text_copy, strlen(text_copy)+1); } else /* equalseen == FALSE. */ { char *stmt_copy = strdup(buffer.stmt); char *text_copy = strdup(buffer.text); token = keyscan (tab_stmt, &buffer); /* There should probably be a trap in here to catch bad keywords. */ if (token) { if( ((token == DO) || (token == IF) || (token == DATA)) && /* (((tokennumber != 1) && (firsttoken != INTEGER)) || */ (((tokennumber != 0) && (firsttoken != INTEGER)) || ((tokennumber != 1) && (firsttoken == INTEGER))) ) { if(lexdebug) printf("got incorrect DO or IF keyword, restoring buffer\n"); strcpy(buffer.stmt,stmt_copy); strcpy(buffer.text,text_copy); } else { tokennumber++; if(token == FORMAT) format_stmt = 1; if(lexdebug) printf("8: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); f2jfree(stmt_copy, strlen(stmt_copy)+1); f2jfree(text_copy, strlen(text_copy)+1); return token; } } else { /* trying to trap the TO in ASSIGN integer TO name. * check tokennumber == 3 to avoid checking the name part (since the * name could be "TO"). using 3 because we have a label * number as the first token and we start numbering at 0, so * the TO keyword would be number 3. */ if(!commaseen && (tokennumber == 3)) { token = keyscan (assign_toks, &buffer); if(token) { tokennumber++; if(lexdebug) printf("8.1: lexer returns %s (%s)\n", tok2str(token), buffer.stmt); return token; } } } f2jfree(stmt_copy, strlen(stmt_copy)+1); f2jfree(text_copy, strlen(text_copy)+1); } } /* If we are parsing an ASSIGN statement, trap the TO keyword. * There's no label number, so the token number is 2. (see * comment above). */ if((firsttoken == ASSIGN) && (tokennumber == 2)) { token = keyscan (assign_toks, &buffer); if(token) { tokennumber++; if(lexdebug) printf("8.2: lexer returns %s (%s)\n", tok2str(token), buffer.stmt); return token; } } if (isalpha ((int) *buffer.stmt)) token = name_scan (&buffer); if (token) { tokennumber++; if(lexdebug) printf("firsttoken = %s and format_stmt = %s\n", tok2str(firsttoken), format_stmt?"TRUE":"FALSE"); /* check to see if we're parsing a FORMAT statment so * that we can look for edit speicification characters */ if((firsttoken == INTEGER) && (format_stmt)) { if(lexdebug) printf("****the spec is '%s'\n", yylval.lexeme); if((yylval.lexeme[0] == 'X') || (yylval.lexeme[0] == 'P') || (yylval.lexeme[0] == 'x') || (yylval.lexeme[0] == 'p')) { char *tmp; token = EDIT_DESC; if(strlen(yylval.lexeme) > 1) { if(lexdebug) printf("now we want to push '%s' back before '%s'\n", yylval.lexeme + 1,buffer.stmt); tmp = strdup(buffer.stmt); strcpy(buffer.stmt,yylval.lexeme + 1); strcat(buffer.stmt,tmp); yylval.lexeme[1] = '\0'; if(lexdebug) printf("now lexeme = '%s' and buffer.stmt = '%s'\n", yylval.lexeme,buffer.stmt); strcpy(buffer.text,buffer.stmt); } } if( (yylval.lexeme[0] == 'A') || (yylval.lexeme[0] == 'a') || (yylval.lexeme[0] == 'F') || (yylval.lexeme[0] == 'f') || (yylval.lexeme[0] == 'I') || (yylval.lexeme[0] == 'i') || (yylval.lexeme[0] == 'D') || (yylval.lexeme[0] == 'd') || (yylval.lexeme[0] == 'G') || (yylval.lexeme[0] == 'g') || (yylval.lexeme[0] == 'E') || (yylval.lexeme[0] == 'e') || (yylval.lexeme[0] == 'L') || (yylval.lexeme[0] == 'l')) { token = EDIT_DESC; /* the following if statment grabs format specs like * G10.3 (although, at this point, we've already got * G10 so now we want to grab the rest and append it) */ if( buffer.stmt[0] == '.' ) { char *bufptr = strdup(buffer.stmt); int len=1; /* len is initialized to 1, so we skip the '.' char */ while(!isdigit((int) bufptr[len])) len++; bufptr[len+1] = '\0'; strcat(yylval.lexeme,bufptr); f2jfree(bufptr, strlen(bufptr)+1); bufptr = strdup(buffer.stmt + len + 1); strcpy(buffer.stmt,bufptr); strcpy(buffer.text,bufptr); f2jfree(bufptr, strlen(bufptr)+1); } if(lexdebug) printf("8.5: lexer returns %s (%s)\n", tok2str(token),buffer.stmt); return token; } } if((firsttoken == IMPLICIT) && (!strcmp(yylval.lexeme,"NONE") || !strcmp(yylval.lexeme,"none"))) token = NONE; if(lexdebug) printf("9: lexer returns %s (%s)\n",tok2str(token),buffer.stmt); return token; } if(isdigit ((int) *buffer.stmt) || *buffer.stmt == '.') { token = number_scan (&buffer,format_stmt, tokennumber); } if (token) { tokennumber++; if(lexdebug) { printf("10: lexer returns %s (%s)\n",tok2str(token),buffer.stmt); printf("10: lexeme is '%s'\n",yylval.lexeme); } return token; } token = string_or_char_scan (&buffer); if (token) { tokennumber++; if(lexdebug) printf("11: lexer returns %s (%s)\n",tok2str(token),buffer.stmt); return token; } #endif /* SALES */ #if NOTSALES token = keyscan (tab_type, &buffer); if (token) return token; token = keyscan (tab_toks, &buffer); if (token) return token; token = keyscan (tab_stmt, &buffer); if (token) return token; /* Else... we gotta scan the silly string for NAMES or CONSTS. */ if (isalpha (*buffer.stmt)) token = name_scan (&buffer); if (token) return token; if (isdigit (*buffer.stmt)) token = number_scan (&buffer,format_stmt, tokennumber); if (token) return token; token = string_or_char_scan (&buffer); if (token) return token; #endif /* NOTSALES */ /* This code below appears to never get called. * Not sure why not. */ if(lexdebug) { printf ("Token (yylex): %d\n",token); printf("(second): lexer returning 0\n"); } return 0; } /* Close yylex(). */ /***************************************************************************** * * * open_included_file * * * * search all the include paths specified on the command line with -I (note * * that the current directory is always included first). return NULL if * * the file could not be found in any directory. * * * *****************************************************************************/ FILE * open_included_file(char *filename) { Dlist tmp; FILE *tempfp; char *prefix, *full_file = NULL; dl_traverse(tmp, include_paths) { prefix = (char *)dl_val(tmp); full_file = (char *)f2jrealloc(full_file, strlen(prefix) + strlen(filename) + 2); strcpy(full_file, prefix); strcat(full_file, FILE_DELIM); strcat(full_file, filename); if((tempfp = fopen(full_file,"rb")) != NULL) return tempfp; } return NULL; } /***************************************************************************** * * * prelex * * * * Ok, here is how it is going to work. yylex() will * * call prelex() to get a statement that has all of the * * comments pounded out of it, all the white space * * collapsed, and all of the line labels, contexts, * * continuations, etc., set. What prelex does NOT check * * is whether there is six spaces of white at the * * beginning of each statement. * * * *****************************************************************************/ int prelex (BUFFER * bufstruct) { if(lexdebug) printf("entering prelex()\n"); do { if (f2j_fgets (bufstruct->stmt, BIGBUFF, ifp) != NULL) { if(lexdebug) printf("the line is [%s](%d)\n",bufstruct->stmt, (int)strlen(bufstruct->stmt)); /* truncate anything beyond 72 characters */ bufstruct->stmt[72] = '\n'; bufstruct->stmt[73] = '\0'; /* Dispose of comments and blank lines for now. * Later, a COMMENT token can be defined and the * comment returned for inclusion in either * source or assembler code. */ if (bufstruct->stmt[0] == 'c' || bufstruct->stmt[0] == 'C' || bufstruct->stmt[0] == '*' || bufstruct->stmt[0] == '\n') { lineno++; strcpy(yylval.lexeme, bufstruct->stmt); return COMMENT; } if(lexdebug) printf ("First char in buffer: %c\n", bufstruct->stmt[0]); /* Ok, we have a line that is not a comment and that * does not start and end with a newline, i.e. blank. * If the current statement is continued on the * next line, that statement is catenated to the * current statement. */ check_continued_lines (ifp, bufstruct->stmt); collapse_white_space (bufstruct); truncate_bang_comments(bufstruct); if(bufstruct->stmt[0] == '\n') { lineno++; strcpy(yylval.lexeme, bufstruct->stmt); return COMMENT; } if( ! strncmp(bufstruct->stmt, "INCLUDE", 7) ) { /* we are probably looking at an include statement */ int iidx, yidx; BOOL ftickseen; #define FTICK 39 #define INC_OFFSET 8 if(bufstruct->stmt[7] != FTICK) { fprintf(stderr,"Badly formed INCLUDE statement\n"); strcpy(yylval.lexeme, bufstruct->stmt); return COMMENT; } yidx = 0; iidx = INC_OFFSET; ftickseen = FALSE; while( (bufstruct->stmt[iidx] != '\0') && (iidx < BIGBUFF)) { if(bufstruct->stmt[iidx] == FTICK) { if((bufstruct->stmt[iidx+1] == FTICK)) { yylval.lexeme[yidx] = bufstruct->stmt[iidx]; yylval.lexeme[yidx+1] = bufstruct->stmt[iidx+1]; iidx+=2; yidx+=2; continue; } else { ftickseen = TRUE; break; } } yylval.lexeme[yidx] = bufstruct->stmt[iidx]; iidx++; yidx++; } if(! ftickseen) { fprintf(stderr,"Badly formed INCLUDE statement\n"); strcpy(yylval.lexeme, bufstruct->stmt); return COMMENT; } yylval.lexeme[yidx] = '\0'; return INCLUDE; } if(lexdebug) printf ("From prelex: %s\n", bufstruct->stmt); lineno++; statementno++; func_stmt_num++; return 0; } /* EOF conditions. */ if(lexdebug) printf ("EOF\n"); current_file_info = (INCLUDED_FILE *)dl_pop(file_stack); if(current_file_info != NULL) { ifp = current_file_info->fp; lineno = current_file_info->line_num; } }while(current_file_info != NULL); bufstruct->stmt[0] = '\0'; return 0; } /***************************************************************************** * * * truncate_bang_comments * * * * This routine takes the buffer after it has had all continued lines * * appended and removes "!" style comments. * * * *****************************************************************************/ void truncate_bang_comments(BUFFER * bufstruct) { BOOL in_string = FALSE; char *cp; for (cp = bufstruct->stmt; *cp; cp++) { /* if we see a '!' and we're not in the middle of a string, then * truncate the remaining comment. */ if(*cp == '!' && !in_string) { *cp = '\n'; *(cp+1) = '\0'; break; } if(*cp == '\'') { if(in_string) { if(*(cp+1) != '\'') in_string = FALSE; else cp++; } else { in_string = TRUE; } } } } /***************************************************************************** * * * collapse_white_space * * * * Get rid of all of the white space, newlines, etc. in the * * statement. Literal strings are handled by keeping the * * quoting ticks (') and copying the quoted text verbatim * * into the returned string. This routine modifies the * * character array stored in the fields of `bufstruct'. * * This procedure also implements Sale's algorithm to trap * * keywords. * *****************************************************************************/ void collapse_white_space (BUFFER * bufstruct) { /* `cp' is character pointer, `tcp' is temporary cp and * `yycp' points at the text buffer for some (what?) reason. */ register char *cp, *tcp, *yycp; char tempbuf[BIGBUFF]; int parens = 0; commaseen = FALSE, equalseen = FALSE, letterseen = FALSE; tcp = tempbuf; yycp = bufstruct->text; if(lexdebug) printf("entering collapse_white_space, buffer is [%s]\n", bufstruct->stmt); for (cp = bufstruct->stmt; *cp; cp++) { /* Get rid of all of the newlines, tabs, whitespace. */ if (*cp == ' ' || *cp == '\t' || *cp == '\n') continue; /* If a single front tick is seen, stand by * to copy a literal string, delimited between * two tick marks. This section in here was left out * the string in the prelexed statement. This was * handled with at hack. */ if (*cp == '\'') /* Escape the tick mark with a slash "\" */ { int done=FALSE; *tcp = *cp; tcp++; /* Hack... */ *yycp = *cp; yycp++; cp++; while(!done) { while (*cp != '\'') /* Literal copy until next tick. */ { *tcp = *cp; tcp++; /* Hack... All this while loop does is increment * without using the toupper function. The next * two lines were left out originally. */ *yycp = *cp; yycp++; cp++; } /* End while() for copying strings. */ /* At this point, we have seen a tick, but now we * determine whether it is really the end of the string * or an escape sequence e.g. * str = 'doesn''t parse' * 9/30/97 --Keith */ if(*(cp+1) == '\'') /* if next char after tick is a tick */ { *tcp = *cp; tcp++; *yycp = *cp; yycp++; cp++; *tcp = *cp; tcp++; *yycp = *cp; yycp++; cp++; } else done = TRUE; } /* end while(not done) */ } /* End if() for copying character strings. */ /* We need to track the number of opening and closing * parentheses "(" and ")" to implement Sale's algorithm. */ if(*cp == '(') parens++; if(*cp == ')') parens--; /* Examine the characters outside of matching parentheses. * Whats between matching parentheses doesn't matter. */ if(parens == 0) { if(*cp == ',') commaseen = TRUE; if(*cp == '=') equalseen = TRUE; if (*cp == ')') { char * lpp; /* Last parens pointer, temporary. */ /* Ok, lets peep ahead to the next non-whitespace * character and see if its a letter. The for() * loop merely sets the pointer for look-ahead. */ for (lpp=cp+1;isspace((int) *lpp);lpp++); /* Since we have an opportunity, let's trap the * error condition of having isspace() pick up * a newline following the last paren. */ /* * if (*lpp == '\n') * { * printf("Bad syntax, \" followed by \"\\n\"\n"); * exit(EXIT_FAILURE); * } * else */ if (isalpha((int) *lpp)) letterseen = TRUE; } /* End if for ")". */ } /* End if for no parens. */ *yycp = *cp; yycp++; *tcp = toupper (*cp); tcp++; } /* End of for() loop. */ /* Insert newline for statement separator. This helps parse * situations where end and beginning of adjacent statements * are NAME tokens, i.e. NAME NAME, etc. Also, newlines are * natural fortran statement separators. */ *yycp = '\n'; *tcp = '\n'; /* Insert an null character to mark the end of the string. */ *(yycp+1) = 0; *(tcp+1) = 0; /* Our new string is ready for lexing! */ strcpy (bufstruct->stmt, tempbuf); strcpy (line_buffer, tempbuf); } /***************************************************************************** * * * Check and see whether the next line continues the * * present line. Marker for line continuation is any character * * in column 6. * *****************************************************************************/ void check_continued_lines (FILE * fp, char *current_line) { int items, short_line; char next_line[100]; int i,j ; /* rws indexes for chopping off end of line */ /* Now we have to determine whether the statement * is continued on the next line by getting another * line and examining column 6 for a continuation marker. */ for(;;) { next_line[0] = '\0'; items = fread (next_line, 1, 6, fp); /* If we are NOT at the end of file, reset the * pointer to the start of the line so that * the next fgets will grab the entire line. */ if(items == 0) return; /* End of file. */ /* check for a newline within the first 6 characters * of the next line. if one exists, it cannot be a * continued line. */ short_line = 0; for(i=0;istmt; yycp = bufstruct->text; while (tab->kwd) { /* Get the stringlength of the token in the symbol table. * A better way to do this might be to include the length * of the keyword in the table instead of computing it * everytime. */ tokenlength = strlen (tab->kwd); /* Try to match a substring of the current string (scp).*/ if (!strncmp (scp, tab->kwd, tokenlength)) { if(tokenlength > YYTEXTLEN-1) fprintf(stderr,"Warning: going to write past yytext (%d)\n", tokenlength); strncpy (yytext, yycp, tokenlength); yycp += tokenlength; yytext[tokenlength] = '\0'; strcpy(swap_buf, yycp); strcpy(bufstruct->text, swap_buf); /* Save the type or kind of relational operator * immediate reduction in the parser. This * implementation is pretty lame, a hold over * from Levine's quick and dirty lexer. */ if((tab->ktok == ARITH_TYPE) || (tab->ktok == CHAR_TYPE)) yylval.type = tab->klex; if(tab->ktok == RELOP) yylval.tok = tab->klex; /* Now set the string pointer to point at the first * character past the end of the string. */ scp += tokenlength; strcpy(swap_buf, scp); strcpy(bufstruct->stmt, swap_buf); return tab->ktok; } tab++; /* Check the next table entry. */ } /* Close the while() loop. */ return 0; /* Not a recognized token. */ } /* Close keyscan(). */ /***************************************************************************** * * * methodscan * * * * Called after hash lookup indicates there is java method * * equivalent in the fortran source code. Returns a pointer * * to the java string equivalent to the fortran source code. * * This is surely a hack. * *****************************************************************************/ METHODTAB * methodscan (METHODTAB * tab, char * name) { /* The method translation table is initialized in * the header block of this file. We treat the table * as a linear linked list by stepping through the * array entries with the pointer `*tab'. Note that * `NULL' last entry in the table shuts down the for() * loop. */ while (tab->fortran_name != NULL) { if (tab->fortran_name == NULL) return NULL; if (!strcmp (tab->fortran_name,name)) { if(lexdebug) printf("java_name: %s\n", tab->java_method); return tab; } tab++; } /* Close for() loop. */ return NULL; /* Not in table. */ } /* Close methodscan(). */ /***************************************************************************** * * * name_scan * * * * Scan a card image for a named identifier. * *****************************************************************************/ int name_scan (BUFFER * bufstruct) { char *ncp, *tcp, swap_buf[BIGBUFF]; unsigned int tokenlength = 0; ncp = bufstruct->stmt; tcp = bufstruct->text; /* Find the name. * We checked the first character in yylex to make sure * it was alphabetic. */ while (isalnum ((int) *ncp) || (*ncp == '_')) { ncp++; tokenlength++; } strncpy (yylval.lexeme, tcp, tokenlength); yylval.lexeme[tokenlength] = '\0'; tcp += tokenlength; strcpy(swap_buf, tcp); strcpy(bufstruct->text, swap_buf); strcpy(swap_buf, ncp); strcpy(bufstruct->stmt, swap_buf); return NAME; } /* Close name_scan(). */ /***************************************************************************** * * * number_scan * * * * Scan a card image for a numerical constant. * * Need to add code in here to change exp numbers * * to doubles, or at least to replace the instances * * of 'd' and 'D' with 'e'. * * * * 9/30/97 - Added fmt parameter which is a boolean * * representing whether or not this number occurs * * within a format statement. If so, we only * * want to return the integer part of the spec... * * e.g., if our input is 2D36.8, just return 2 * * --Keith * *****************************************************************************/ int number_scan (BUFFER * bufstruct, int fmt, int toknum) { char *ncp, *tcp, swap_buf[BIGBUFF]; BUFFER tempbuf; int token; unsigned int tokenlength = 0; int type = INTEGER; /* Default, in case we find nothing else. */ ncp = bufstruct->stmt; /* Number character pointer. */ tcp = bufstruct->text; /* Literal text character pointer. */ if(lexdebug) { printf("here in number scan\n buf.stmt = '%s'\n",bufstruct->stmt); printf(" buf.text = '%s'\n",bufstruct->text); } if(fmt || (toknum == 0)) { while(isdigit ((int) *ncp)) { ncp++; tokenlength++; } } else { /* Test and see whether it is a number (constant). * If so, store the literal text in yytext. These * long logical expressions are probably not very * efficient, but they should be easy to read. */ while (isdigit ((int) *ncp) || *ncp == '.' || *ncp == 'D' || *ncp == 'd' || *ncp == 'E' || *ncp == 'e') { switch (*ncp) { case '.': /* If there is a dot, there may be a float or double or * exponential, or an integer followed by a keyword such as * .AND., .OR., etc. */ strcpy (tempbuf.stmt, ncp); strcpy (tempbuf.text, tcp); token = keyscan (tab_toks, &tempbuf); if (token) break; /* Leave the while() loop. */ /* Else if there is no token returned, check for * the usual double or exponential number. */ /* If the next character, i.e. *(ncp+1) is a digit, * increment and continue while loop, * else get out of while loop. */ if (isdigit ((int) *(ncp + 1))) { ncp += 2; tokenlength += 2; type = FLOAT; /* Case of `nn.dd...' */ /* Control passes to back to * while() loop; get another * character. */ continue; } else { ncp++; tokenlength++; type = FLOAT; /* Case of `nn.' */ /* Back to while() loop * for another character.*/ continue; } case 'E': case 'e': case 'D': case 'd': /* This exponential notation stuff works pretty good. * It will need to be modified to express the * number in exponential notation as an equivalent * double. * * First, take care of the case that looks like this: * 1.0e+1 or 1.0e-1. */ if (*(ncp + 1) == '+' || *(ncp + 1) == '-') { if(*ncp == 'e' || *ncp == 'E') type = E_EXPONENTIAL; else type = D_EXPONENTIAL; ncp += 2; tokenlength += 2; continue; /* Loop again. */ } /* Now take care of cases that look like this: 1.0e1. */ if (isdigit ((int) *(ncp + 1))) { if(*ncp == 'e' || *ncp == 'E') type = E_EXPONENTIAL; else type = D_EXPONENTIAL; ncp++; tokenlength++; continue; /* Loop again. */ } else break; /* Break switch. */ default: /* All digits do this. */ ncp++; tokenlength++; continue; /* Loop again. */ } /* Close switch(). */ break; } /* Close while() loop. */ } if(lexdebug) { printf("ok that was fun, ncp = '%s', tcp = '%s'",ncp,tcp); printf(" and tokenlength = %d\n",tokenlength); } strncpy (yylval.lexeme, tcp, tokenlength); yylval.lexeme[tokenlength] = '\0'; if(lexdebug) printf ("Number: %s\n", yytext); tcp += tokenlength; strcpy(swap_buf, tcp); strcpy(bufstruct->text, swap_buf); strcpy(swap_buf, ncp); strcpy(bufstruct->stmt, swap_buf); return type; } /* Close name_ident_scan(). */ /***************************************************************************** * * * string_or_char_scan * * * * Scan a string, making sure to check for escaped ticks in the text. * *****************************************************************************/ int string_or_char_scan (BUFFER * bufstruct) { unsigned int tokenlength = 0; char *scp, *textcp, swap_buf[BIGBUFF]; scp = bufstruct->stmt; textcp = bufstruct->text; /* Test and see if there is a tic (`'') mark. */ if (*scp == '\'') { int done = FALSE; scp++; textcp++; if(lexdebug) printf ("scp: %s\n", scp); /* Loop until we find another tick (') mark. */ while(!done) { while (*scp != '\'') { scp++; tokenlength++; } /* Now we determine whether this is the final tick * or just an escape sequence to actually print a * tick. If it's an escape, substitute a backslash * for the first tick. that is, '' -> \' * 9/30/97 --Keith * * I'm not sure why I was using backslash here, but * it wasn't necessary, so changing it to just blank * the first tick. * 7/5/04 --keith */ if( *(scp + 1) == '\'' ) { *(textcp + tokenlength) = ' '; scp+=2; tokenlength+=2; } else done = TRUE; } if(tokenlength > YYTEXTLEN-1) fprintf(stderr,"Warning: going to write past yytext (%d)\n", tokenlength); strncpy (yytext, textcp, tokenlength); yytext[tokenlength] = '\0'; /* Terminate the string at tick. */ strcpy(yylval.lexeme, yytext); textcp += tokenlength; /* Now increment to get past the tic marks. */ scp++; textcp++; strcpy(swap_buf, scp); strcpy(bufstruct->stmt, swap_buf); strcpy(swap_buf, textcp); strcpy(bufstruct->text, swap_buf); /* Reset the value; strlen does not include the value * of '\0' that terminates the string. */ tokenlength = strlen(yylval.lexeme); if (tokenlength == 1) return CHAR; else return STRING; } else return 0; } /* Close string_or_char_scan(). */ char * f2j_fgets(char *s, int n, FILE *f) { char *rv; int len; rv = fgets(s, n, f); if(rv == NULL) return NULL; len = strlen(s); switch(len) { case 0: s[0] = '\0'; break; case 1: s[0] = '\n'; s[1] = '\0'; break; default: if( s[len-2] == '\r' ) { s[len -2] = '\n'; s[len -1] = '\0'; } break; } return s; } /***************************************************************************** * * * tok2str * * * * Return the string representation of a token. This function is used * * primarily for debugging purposes. * *****************************************************************************/ char * tok2str(int tok) { switch(tok) { case PLUS: return("PLUS"); case MINUS: return("MINUS"); case OP: return("OP"); case CP: return("CP"); case STAR: return("STAR"); case POW: return("POW"); case DIV: return("DIV"); case CAT: return("CAT"); case CM: return("CM"); case EQ: return("EQ"); case COLON: return("COLON"); case NL: return("NL"); case NOT: return("NOT"); case AND: return("AND"); case OR: return("OR"); case RELOP: return("RELOP"); case EQV: return("EQV"); case NEQV: return("NEQV"); case NAME: return("NAME"); case DOUBLE: return("DOUBLE"); case INTEGER: return("INTEGER"); case E_EXPONENTIAL: return("E_EXPONENTIAL"); case D_EXPONENTIAL: return("D_EXPONENTIAL"); case CONST_EXP: return("CONST_EXP"); case TrUE: return("TrUE"); case FaLSE: return("FaLSE"); case ICON: return("ICON"); case RCON: return("RCON"); case LCON: return("LCON"); case CCON: return("CCON"); case FLOAT: return("FLOAT"); case CHARACTER: return("CHARACTER"); case LOGICAL: return("LOGICAL"); case COMPLEX: return("COMPLEX"); case NONE: return("NONE"); case IF: return("IF"); case THEN: return("THEN"); case ELSE: return("ELSE"); case ELSEIF: return("ELSEIF"); case ENDIF: return("ENDIF"); case ENDDO: return("ENDDO"); case DO: return("DO"); case GOTO: return("GOTO"); case ASSIGN: return("ASSIGN"); case TO: return("TO"); case CONTINUE: return("CONTINUE"); case STOP: return("STOP"); case PAUSE: return("PAUSE"); case RDWR: return("RDWR"); case END: return("END"); case STRING: return("STRING"); case CHAR: return("CHAR"); case OPEN: return("OPEN"); case CLOSE: return("CLOSE"); case BACKSPACE: return("BACKSPACE"); case REWIND: return("REWIND"); case ENDFILE: return("ENDFILE"); case FORMAT: return("FORMAT"); case PROGRAM: return("PROGRAM"); case FUNCTION: return("FUNCTION"); case SUBROUTINE: return("SUBROUTINE"); case ENTRY: return("ENTRY"); case CALL: return("CALL"); case RETURN: return("RETURN"); case ARITH_TYPE: return("ARITH_TYPE"); case CHAR_TYPE: return("CHAR_TYPE"); case DIMENSION: return("DIMENSION"); case COMMON: return("COMMON"); case EQUIVALENCE: return("EQUIVALENCE"); case EXTERNAL: return("EXTERNAL"); case PARAMETER: return("PARAMETER"); case INTRINSIC: return("INTRINSIC"); case IMPLICIT: return("IMPLICIT"); case SAVE: return("SAVE"); case DATA: return("DATA"); case COMMENT: return("COMMENT"); case WRITE: return("WRITE"); case FMT: return("FMT"); case READ: return("READ"); case EDIT_DESC: return("EDIT_DESC"); case REPEAT: return("REPEAT"); default: { static char asdf[20]; sprintf(asdf,"Unknown token: %d\n",tok); return(asdf); } } } f2j-0.8.1/src/f2jmain.c0000600000077700002310000005476311031241063014542 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2jmain.c,v $ * $Revision: 1.69 $ * $Date: 2008/06/24 21:03:44 $ * $Author: keithseymour $ */ /***************************************************************************** * f2jmain.c * * * * This file contains the main routine for the Fortran-to-Java translator. * * * *****************************************************************************/ #include #include #include #include #include #include #include #include #include #include"f2j-config.h" #include"f2j.h" #include"y.tab.h" #include"dlist.h" #include"f2jmem.h" #include"f2j_externs.h" extern char *java_reserved_words[]; extern char *blas_routines[]; extern char *generic_intrinsics[]; extern char *unit_name; extern char *optarg; extern Dlist file_stack; extern Dlist include_paths; #ifdef _WIN32 char null_file[] = "f2j.tmp"; #else char null_file[] = "/dev/null"; #endif FILE *devnull; /* pointer to the file /dev/null */ AST *addnode(void); char *f2j_fgets(char *, int, FILE *); SYMTABLE *new_symtable (int); int yyparse (void); void type_insert (SYMTABLE *, AST *, enum returntype, char *), handle_segfault(int), insert_entries(char *, Dlist); extern int getopt(int, char *const *, const char *); /***************************************************************************** * main * * * * This is the main f2java routine. Parse the command-line options and * * open the input file. * * * *****************************************************************************/ int main (int argc, char **argv) { char classname[130]; char *truncfilename; char sourcename[130]; char vcgname[130]; char *indexname; char *f2jpath; char *search_path; AST *temp; int errflg = 0; int c; int i; /* split the help string into multiple sections to comply * with some iso standard on string lengths... */ char f2java_help[] = "The program is used as follows:\n\n\ To compile a program into Java source code:\n\ f2java filename\n\n"; char f2java_help_I_option[] = "The -I option specifies\ a path to be searched for\nincluded files (may be used\ multiple times).\n\n"; #ifdef _WIN32 char f2java_help_c_option[] = "The -c option may also be\ used to specify the search\n\ path for \".f2j\" files. It is a semicolon-separated\n\ list of paths, like a Java CLASSPATH). For example:\n\n\ f2java -c .;..\\objects filename\n\n"; #else char f2java_help_c_option[] = "The -c option may also be\ used to specify the search\n\ path for \".f2j\" files. It is a colon-separated\n\ list of paths, like a Java CLASSPATH). For example:\n\n\ f2java -c .:../objects filename\n\n"; #endif char f2java_help_p_option[] = "The -p option may also be\ used to specify the name\n\ of the package. For example:\n\n\ f2java -p org.netlib.blas filename\n\n"; char f2java_help_o_option[] = "The -o option specifies\ the destination directory\n\ to which the code should be written.\n\n"; char f2java_help_w_option[] = "The -w option forces all\ scalars to be generated as\n\ wrapped objects. The default behavior is to only\n\ wrap those scalars that must be passed by reference.\n\n"; char f2java_help_i_option[] = "The -i option causes f2j\ to generate a high-level\n\ interface to each subroutine and function.\n\n"; char f2java_help_h_option[] = "The -h option displays\ this helpful information.\n\n"; char f2java_help_s_option[] = "The -s option causes f2j\ to simplify the interfaces\n\ by removing the offset parameter and using a zero offset.\n\ It isn't necessary to specify the -i flag in addition\n\ to the -s.\n\n"; char f2java_help_d_option[] = "The -d options causes f2j\ to generate comments in\n\ a format suitable for javadoc. It is a bit of a LAPACK-\n\ specfic hack...the longest comment in the program unit\n\ is placed in the javadoc comment. It works fine for\n\ BLAS/LAPACK code (or any other code where the longest\n\ comment is the one that describes the function), but\n\ will most likely not work for other code.\n\n"; char f2java_help_fm_option[] = "The -fm option causes f2j\ to generate code that calls\njava.lang.StrictMath\ instead of java.lang.Math. By\ndefault, java.lang.Math is used.\n\n"; char f2java_help_fs_option[] = "The -fs option causes f2j\ to declare the generated\ncode as strictfp (strict floating point).\ By default,\nthe generated code is not strict.\n\n"; char f2java_help_fb_option[] = "The -fb option enables\ both the -fm and -fs options.\n\n"; char f2java_help_vs_option[] = "The -vs option causes f2j\ to generate all variables\nas static class variables.\ By default f2j generates\nvariables as locals.\n\n"; char f2java_help_va_option[] = "The -va option causes f2j\ to generate arrays\nas static class variables,\ but other\nvariables are generated as locals.\n\n"; signal(SIGSEGV,handle_segfault); omitWrappers = TRUE; strictMath = FALSE; strictFp = FALSE; genInterfaces = FALSE; genJavadoc = FALSE; noOffset = FALSE; package_name = NULL; output_dir = NULL; search_path = NULL; save_all_override = FALSE; f2j_arrays_static = FALSE; file_stack = make_dl(); include_paths = make_dl(); dl_insert_b(include_paths, "."); ignored_formatting = 0; bad_format_count = 0; while((c = getopt(argc,argv,"I:c:p:wif:sdho:v:")) != EOF) switch(c) { case 'I': dl_insert_b(include_paths, optarg); break; case 'c': search_path = optarg; break; case 'p': package_name = optarg; break; case 'f': if(!strcmp("b", optarg)) strictMath = strictFp = TRUE; else if(!strcmp("m", optarg)) strictMath = TRUE; else if(!strcmp("s", optarg)) strictFp = TRUE; break; case 'w': omitWrappers = FALSE; break; case 'h': printf("This is Fortran-to-Java version %s.\n\n", F2J_VERSION); printf("%s",f2java_help); printf("%s",f2java_help_I_option); printf("%s",f2java_help_c_option); printf("%s",f2java_help_p_option); printf("%s",f2java_help_o_option); printf("%s",f2java_help_w_option); printf("%s",f2java_help_i_option); printf("%s",f2java_help_h_option); printf("%s",f2java_help_s_option); printf("%s",f2java_help_d_option); printf("%s",f2java_help_fm_option); printf("%s",f2java_help_fs_option); printf("%s",f2java_help_fb_option); printf("%s",f2java_help_vs_option); printf("%s",f2java_help_va_option); exit(EXIT_SUCCESS); break; case 'i': genInterfaces = TRUE; break; case 'd': genJavadoc = TRUE; break; case 's': noOffset = TRUE; break; case 'v': if(!strcmp("s", optarg)) save_all_override = TRUE; else if(!strcmp("a", optarg)) f2j_arrays_static = TRUE; else { fprintf(stderr,"-v%s: bad argument\n",optarg); errflg++; } break; case 'o': output_dir = optarg; break; case '?': errflg++; break; default: printf("Bad arg.\n"); break; } if(errflg || (argc < 2)) { fprintf(stderr, "Usage: f2java [-I include path] [-c search path]"); fprintf(stderr, " [-p package name] [-o output dir]"); fprintf(stderr, " [-w] [-i] [-s] [-d] [-vs] [-va] [-fs] [-fm] [-fb] \n"); fprintf(stderr, "For help: f2java -h\n"); exit(EXIT_FAILURE); } if(noOffset) genInterfaces = TRUE; inputfilename = argv[argc - 1]; if((ifp = fopen (inputfilename, "rb"))==NULL) { fprintf(stderr,"Input file not found: '%s'\n",inputfilename); exit(EXIT_FAILURE); } current_file_info = (INCLUDED_FILE *)f2jalloc(sizeof(INCLUDED_FILE)); current_file_info->name = strdup(inputfilename); current_file_info->line_num = 0; current_file_info->fp = ifp; truncfilename = strdup(inputfilename); truncfilename = strtok (truncfilename, "."); *truncfilename = toupper (*truncfilename); /* Loathsome hacks... */ strcpy (classname, truncfilename); strcpy (sourcename, truncfilename); strcpy (vcgname, truncfilename); strcat (sourcename, ".java"); strcat (vcgname, ".vcg"); initialize (); #if VCG if((vcgfp = fopen(vcgname, "w"))==NULL) { fprintf(stderr,"Cannot open output file '%s'.\n",sourcename); perror("Reason"); exit(EXIT_FAILURE); } #endif indexname = (char *)f2jalloc(strlen(truncfilename) + 5); strcpy(indexname, truncfilename); strcat(indexname, ".f2j"); if((indexfp = bc_fopen_fullpath(indexname,"w", output_dir)) == NULL) { fprintf(stderr,"Error opening index file: '%s'\n", indexname); exit(EXIT_FAILURE); } /* the Java keywords are stored in a list of strings. Store them * all in a hash table for quick lookup. */ java_keyword_table = (SYMTABLE *) new_symtable (211); temp = addnode(); for(i=0;java_reserved_words[i] != NULL; i++) type_insert(java_keyword_table,temp,0,java_reserved_words[i]); blas_routine_table = (SYMTABLE *) new_symtable(211); temp = addnode(); for(i=0;blas_routines[i] != NULL; i++) type_insert(blas_routine_table,temp,0,blas_routines[i]); generic_table = (SYMTABLE *) new_symtable(211); temp = addnode(); for(i=0;generic_intrinsics[i] != NULL; i++) type_insert(generic_table,temp,0,generic_intrinsics[i]); /* if search path was not specified on command line, then * check for environment variable. */ if(search_path == NULL) { f2jpath = getenv(F2J_PATH_VAR); if(f2jpath == NULL) { /* can't use strtok on constant strings, so create a new one here */ f2jpath = strdup("."); } } else f2jpath = search_path; descriptor_table = build_method_table(f2jpath); devnull = fopen(null_file,"w"); if(devnull == NULL) { fprintf(stderr,"Cannot open %s for writing\n", null_file); exit(EXIT_FAILURE); } fprintf(stderr,"%s:\n",inputfilename); if(yyparse() != 0) { fprintf(stderr, "Parsing failed.\n"); exit(EXIT_FAILURE); } fclose(ifp); #if VCG fclose(vcgfp); #endif if(bad_format_count > 0) fprintf(stderr,"Unsupported formatting (%d statements)\n", bad_format_count); if(ignored_formatting > 0) fprintf(stderr,"Ignored %d format statement(s) with implied loops\n", ignored_formatting); if(fclose(indexfp) < 0) { fprintf(stderr,"error closing indexfp...\n"); perror("reason"); } if(fclose(devnull) < 0) { fprintf(stderr,"error closing devnull...\n"); perror("reason"); } #ifdef _WIN32 /* for windows, we should delete the temp file created earlier. */ if(remove(null_file) < 0) { fprintf(stderr,"couldn't remove temp file...\n"); perror("reason"); } #endif exit(EXIT_SUCCESS); } /***************************************************************************** * * * javaheader * * * * The header for the Java source will depend on whether the * * BLAS or LAPACK routines are being compiled. The way this * * works is to have the CLASSPATH point at the directory that * * contains directories that contain the actual classes. * * The preprocessor junk is a necessary evil, at least temporarily. * * * *****************************************************************************/ void javaheader (FILE * fp, char *reflect) { fprintf(fp,"/*\n"); fprintf(fp," * Produced by f2java. f2java is part of the Fortran-\n"); fprintf(fp," * -to-Java project at the University of Tennessee Netlib\n"); fprintf(fp," * numerical software repository.\n *\n"); fprintf(fp," * Original authorship for the BLAS and LAPACK numerical\n"); fprintf(fp," * routines may be found in the Fortran source, available at\n"); fprintf(fp," * http://www.netlib.org.\n *\n"); fprintf(fp," * Fortran input file: %s\n", inputfilename); fprintf(fp," * f2java version: %s\n *\n", F2J_VERSION); fprintf(fp," */\n\n"); if(package_name != NULL) fprintf(fp,"package %s;\n",package_name); fprintf(fp,"import java.lang.*;\n"); fprintf(fp,"import org.netlib.util.*;\n\n"); fprintf(fp,"%s", reflect); /* the import stmt for reflection capability */ fprintf(fp,"\n\n"); } /***************************************************************************** * initialize * * * * Take care of some other crap that cannot be handled in the * * parser. Basically, I should initialize ALL of the symbol * * tables in here, then access all of them as externs. As a * * matter of fact, I should put all initializations into their * * own file. * * * *****************************************************************************/ void initialize () { int tablesize = 211; lineno = 0; statementno = 0; func_stmt_num = 0; /* * array_table = (SYMTABLE *) new_symtable (tablesize); * format_table = (SYMTABLE *) new_symtable (tablesize); * data_table = (SYMTABLE *) new_symtable (tablesize); * save_table = (SYMTABLE *) new_symtable (tablesize); * common_table = (SYMTABLE *) new_symtable (tablesize); * parameter_table = (SYMTABLE *) new_symtable (tablesize); */ common_block_table = (SYMTABLE *) new_symtable (tablesize); function_table = (SYMTABLE *) new_symtable (tablesize); global_func_table = (SYMTABLE *) new_symtable (tablesize); global_common_table = (SYMTABLE *) new_symtable (tablesize); } /***************************************************************************** * uppercase * * * * This should be located in some other file * * than main(). Procedure simply uppercases * * every character in a string. * * * *****************************************************************************/ void uppercase(char * name) { while (*name) { *name = toupper(*name); name++; } } /***************************************************************************** * * * handle_segfault * * * * This function is called whenever the program seg faults. We flush * * stdout so that we can get a better idea of where the program was when it * * crashed. * * * *****************************************************************************/ void handle_segfault(int x) { fflush(stdout); fprintf(stderr,"Segmentation Fault, stdout flushed. [%d]\n", x); if(unit_name != NULL) fprintf(stderr,"unit name is %s\n",unit_name); fflush(stderr); exit(EXIT_FAILURE); } /***************************************************************************** * * * build_method_table * * * * this function searches through all the .f2j files found in directories * * specified in the user's F2J_SEARCH_PATH environment variable and builds * * a list of the method descriptors. * * * *****************************************************************************/ Dlist build_method_table(char *path) { char *token; struct dirent *dir_entry; DIR *cur_dir; int len; int size = 5; char * full_path; Dlist paths, tmp, new_table; new_table = make_dl(); full_path = (char *)f2jalloc(size); token = strtok(path, PATH_DELIM); if(token == NULL) return NULL; paths = make_dl(); /* gotta build a list of tokens in the F2J_SEARCH_PATH * because nested calls to strtok() don't work. */ do { dl_insert_b(paths, token); } while( (token = strtok(NULL, PATH_DELIM)) != NULL); dl_traverse(tmp, paths) { token = (char *) tmp->val; if((cur_dir = opendir(token)) == NULL) continue; while((dir_entry = readdir(cur_dir)) != NULL) { len = strlen(dir_entry->d_name); if((len > 4) && !strncmp(dir_entry->d_name+(len-4), ".f2j", 4)) { if((len + strlen(token) +2) > (unsigned int)size) { size = (len + strlen(token)) * 2; /* double for good measure */ full_path = f2jrealloc(full_path, size); } strcpy(full_path, token); if(full_path[strlen(full_path)-1] != FILE_DELIM[0]) strcat(full_path, FILE_DELIM); strcat(full_path, dir_entry->d_name); insert_entries(full_path, new_table); } } closedir(cur_dir); } f2jfree(full_path, size); dl_delete_list(paths); return new_table; } /***************************************************************************** * * * find_method * * * * this function searches the given Dlist for a method reference matching * * the given method name. the first matching entry is returned. * * * *****************************************************************************/ JVM_METHODREF * find_method(char *meth, Dlist methtab) { Dlist tmp; JVM_METHODREF * entry; dl_traverse(tmp, methtab) { entry = (JVM_METHODREF *) tmp->val; if( !strcmp(entry->methodname, meth) ) return entry; } return NULL; } /***************************************************************************** * * * get_line * * * * Keeps reading chunks from the specified file until a newline is found. * * Appends all the chunks to one string and returns that. * * * *****************************************************************************/ char * get_line(FILE *in) { #define BUFSZ 400 char buf[BUFSZ]; char *rv, *line, *ltmp; int idx = 0, cur_size = BUFSZ; if(!in) return NULL; line = (char *)malloc(BUFSZ); *line = '\0'; if(!line) return NULL; do { rv = fgets(buf, BUFSZ, in); if(!rv) return NULL; memcpy(line+idx, buf, BUFSZ); idx += strlen(buf); cur_size += BUFSZ; ltmp = realloc(line, cur_size); if(!ltmp) return NULL; line = ltmp; } while(buf[strlen(buf)-1] != '\n'); return line; } /***************************************************************************** * * * insert_entries * * * * given the filename, insert all method/descriptor entries from that file * * into the specified Dlist. * * * *****************************************************************************/ void insert_entries(char *path, Dlist methtab) { char * class, * method, * desc, * buf; FILE *in; if((in = fopen(path, "rb")) == NULL) return; while((buf=get_line(in)) != NULL) { buf[strlen(buf)-1] = '\0'; class = strtok(buf,":"); method = strtok(NULL,":"); desc = strtok(NULL,":"); if(!class || !method || !desc) continue; dl_insert_b(methtab, bc_new_method_node(class,method,desc)); } fclose(in); return; } /***************************************************************************** * * * strAppend * * * * Append the given string value (new) to the expandable string (str), * * allocating more memory if necessary. * * * *****************************************************************************/ struct _str * strAppend(struct _str *str, char *new) { if(str == NULL) { str = (struct _str *)f2jalloc(sizeof (struct _str)); str->size = STR_INIT; str->val = (char *)f2jalloc(STR_INIT); str->val[0] = '\0'; } if(strlen(new) + strlen(str->val) >= str->size) { if(strlen(new) > STR_CHUNK) { str->val = (char *)f2jrealloc(str->val, str->size + strlen(new)); str->size += strlen(new); } else { str->val = (char *)f2jrealloc(str->val, str->size + STR_CHUNK); str->size += STR_CHUNK; } } strcat(str->val, new); return str; } f2j-0.8.1/src/f2jmem.c0000600000077700002310000001475411031241063014370 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2jmem.c,v $ * $Revision: 1.16 $ * $Date: 2007/12/12 21:47:41 $ * $Author: keithseymour $ */ /***************************************************************************** * f2jmem.c * * * * This file contains the memory management routines for f2j. * * * *****************************************************************************/ #include"f2jmem.h" /***************************************************************************** * * * f2jfree * * * * Wrapper around free which may overwrite the memory such that we can find * * problems early (only if DEBUG_MEM is defined). * * * *****************************************************************************/ void f2jfree(void *p, size_t size) { #ifdef DEBUG_MEM memset(p, 0xA, size); #endif free(p); } /***************************************************************************** * * * f2jalloc * * * * Error-checking memory allocation routine for f2java. we can't recover * * from an out of memory condition, so we'll just call exit() which will * * close all open streams for us. * * * *****************************************************************************/ void * f2jalloc(size_t numbytes) { void * mem = malloc(numbytes); if(mem == NULL) alloc_error(numbytes); return mem; } /***************************************************************************** * * * f2jcalloc * * * * Error-checking memory allocation routine for f2java. we can't recover * * from an out of memory condition, so we'll just call exit() which will * * close all open streams for us. * * * *****************************************************************************/ void * f2jcalloc(size_t numitems, size_t numbytes) { void * mem = calloc(numitems, numbytes); if(mem == NULL) alloc_error(numbytes); return mem; } /***************************************************************************** * * * f2jrealloc * * * * Error-checking memory allocation routine for f2java. we can't recover * * from an out of memory condition, so we'll just call exit() which will * * close all open streams for us. * * * *****************************************************************************/ void * f2jrealloc(void *ptr, size_t size) { void *mem = realloc(ptr, size); if(mem == NULL) alloc_error(size); return mem; } /***************************************************************************** * * * alloc_error * * * * called when there is an error allocating memory. this function prints * * an error message and exits. * * * *****************************************************************************/ void alloc_error(size_t size) { fprintf(stderr,"f2java: Error allocating %d bytes of memory. Stopping.\n", (int)size); perror("Reason:"); exit(EXIT_FAILURE); } /***************************************************************************** * * * free_var_info * * * * frees a variable info structure. * * * *****************************************************************************/ void free_var_info(struct var_info *v) { f2jfree(v->name, strlen(v->name)+1); f2jfree(v->desc, strlen(v->desc)+1); f2jfree(v->class, strlen(v->class)+1); f2jfree(v, sizeof(struct var_info)); } /***************************************************************************** * free_ast_node * * * * * *****************************************************************************/ void free_ast_node(AST *n) { if( n == NULL ) return; switch(n->nodetype) { case Constant: if(n->astnode.constant.number) free(n->astnode.constant.number); break; case Identifier: case Typedec: case Assignment: break; case IoExplist: /* currently we should ignore this */ break; case Expression: free_ast_node(n->astnode.expression.rhs); break; case Binaryop: case Power: free_ast_node(n->astnode.expression.lhs); free_ast_node(n->astnode.expression.rhs); break; default: fprintf(stderr,"free_ast_node() warning: unsupported node %s.\n", print_nodetype(n)); break; /*ansi*/ } f2jfree(n, sizeof(AST)); } f2j-0.8.1/src/f2jmem.h0000600000077700002310000000061211031241064014362 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2jmem.h,v $ * $Revision: 1.6 $ * $Date: 2004/02/04 06:25:43 $ * $Author: keithseymour $ */ #ifndef F2JMEM_H #define F2JMEM_H #include"f2j.h" void alloc_error(size_t), f2jfree(void *, size_t), free_var_info(struct var_info *), * f2jalloc(size_t), * f2jcalloc(size_t, size_t), * f2jrealloc(void *, size_t), free_ast_node(AST *); #endif f2j-0.8.1/src/f2jparse.y0000600000077700002310000047273511031241064014762 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2jparse.y,v $ * $Revision: 1.144 $ * $Date: 2007/12/12 21:47:41 $ * $Author: keithseymour $ */ %{ /***************************************************************************** * f2jparse * * * * This is a yacc parser for a subset of Fortran 77. It builds an AST * * which is used by codegen() to generate Java code. * * * *****************************************************************************/ #include #include #include #include #include"f2j.h" #include"f2j_externs.h" #include"f2jmem.h" /***************************************************************************** * Define YYDEBUG as 1 to get debugging output from yacc. * *****************************************************************************/ #define YYDEBUG 0 /***************************************************************************** * Global variables. * *****************************************************************************/ int debug = FALSE, /* set to TRUE for debugging output */ emittem = 1, /* set to 1 to emit Java, 0 to just parse */ len = 1, /* keeps track of the size of a data type */ temptok, /* temporary token for an inline expr */ save_all, /* is there a SAVE stmt without a var list */ cur_do_label; /* current 'do..end do' loop label */ AST * unit_args = NULL, /* pointer to args for this program unit */ * equivList = NULL; /* list to keep track of equivalences */ Dlist assign_labels, /* labels used in ASSIGN TO statements */ subroutine_names, /* holds the names of subroutines */ do_labels; /* generated labels for 'do..end do' loops */ enum returntype typedec_context = Object; /* what kind of type dec we are parsing */ /***************************************************************************** * Function prototypes: * *****************************************************************************/ METHODTAB * methodscan (METHODTAB *, char *); int yylex(void), intrinsic_or_implicit(char *), in_dlist_stmt_label(Dlist, AST *), in_dlist(Dlist, char *); double eval_const_expr(AST *); char * lowercase(char * ), * first_char_is_minus(char *), * unary_negate_string(char *), * tok2str(int ); void yyerror(char *), start_vcg(AST *), emit(AST *), jas_emit(AST *), init_tables(void), addEquiv(AST *), assign(AST *), typecheck(AST *), optScalar(AST *), type_insert (SYMTABLE * , AST * , enum returntype , char *), type_hash(AST *), merge_common_blocks(AST *), arg_table_load(AST *), exp_to_double (char *, char *), assign_function_return_type(AST *, AST *), insert_name(SYMTABLE *, AST *, enum returntype), store_array_var(AST *), initialize_implicit_table(ITAB_ENTRY *), printbits(char *, void *, int), print_sym_table_names(SYMTABLE *); AST * dl_astnode_examine(Dlist l), * addnode(void), * switchem(AST *), * gen_incr_expr(AST *, AST *), * gen_iter_expr(AST *, AST *, AST *), * initialize_name(char *), * process_typestmt(enum returntype, AST *), * process_array_declaration(AST *, AST *), * process_subroutine_call(AST *, AST *); SYMTABLE * new_symtable (int ); extern METHODTAB intrinsic_toks[]; ITAB_ENTRY implicit_table[26]; %} %union { struct ast_node *ptnode; int tok; enum returntype type; char lexeme[YYTEXTLEN]; } /* generic tokens */ %token PLUS MINUS OP CP STAR POW DIV CAT CM EQ COLON NL %token NOT AND OR %token RELOP EQV NEQV %token NAME DOUBLE INTEGER E_EXPONENTIAL D_EXPONENTIAL %token CONST_EXP TrUE FaLSE ICON RCON LCON CCON %token FLOAT CHARACTER LOGICAL COMPLEX NONE /* a zillion keywords */ %token IF THEN ELSE ELSEIF ENDIF DO GOTO ASSIGN TO CONTINUE STOP %token RDWR END ENDDO STRING CHAR PAUSE %token OPEN CLOSE BACKSPACE REWIND ENDFILE FORMAT %token PROGRAM FUNCTION SUBROUTINE ENTRY CALL RETURN %token ARITH_TYPE CHAR_TYPE %token DIMENSION INCLUDE %token COMMON EQUIVALENCE EXTERNAL PARAMETER INTRINSIC IMPLICIT %token SAVE DATA COMMENT READ WRITE PRINT FMT EDIT_DESC REPEAT %token OPEN_IOSTAT OPEN_ERR OPEN_FILE OPEN_STATUS OPEN_ACCESS %token OPEN_FORM OPEN_UNIT OPEN_RECL OPEN_BLANK /* these are here to silence conflicts related to parsing comments */ %nonassoc RELOP %nonassoc LOWER_THAN_COMMENT %nonassoc COMMENT /* All of my additions or changes to Levine's code. These * non-terminals are in alphabetic order because I have had to * change the grammar quite a bit. It is tiring trying to root * out the location of a non-terminal, much easier to find when * in alphabetic order. */ %type Arraydeclaration Arrayname Arraynamelist Assignment %type Arrayindexlist Arithmeticif ArraydecList AssignedGoto %type Blockif Boolean Close Comment %type Call Constant Continue EndDo %type Data DataList DataConstantExpr DataConstant DataItem %type /* DataElement */ Do_incr Doloop %type DataLhs DataConstantList Dimension LoopBounds %type Do_vals Double Float %type EquivalenceStmt EquivalenceList EquivalenceItem %type Else Elseif Elseifs EndIf End Exp Explist Exponential External %type Function Functionargs F2java %type Fprogram Ffunction Fsubroutine %type Goto Common CommonList CommonSpec ComputedGoto %type IfBlock Implicit Integer Intlist Intrinsic %type ImplicitSpecItem ImplicitLetterList ImplicitLetter %type Label Lhs Logicalif %type Name UndeclaredName Namelist UndeclaredNamelist %type LhsList Open %type Parameter Pdec Pdecs Program PrintIoList %type Read IoExp IoExplist Return Rewind %type Save Specstmt Specstmts SpecStmtList Statements %type Statement StmtLabelAssign Subroutinecall %type Sourcecodes Sourcecode Star %type String Subroutine Stop SubstringOp Pause %type Typestmt ArithTypevar ArithTypevarlist %type CharTypevar CharTypevarlist %type ArithTypes ArithSimpleType CharTypes CharSimpleType %type AnySimpleType AnyTypes %type Write WriteFileDesc FormatSpec EndSpec %type Format FormatExplist FormatExp FormatSeparator %type RepeatableItem UnRepeatableItem RepeatSpec %type log_disjunct log_term log_factor log_primary %type arith_expr term factor char_expr primary %type Ios CharExp OlistItem Olist UnitSpec %% F2java: Sourcecodes { AST *temp, *prev, *commentList = NULL; if(debug) printf("F2java -> Sourcecodes\n"); $$ = switchem($1); #if VCG if(emittem) start_vcg($$); #endif prev = NULL; for(temp=$$;temp!=NULL;temp=temp->nextstmt) { if(emittem) { if(temp->nodetype == Comment) { if((prev == NULL) || ((prev != NULL) && (prev->nodetype != Comment))) commentList = temp; } else { /* commentList may be NULL here so we must check * for that in codegen. */ temp->astnode.source.prologComments = commentList; typecheck(temp); if(omitWrappers) optScalar(temp); emit(temp); commentList = NULL; } } prev = temp; } } ; Sourcecodes: Sourcecode { AST *temp; if(debug) printf("Sourcecodes -> Sourcecode\n"); $$=$1; /* insert the name of the program unit into the * global function table. this will allow optScalar() * to easily get a pointer to a function. */ if(omitWrappers && ($1->nodetype != Comment)) { temp = $1->astnode.source.progtype->astnode.source.name; type_insert(global_func_table, $1, 0, temp->astnode.ident.name); } } | Sourcecodes Sourcecode { AST *temp; if(debug) printf("Sourcecodes -> Sourcecodes Sourcecode\n"); $2->prevstmt = $1; $$=$2; /* insert the name of the program unit into the * global function table. this will allow optScalar() * to easily get a pointer to a function. */ if(omitWrappers && ($2->nodetype != Comment)) { temp = $2->astnode.source.progtype->astnode.source.name; type_insert(global_func_table, $2, 0, temp->astnode.ident.name); } } ; Sourcecode : Fprogram { if(debug) printf("Sourcecode -> Fprogram\n"); $$=$1; } | Fsubroutine { if(debug) printf("Sourcecode -> Fsubroutine\n"); $$=$1; } | Ffunction { if(debug) printf("Sourcecode -> Ffunction\n"); $$=$1; } | Comment { if(debug) printf("Sourcecode -> Comment\n"); $$=$1; } ; Fprogram: Program Specstmts Statements End { if(debug) printf("Fprogram -> Program Specstmts Statements End\n"); add_implicit_to_tree($2); $$ = addnode(); /* store the tables built during parsing into the * AST node for access during code generation. */ $$->astnode.source.type_table = type_table; $$->astnode.source.external_table = external_table; $$->astnode.source.intrinsic_table = intrinsic_table; $$->astnode.source.args_table = args_table; $$->astnode.source.array_table = array_table; $$->astnode.source.format_table = format_table; $$->astnode.source.data_table = data_table; $$->astnode.source.save_table = save_table; $$->astnode.source.common_table = common_table; $$->astnode.source.parameter_table = parameter_table; $$->astnode.source.constants_table = constants_table; $$->astnode.source.equivalences = equivList; $$->astnode.source.stmt_assign_list = assign_labels; $$->astnode.source.javadocComments = NULL; $$->astnode.source.save_all = save_all; /* initialize some values in this node */ $$->astnode.source.needs_input = FALSE; $$->astnode.source.needs_output = FALSE; $$->astnode.source.needs_reflection = FALSE; $$->astnode.source.needs_blas = FALSE; if(omitWrappers) $$->astnode.source.scalarOptStatus = NOT_VISITED; $1->parent = $$; /* 9-4-97 - Keith */ $2->parent = $$; /* 9-4-97 - Keith */ $3->parent = $$; /* 9-4-97 - Keith */ $4->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Progunit; $$->astnode.source.progtype = $1; $$->astnode.source.typedecs = $2; $4->prevstmt = $3; $$->astnode.source.statements = switchem($4); /* a PROGRAM has no args, so set the symbol table to NULL */ args_table = NULL; $1->astnode.source.descriptor = MAIN_DESCRIPTOR; } ; Fsubroutine: Subroutine Specstmts Statements End { HASHNODE *ht; AST *temp; if(debug) printf("Fsubroutine -> Subroutine Specstmts Statements End\n"); add_implicit_to_tree($2); $$ = addnode(); $1->parent = $$; $2->parent = $$; $3->parent = $$; $4->parent = $$; $$->nodetype = Progunit; $$->astnode.source.progtype = $1; /* store the tables built during parsing into the * AST node for access during code generation. */ $$->astnode.source.type_table = type_table; $$->astnode.source.external_table = external_table; $$->astnode.source.intrinsic_table = intrinsic_table; $$->astnode.source.args_table = args_table; $$->astnode.source.array_table = array_table; $$->astnode.source.format_table = format_table; $$->astnode.source.data_table = data_table; $$->astnode.source.save_table = save_table; $$->astnode.source.common_table = common_table; $$->astnode.source.parameter_table = parameter_table; $$->astnode.source.constants_table = constants_table; $$->astnode.source.equivalences = equivList; $$->astnode.source.stmt_assign_list = assign_labels; $$->astnode.source.javadocComments = NULL; $$->astnode.source.save_all = save_all; /* initialize some values in this node */ $$->astnode.source.needs_input = FALSE; $$->astnode.source.needs_output = FALSE; $$->astnode.source.needs_reflection = FALSE; $$->astnode.source.needs_blas = FALSE; if(omitWrappers) $$->astnode.source.scalarOptStatus = NOT_VISITED; $$->astnode.source.typedecs = $2; $4->prevstmt = $3; $$->astnode.source.statements = switchem($4); /* foreach arg to this program unit, store the array * size, if applicable, from the hash table into the * node itself. */ for(temp=$1->astnode.source.args;temp!=NULL;temp=temp->nextstmt) { if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL) { temp->vartype=ht->variable->vartype; temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist; } if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){ ht->variable->vartype=temp->vartype; } } type_insert(function_table, $1, 0, $1->astnode.source.name->astnode.ident.name); } ; Ffunction: Function Specstmts Statements End { HASHNODE *ht; AST *temp; if(debug) printf("Ffunction -> Function Specstmts Statements End\n"); assign_function_return_type($1, $2); add_implicit_to_tree($2); $$ = addnode(); /* store the tables built during parsing into the * AST node for access during code generation. */ $$->astnode.source.type_table = type_table; $$->astnode.source.external_table = external_table; $$->astnode.source.intrinsic_table = intrinsic_table; $$->astnode.source.args_table = args_table; $$->astnode.source.array_table = array_table; $$->astnode.source.format_table = format_table; $$->astnode.source.data_table = data_table; $$->astnode.source.save_table = save_table; $$->astnode.source.common_table = common_table; $$->astnode.source.parameter_table = parameter_table; $$->astnode.source.constants_table = constants_table; $$->astnode.source.equivalences = equivList; $$->astnode.source.stmt_assign_list = assign_labels; $$->astnode.source.javadocComments = NULL; $$->astnode.source.save_all = save_all; /* initialize some values in this node */ $$->astnode.source.needs_input = FALSE; $$->astnode.source.needs_output = FALSE; $$->astnode.source.needs_reflection = FALSE; $$->astnode.source.needs_blas = FALSE; if(omitWrappers) $$->astnode.source.scalarOptStatus = NOT_VISITED; $1->parent = $$; /* 9-4-97 - Keith */ $2->parent = $$; /* 9-4-97 - Keith */ $3->parent = $$; /* 9-4-97 - Keith */ $4->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Progunit; $$->astnode.source.progtype = $1; $$->astnode.source.typedecs = $2; $4->prevstmt = $3; $$->astnode.source.statements = switchem($4); /* foreach arg to this program unit, store the array * size, if applicable, from the hash table into the * node itself. */ for(temp=$1->astnode.source.args;temp!=NULL;temp=temp->nextstmt) { if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL) { temp->vartype=ht->variable->vartype; temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist; } if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){ ht->variable->vartype=temp->vartype; } } type_insert(function_table, $1, 0, $1->astnode.source.name->astnode.ident.name); } ; Program: PROGRAM UndeclaredName NL { if(debug) printf("Program -> PROGRAM UndeclaredName\n"); unit_args = NULL; $$ = addnode(); $2->parent = $$; /* 9-4-97 - Keith */ lowercase($2->astnode.ident.name); $$->astnode.source.name = $2; $$->nodetype = Program; $$->token = PROGRAM; $$->astnode.source.args = NULL; init_tables(); fprintf(stderr," MAIN %s:\n",$2->astnode.ident.name); } ; Subroutine: SUBROUTINE UndeclaredName Functionargs NL { if(debug) printf("Subroutine -> SUBROUTINE UndeclaredName Functionargs NL\n"); unit_args = $3; $$ = addnode(); $2->parent = $$; /* 9-4-97 - Keith */ if($3 != NULL) $3->parent = $$; /* 9-4-97 - Keith */ $$->astnode.source.name = $2; $$->nodetype = Subroutine; $$->token = SUBROUTINE; $$->astnode.source.args = switchem($3); fprintf(stderr,"\t%s:\n",$2->astnode.ident.name); } | SUBROUTINE UndeclaredName NL { if(debug) printf("Subroutine -> SUBROUTINE UndeclaredName NL\n"); unit_args = NULL; init_tables(); $$ = addnode(); $2->parent = $$; /* 9-4-97 - Keith */ $$->astnode.source.name = $2; $$->nodetype = Subroutine; $$->token = SUBROUTINE; $$->astnode.source.args = NULL; fprintf(stderr,"\t%s:\n",$2->astnode.ident.name); } ; Function: AnySimpleType FUNCTION UndeclaredName Functionargs NL { if(debug) printf("Function -> AnySimpleType FUNCTION UndeclaredName Functionargs NL\n"); unit_args = $4; $$ = addnode(); $3->parent = $$; /* 9-4-97 - Keith */ if($4 != NULL) $4->parent = $$; /* 9-4-97 - Keith */ $$->astnode.source.name = $3; $$->nodetype = Function; $$->token = FUNCTION; $$->astnode.source.returns = $1; $$->vartype = $1; $3->vartype = $1; $$->astnode.source.args = switchem($4); /* since the function name is the implicit return value * and it can be treated as a variable, we insert it into * the hash table for lookup later. */ $3->astnode.ident.localvnum = -1; insert_name(type_table, $3, $1); fprintf(stderr,"\t%s:\n",$3->astnode.ident.name); } | FUNCTION UndeclaredName Functionargs NL { enum returntype ret; unit_args = $3; $$ = addnode(); $2->parent = $$; if($3 != NULL) $3->parent = $$; $$->astnode.source.name = $2; $$->nodetype = Function; $$->token = FUNCTION; ret = implicit_table[tolower($2->astnode.ident.name[0]) - 'a'].type; $$->astnode.source.returns = ret; $$->vartype = ret; $2->vartype = ret; $$->astnode.source.args = switchem($3); $2->astnode.ident.localvnum = -1; insert_name(type_table, $2, ret); fprintf(stderr,"\t%s:\n",$2->astnode.ident.name); } ; Specstmts: SpecStmtList %prec LOWER_THAN_COMMENT { AST *tmparg; if(debug){ printf("Specstmts -> SpecStmtList\n"); } $1 = switchem($1); type_hash($1); $$=$1; for(tmparg = unit_args; tmparg; tmparg=tmparg->nextstmt) { HASHNODE *ht; ht = type_lookup(type_table, tmparg->astnode.ident.name); if(ht) { if(!ht->variable->astnode.ident.explicit) ht->variable->vartype = implicit_table[tolower(tmparg->astnode.ident.name[0]) - 'a'].type; } else fprintf(stderr, "warning: didn't find %s in symbol table\n", tmparg->astnode.ident.name); } } ; SpecStmtList: Specstmt { $$=$1; } | SpecStmtList Specstmt { $2->prevstmt = $1; $$ = $2; } ; Specstmt: Dimension { $$ = $1; } | EquivalenceStmt { $$ = $1; } | Common { $$ = $1; } | Save { $$=$1; } | Intrinsic { $$=$1; } | Typestmt { $$=$1; } | External { $$=$1; } | Parameter { $$=$1; } | Implicit { $$=$1; } | Data NL { $$=$1; } | Comment { $$ = $1; } ; Dimension: DIMENSION ArraydecList NL { $$ = addnode(); $2->parent = $$; $2 = switchem($2); $$->nodetype = Dimension; $$->astnode.typeunit.declist = $2; } ; ArraydecList: ArraydecList CM Arraydeclaration { $3->prevstmt = $1; $$ = $3; $$->nodetype = Dimension; } | Arraydeclaration { $$ = $1; $$->nodetype = Dimension; } ; /* the EQUIVALENCE productions are taken from Robert Moniot's * ftnchek grammar. */ EquivalenceStmt: EQUIVALENCE EquivalenceList NL { $$ = addnode(); $$->nodetype = Equivalence; $$->prevstmt = NULL; $$->nextstmt = NULL; $$->astnode.equiv.nlist = switchem($2); } ; EquivalenceList: OP EquivalenceItem CP { AST *tmp; $$ = addnode(); $$->nodetype = Equivalence; $$->prevstmt = NULL; $$->nextstmt = NULL; $$->astnode.equiv.clist = switchem($2); for(tmp=$2;tmp!=NULL;tmp=tmp->prevstmt) tmp->parent = $$; addEquiv($$->astnode.equiv.clist); } | EquivalenceList CM OP EquivalenceItem CP { AST *tmp; $$ = addnode(); $$->nodetype = Equivalence; $$->astnode.equiv.clist = switchem($4); $$->prevstmt = $1; $$->nextstmt = NULL; for(tmp=$4;tmp!=NULL;tmp=tmp->prevstmt) tmp->parent = $$; addEquiv($$->astnode.equiv.clist); } ; EquivalenceItem: Lhs { $$ = $1; } | EquivalenceItem CM Lhs { $3->prevstmt = $1; $$ = $3; } ; Common: COMMON CommonList NL { $$ = addnode(); $$->nodetype = CommonList; $$->astnode.common.name = NULL; $$->astnode.common.nlist = switchem($2); merge_common_blocks($$->astnode.common.nlist); } ; CommonList: CommonSpec { $$ = $1; } | CommonList CommonSpec { $2->prevstmt = $1; $$ = $2; } ; CommonSpec: DIV UndeclaredName DIV ArithTypevarlist { AST *temp; int pos; if(debug){ printf("CommonSpec -> DIV UndeclaredName DIV Namelist\n"); } $$ = addnode(); $$->nodetype = Common; $$->astnode.common.name = strdup($2->astnode.ident.name); $$->astnode.common.nlist = switchem($4); pos = 0; /* foreach variable in the COMMON block... */ for(temp=$$->astnode.common.nlist;temp!=NULL;temp=temp->nextstmt) { temp->astnode.ident.commonBlockName = strdup($2->astnode.ident.name); if(omitWrappers) temp->astnode.ident.position = pos++; /* insert this name into the common table */ if(debug) printf("@insert %s (block = %s) into common table\n", temp->astnode.ident.name, $2->astnode.ident.name); type_insert(common_table, temp, Float, temp->astnode.ident.name); } type_insert(global_common_table, $$, Float, $$->astnode.common.name); free_ast_node($2); } | CAT ArithTypevarlist /* CAT is // */ { AST *temp; /* This is an unnamed common block */ if(debug){ printf("CommonSpec -> CAT Namelist\n"); } $$ = addnode(); $$->nodetype = Common; $$->astnode.common.name = strdup("Blank"); $$->astnode.common.nlist = switchem($2); /* foreach variable in the COMMON block... */ for(temp=$2;temp!=NULL;temp=temp->prevstmt) { temp->astnode.ident.commonBlockName = "Blank"; /* insert this name into the common table */ if(debug) printf("@@insert %s (block = unnamed) into common table\n", temp->astnode.ident.name); type_insert(common_table, temp, Float, temp->astnode.ident.name); } type_insert(global_common_table, $$, Float, $$->astnode.common.name); } ; /* SAVE is ignored by the code generator. * ..not anymore 12/10/01 kgs */ Save: SAVE NL { /* * I think in this case every variable is supposed to * be saved, but we already emit every variable as * static. do nothing here. --Keith */ $$ = addnode(); $$->nodetype = Save; save_all = TRUE; } | SAVE DIV Namelist DIV NL { AST *temp; if(debug){ printf("Save -> SAVE DIV Namelist DIV NL\n"); } $$ = addnode(); $3->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Save; for(temp=$3;temp!=NULL;temp=temp->prevstmt) { if(debug) printf("@@insert %s into save table\n", temp->astnode.ident.name); type_insert(save_table, temp, Float, temp->astnode.ident.name); } } | SAVE Namelist NL { AST *temp; if(debug){ printf("Save -> SAVE Namelist NL\n"); } $$ = addnode(); $2->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Save; for(temp=$2;temp!=NULL;temp=temp->prevstmt) { if(debug) printf("@@insert %s into save table\n", temp->astnode.ident.name); type_insert(save_table, temp, Float, temp->astnode.ident.name); } } ; Implicit: IMPLICIT ImplicitSpecList NL { $$=addnode(); $$->nodetype = Specification; $$->token = IMPLICIT; } | IMPLICIT NONE NL { $$=addnode(); $$->nodetype = Specification; $$->token = IMPLICIT; fprintf(stderr,"Warning: IMPLICIT NONE ignored.\n"); } ; ImplicitSpecList: ImplicitSpecItem { /* I don't think anything needs to be done here */ } | ImplicitSpecList CM ImplicitSpecItem { /* or here either. */ } ; ImplicitSpecItem: AnyTypes OP ImplicitLetterList CP { AST *temp; for(temp=$3;temp!=NULL;temp=temp->prevstmt) { char *start_range, *end_range; char start_char, end_char; int i; start_range = temp->astnode.expression.lhs->astnode.ident.name; end_range = temp->astnode.expression.rhs->astnode.ident.name; start_char = tolower(start_range[0]); end_char = tolower(end_range[0]); if((strlen(start_range) > 1) || (strlen(end_range) > 1)) { yyerror("IMPLICIT spec must contain single character."); exit(EXIT_FAILURE); } if(end_char < start_char) { yyerror("IMPLICIT range in backwards order."); exit(EXIT_FAILURE); } for(i=start_char - 'a'; i <= end_char - 'a'; i++) { if(implicit_table[i].declared) { yyerror("Duplicate letter specified in IMPLICIT statement."); exit(EXIT_FAILURE); } implicit_table[i].type = $1; implicit_table[i].declared = TRUE; implicit_table[i].len = len; /* global set in Types production */ } } } ; ImplicitLetterList: ImplicitLetter { $$ = $1; } | ImplicitLetterList CM ImplicitLetter { $3->prevstmt = $1; $$ = $3; } ; ImplicitLetter: UndeclaredName { $$ = addnode(); $$->nodetype = Expression; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $1; } | UndeclaredName MINUS UndeclaredName { $$ = addnode(); $$->nodetype = Expression; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; } ; Data: DATA DataList { /* $$ = $2; */ $$ = addnode(); $$->nodetype = DataList; $$->astnode.label.stmt = $2; } ; DataList: DataItem { $$ = $1; } | DataList CM DataItem { $3->prevstmt = $1; $$ = $3; } ; DataItem: LhsList DIV DataConstantList DIV { AST *temp; $$ = addnode(); $$->astnode.data.nlist = switchem($1); $$->astnode.data.clist = switchem($3); $$->nodetype = DataStmt; $$->prevstmt = NULL; $$->nextstmt = NULL; for(temp=$1;temp!=NULL;temp=temp->prevstmt) { if(debug) printf("@@insert %s into data table\n", temp->astnode.ident.name); temp->parent = $$; if(temp->nodetype == DataImpliedLoop) type_insert(data_table, temp, Float, temp->astnode.forloop.Label->astnode.ident.name); else type_insert(data_table, temp, Float, temp->astnode.ident.name); } } ; DataConstantList: DataConstantExpr { $$ = $1; } | DataConstantList CM DataConstantExpr { $3->prevstmt = $1; $$ = $3; } ; DataConstantExpr: DataConstant { $$ = $1; } | DataConstant STAR DataConstant { $$ = $1; $$=addnode(); $$->nodetype = Binaryop; $$->token = STAR; $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->astnode.expression.optype = '*'; } ; DataConstant: Constant { $$ = $1; } | UndeclaredName { HASHNODE *hash_temp; if((parameter_table != NULL) && ((hash_temp = type_lookup(parameter_table, yylval.lexeme)) != NULL)) { $$ = addnode(); $$->nodetype = Constant; $$->vartype = hash_temp->variable->vartype; $$->token = hash_temp->variable->token; $$->astnode.constant.number = strdup(hash_temp->variable->astnode.constant.number); } else{ printf("Error: '%s' is not a constant\n",yylval.lexeme); exit(EXIT_FAILURE); } } | MINUS Constant { char *neg_string; neg_string = unary_negate_string($2->astnode.constant.number); if(!neg_string) { fprintf(stderr, "Error generating negated string (DataConstant)\n"); exit(EXIT_FAILURE); } free($2->astnode.constant.number); $2->astnode.constant.number = neg_string; $$ = $2; } ; LhsList: DataLhs { $$ = $1; } | LhsList CM DataLhs { $3->prevstmt = $1; $$ = $3; } ; DataLhs: Lhs { $$ = $1; } | OP Lhs CM UndeclaredName EQ LoopBounds CP { $6->astnode.forloop.counter = $4; $6->astnode.forloop.Label = $2; $$ = $6; $2->parent = $$; $4->parent = $$; } ; LoopBounds: Integer CM Integer { $$ = addnode(); $1->parent = $$; $3->parent = $$; $$->nodetype = DataImpliedLoop; $$->astnode.forloop.start = $1; $$->astnode.forloop.stop = $3; $$->astnode.forloop.incr = NULL; } | Integer CM Integer CM Integer { $$ = addnode(); $1->parent = $$; $3->parent = $$; $5->parent = $$; $$->nodetype = DataImpliedLoop; $$->astnode.forloop.start = $1; $$->astnode.forloop.stop = $3; $$->astnode.forloop.incr = $5; } ; /* Here is where the fun begins. */ /* No newline token here. Newlines have to be dealt with at * a lower level. */ Statements: Statement { $$ = $1; } | Statements Statement { $2->prevstmt = $1; $$ = $2; } ; Statement: Assignment NL /* NL has to be here because of parameter dec. */ { $$ = $1; $$->nodetype = Assignment; } | Call { $$ = $1; $$->nodetype = Call; } | StmtLabelAssign { $$ = $1; $$->nodetype = StmtLabelAssign; } | Logicalif { $$ = $1; $$->nodetype = Logicalif; } | Arithmeticif { $$ = $1; $$->nodetype = Arithmeticif; } | Blockif { $$ = $1; $$->nodetype = Blockif; } | Doloop { $$ = $1; $$->nodetype = Forloop; } | Return { $$ = $1; $$->nodetype = Return; } | AssignedGoto { $$ = $1; $$->nodetype = AssignedGoto; } | ComputedGoto { $$ = $1; $$->nodetype = ComputedGoto; } | Goto { $$ = $1; $$->nodetype = Goto; } | Label { $$ = $1; $$->nodetype = Label; } | EndDo { $$ = $1; $$->nodetype = Label; } | Continue { $$ = $1; $$->nodetype = Label; } | Write { $$ = $1; $$->nodetype = Write; } | Read { $$ = $1; $$->nodetype = Read; } | Stop { $$ = $1; $$->nodetype = Stop; } | Pause { $$ = $1; $$->nodetype = Pause; } | Open { $$ = $1; $$->nodetype = Unimplemented; } | Close { $$ = $1; $$->nodetype = Unimplemented; } | Comment { $$ = $1; $$->nodetype = Comment; } | Rewind { $$ = $1; $$->nodetype = Unimplemented; } ; Comment: COMMENT NL { $$ = addnode(); $$->token = COMMENT; $$->nodetype = Comment; $$->astnode.ident.len = 0; strcpy($$->astnode.ident.name, yylval.lexeme); } ; Open: OPEN OP Olist CP NL { fprintf(stderr,"Warning: OPEN not implemented.. skipping.\n"); $$ = addnode(); $$->nodetype = Unimplemented; } ; Olist: Olist CM OlistItem /* UNIMPLEMENTED */ | OlistItem /* UNIMPLEMENTED */ ; OlistItem: OPEN_UNIT EQ UnitSpec { /* UNIMPLEMENTED */ $$ = $3; } | UnitSpec { /* UNIMPLEMENTED */ $$ = $1; } | OPEN_IOSTAT EQ Ios { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_ERR EQ Integer { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_FILE EQ CharExp { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_STATUS EQ CharExp { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_ACCESS EQ CharExp { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_FORM EQ CharExp { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_RECL EQ Exp { /* UNIMPLEMENTED */ $$ = $3; } | OPEN_BLANK EQ CharExp { /* UNIMPLEMENTED */ $$ = $3; } ; UnitSpec: Exp { /* UNIMPLEMENTED */ $$ = $1; } | STAR { /* UNIMPLEMENTED */ $$ = addnode(); } ; CharExp: UndeclaredName /* UNIMPLEMENTED */ | String /* UNIMPLEMENTED */ ; Ios: UndeclaredName /* UNIMPLEMENTED */ | UndeclaredName OP Arrayindexlist CP /* UNIMPLEMENTED */ ; Close: CLOSE OP UndeclaredName CP NL { fprintf(stderr,"WArning: CLOSE not implemented.\n"); $$ = $3; } ; Rewind: REWIND UndeclaredName NL { fprintf(stderr,"Warning: REWIND not implemented.\n"); $$ = $2; } ; End: END NL { $$ = addnode(); $$->token = END; $$->nodetype = End; } | Integer END NL { AST *end_temp; end_temp = addnode(); end_temp->token = END; end_temp->nodetype = End; $$ = addnode(); end_temp->parent = $$; $$->nodetype = Label; $$->astnode.label.number = atoi($1->astnode.constant.number); $$->astnode.label.stmt = end_temp; free_ast_node($1); } ; /* * We have to load up a symbol table here with the names of all the * variables that are passed in as arguments to our function or * subroutine. Also need to pass `namelist' off to a procedure * to load a local variable table for opcode generation. * * i inlined the call to init_tables() because when parsing the * argument list, if some arg matched a name previously defined as * a PARAMETER in some other program unit, then arg_table_load() * would catch that and assume that the Name represented a paramter * and reinitialize the node as if it were a constant. kgs 7/26/00 */ Functionargs: OP {init_tables();} Namelist CP { if(debug){ printf("Functionargs -> OP Namelist CP\n"); } $3 = switchem($3); arg_table_load($3); $$ = $3; } | OP CP { if(debug){ printf("Functionargs -> OP Namelist CP\n"); } init_tables(); $$ = NULL; } ; Namelist: Name { if(debug){ printf("Namelist -> Name\n"); } $$=$1; } | Namelist CM Name { if(debug){ printf("Namelist -> Namelist CM Name\n"); } $3->prevstmt = $1; $$ = $3; } ; /* * Somewhere in the actions associated with this production, * I need to ship off the type and variable list to get hashed. * Also need to pass `typevarlist' off to a procedure * to load a local variable table for opcode generation. */ Typestmt: ArithTypes ArithTypevarlist NL { $$ = process_typestmt($1, $2); } | CharTypes CharTypevarlist NL { $$ = process_typestmt($1, $2); } ; ArithTypes: ArithSimpleType { $$ = $1; len = 1; } | ArithSimpleType Star Integer { $$ = $1; len = atoi($3->astnode.constant.number); free_ast_node($2); free_ast_node($3); } ; ArithSimpleType: ARITH_TYPE { $$ = yylval.type; typedec_context = $$; } ; CharTypes: CharSimpleType { $$ = $1; len = 1; } | CharSimpleType Star Integer { $$ = $1; len = atoi($3->astnode.constant.number); free_ast_node($2); free_ast_node($3); } | CharSimpleType Star OP Star CP { $$ = $1; len = -1; free_ast_node($2); free_ast_node($4); } ; CharSimpleType: CHAR_TYPE { $$ = yylval.type; typedec_context = $$; } ; AnySimpleType: ArithSimpleType { $$ = $1; } | CharSimpleType { $$ = $1; } ; AnyTypes: ArithTypes { $$ = $1; } | CharTypes { $$ = $1; } ; /* Here I'm going to do the same thing I did with Explist. That is, * each element in the list of typevars will have a parent link to a * single node indicating that the context of the array is a * declaration. --Keith */ ArithTypevarlist: ArithTypevar { $1->parent = addnode(); $1->parent->nodetype = Typedec; $$ = $1; } | ArithTypevarlist CM ArithTypevar { $3->prevstmt = $1; $3->parent = $1->parent; $$ = $3; } ; ArithTypevar: Name { $$ = $1; $$->astnode.ident.len = -1; } | Name Star Integer { $$ = $1; $$->astnode.ident.len = atoi($3->astnode.constant.number); } | Arraydeclaration { $$ = $1; $$->astnode.ident.len = -1; } ; CharTypevarlist: CharTypevar { $1->parent = addnode(); $1->parent->nodetype = Typedec; $$ = $1; } | CharTypevarlist CM CharTypevar { $3->prevstmt = $1; $3->parent = $1->parent; $$ = $3; } ; CharTypevar: Name { $$ = $1; $$->astnode.ident.len = -1; } | Name Star Integer { $$ = $1; $$->astnode.ident.len = atoi($3->astnode.constant.number); } | Name Star OP Star CP { $$ = $1; $$->astnode.ident.len = -1; } | Arraydeclaration { $$ = $1; $$->astnode.ident.len = -1; } ; /* Deleted the Type REAL hack... Need to take care of that in the * lexer. This CHAR and STRING stuff is in the wrong place and * needs to get axed. Putting the TYPE back in ... * ^^^^^^^^^^^ it is commented out for now 9-12-97, Keith * moved to 'Constant' production 9-17-97, Keith */ /* * Might have to explicitly set the arraydeclist pointer to * NULL in this action. `Name' gets pointed to by the node * that carries the array information. */ Name: NAME { HASHNODE *hashtemp; lowercase(yylval.lexeme); if(type_lookup(java_keyword_table,yylval.lexeme)) yylval.lexeme[0] = toupper(yylval.lexeme[0]); /* check if the name we're looking at is defined as a parameter. * if so, instead of inserting an Identifier node here, we're just * going to insert the Constant node that corresponds to * the parameter. normally the only time we'd worry about * such a substitution would be when the ident was the lhs * of some expression, but that should not happen with parameters. * * otherwise, if not a parameter, get a new AST node initialized * with this name. * * added check for null parameter table because this Name could * be reduced before we initialize the tables. that would mean * that this name is the function name, so we dont want this to * be a parameter anyway. kgs 11/7/00 * */ if((parameter_table != NULL) && ((hashtemp = type_lookup(parameter_table,yylval.lexeme)) != NULL)) { /* had a problem here just setting $$ = hashtemp->variable * when there's an arraydec with two of the same PARAMETERS * in the arraynamelist, e.g. A(NMAX,NMAX). so, instead we * just copy the relevant fields from the constant node. */ if(debug) printf("not calling init name, param %s\n", yylval.lexeme); $$ = addnode(); $$->nodetype = hashtemp->variable->nodetype; $$->vartype = hashtemp->variable->vartype; $$->token = hashtemp->variable->token; $$->astnode.constant.number = strdup(hashtemp->variable->astnode.constant.number); } else{ if(debug) printf("Name -> NAME\n"); $$ = initialize_name(yylval.lexeme); } } ; /* * UndeclaredName is similar to Name except that it is used in * contexts where the name is not actually going to be a declared * variable. Thus in Name, we can insert implicitly defined variables * into the hash table, but here in UndeclaredName we do not. */ UndeclaredName: NAME { lowercase(yylval.lexeme); $$=addnode(); $$->token = NAME; $$->nodetype = Identifier; $$->astnode.ident.needs_declaration = FALSE; if(omitWrappers) $$->astnode.ident.passByRef = FALSE; if(type_lookup(java_keyword_table,yylval.lexeme)) yylval.lexeme[0] = toupper(yylval.lexeme[0]); strcpy($$->astnode.ident.name, yylval.lexeme); } ; UndeclaredNamelist: UndeclaredName { $$=$1; } | UndeclaredNamelist CM UndeclaredName { $3->prevstmt = $1; $$ = $3; } ; String: STRING { $$=addnode(); $$->token = STRING; $$->nodetype = Constant; $$->astnode.constant.number = strdup(yylval.lexeme); $$->vartype = String; if(debug) printf("**The string value is %s\n",$$->astnode.constant.number); } | CHAR { $$=addnode(); $$->token = STRING; $$->nodetype = Constant; $$->astnode.constant.number = strdup(yylval.lexeme); $$->vartype = String; if(debug) printf("**The char value is %s\n",$$->astnode.constant.number); } ; Arraydeclaration: Name OP Arraynamelist CP { $$ = process_array_declaration($1, $3); } ; Arraynamelist: Arrayname { AST *temp; temp = addnode(); temp->nodetype = ArrayDec; $1->parent = temp; if($1->nodetype == ArrayIdxRange) { $1->astnode.expression.lhs->parent = temp; $1->astnode.expression.rhs->parent = temp; } $$=$1; } | Arraynamelist CM Arrayname { $3->prevstmt = $1; $3->parent = $1->parent; if($3->nodetype == ArrayIdxRange) { $3->astnode.expression.lhs->parent = $1->parent; $3->astnode.expression.rhs->parent = $1->parent; } $$ = $3; } ; Arrayname: Exp { $$ = $1; } | Star { $$=$1; } | Exp COLON Exp { $$ = addnode(); $$->nodetype = ArrayIdxRange; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; } ; /* We reduce STAR here, make changes in the Binaryops * reductions for that. This handles the fortran array * declaration, e.g., array(*). */ Star: STAR { $$=addnode(); $$->nodetype = Identifier; *$$->astnode.ident.name = '*'; } ; StmtLabelAssign: ASSIGN Integer TO Name NL { $$ = addnode(); $2->parent = $$; $4->parent = $$; $$->nodetype = StmtLabelAssign; $$->astnode.assignment.lhs = $4; $$->astnode.assignment.rhs = $2; /* add this label to the list of assigned labels */ if(in_dlist_stmt_label(assign_labels, $2) == 0) { if(debug) printf("inserting label num %s in assign_labels list\n", $2->astnode.constant.number); dl_insert_b(assign_labels, $2); } } ; /* At some point, I will need to typecheck the `Name' on the left * hand side of this rule in case it has an array form. If it looks like * an array, but it isn't in the array table, that's an error. */ Assignment: Lhs EQ Exp /* NL (Assignment is also used in the parameter * declaration, where it is not followed by a NL. */ { $$ = addnode(); $1->parent = $$; /* 9-4-97 - Keith */ $3->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Assignment; $$->astnode.assignment.lhs = $1; $$->astnode.assignment.rhs = $3; } ; Lhs: Name { $$=$1; $$->nextstmt = NULL; $$->prevstmt = NULL; } | Name OP Arrayindexlist CP { AST *temp; /* Use the following declaration in case we * need to switch index order. * * HASHNODE * hashtemp; */ $$ = addnode(); $1->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Identifier; $$->prevstmt = NULL; $$->nextstmt = NULL; free_ast_node($3->parent); for(temp = $3; temp != NULL; temp = temp->prevstmt) temp->parent = $$; strcpy($$->astnode.ident.name, $1->astnode.ident.name); /* This is in case we want to switch index order later. * * hashtemp = type_lookup(array_table, $1->astnode.ident.name); * if(hashtemp) * $$->astnode.ident.arraylist = $3; * else * $$->astnode.ident.arraylist = switchem($3); */ /* We don't switch index order. */ $$->astnode.ident.arraylist = switchem($3); free_ast_node($1); } | SubstringOp { $$ = $1; } ; Arrayindexlist: Exp { $1->parent = addnode(); $1->parent->nodetype = Identifier; $$ = $1; } | Arrayindexlist CM Exp { $3->prevstmt = $1; $3->parent = $1->parent; $$ = $3; } ; /* New do loop productions. Entails rewriting in codegen.c * to emit java source code. */ Doloop: Do_incr Do_vals { $$ = $2; $$->nodetype = Forloop; $$->astnode.forloop.Label = $1; } ; Do_incr: DO Integer { $$ = $2; } | DO Integer CM { $$ = $2; } | DO { char *loop_label; loop_label = (char *)malloc(32); if(!loop_label) { fprintf(stderr,"Malloc error\n"); exit(EXIT_FAILURE); } sprintf(loop_label,"%d", cur_do_label); cur_do_label++; $$ = addnode(); $$->token = INTEGER; $$->nodetype = Constant; $$->astnode.constant.number = strdup(loop_label); $$->vartype = Integer; dl_insert_b(do_labels, strdup($$->astnode.constant.number)); free(loop_label); } ; Do_vals: Assignment CM Exp NL { AST *counter; $$ = addnode(); $1->parent = $$; /* 9-4-97 - Keith */ $3->parent = $$; /* 9-4-97 - Keith */ counter = $$->astnode.forloop.counter = $1->astnode.assignment.lhs; $$->astnode.forloop.start = $1; $$->astnode.forloop.stop = $3; $$->astnode.forloop.incr = NULL; $$->astnode.forloop.iter_expr = gen_iter_expr($1->astnode.assignment.rhs,$3,NULL); $$->astnode.forloop.incr_expr = gen_incr_expr(counter,NULL); } | Assignment CM Exp CM Exp NL { AST *counter; $$ = addnode(); $1->parent = $$; /* 9-4-97 - Keith */ $3->parent = $$; /* 9-4-97 - Keith */ $5->parent = $$; /* 9-4-97 - Keith */ counter = $$->astnode.forloop.counter = $1->astnode.assignment.lhs; $$->nodetype = Forloop; $$->astnode.forloop.start = $1; $$->astnode.forloop.stop = $3; $$->astnode.forloop.incr = $5; $$->astnode.forloop.iter_expr = gen_iter_expr($1->astnode.assignment.rhs,$3,$5); $$->astnode.forloop.incr_expr = gen_incr_expr(counter,$5); } ; /* * changed the Label production to allow any statement to have * a line number. -- keith */ Label: Integer Statement { $$ = addnode(); $1->parent = $$; $2->parent = $$; $$->nodetype = Label; $$->astnode.label.number = atoi($1->astnode.constant.number); $$->astnode.label.stmt = $2; free_ast_node($1); } | Integer Format NL { /* HASHNODE *newnode; */ char *tmpLabel; tmpLabel = (char *) f2jalloc(10); /* plenty of space for a f77 label num */ /* newnode = (HASHNODE *) f2jalloc(sizeof(HASHNODE)); */ $$ = addnode(); $1->parent = $$; $2->parent = $$; $$->nodetype = Format; $$->astnode.label.number = atoi($1->astnode.constant.number); $$->astnode.label.stmt = $2; $2->astnode.label.number = $$->astnode.label.number; if(debug) printf("@@ inserting format line num %d\n",$$->astnode.label.number); sprintf(tmpLabel,"%d",$2->astnode.label.number); type_insert(format_table,$2,0,tmpLabel); free_ast_node($1); } ; /* The following productions for FORMAT parsing are derived * from Robert K. Moniot's grammar (see ftnchek-2.9.4) */ Format: FORMAT OP FormatExplist CP { $$ = addnode(); $$->nodetype = Format; $$->astnode.label.stmt = switchem($3); } ; FormatExplist: FormatExp { AST *temp; temp = addnode(); temp->nodetype = Format; $1->parent = temp; $$ = $1; } | FormatExplist FormatExp { $1->nextstmt = $2; $2->prevstmt = $1; $2->parent = $1->parent; if(($2->token == REPEAT) && ($1->token == INTEGER)) { $2->astnode.label.number = atoi($1->astnode.constant.number); if(debug) printf("## setting number = %s\n", $1->astnode.constant.number); } if(debug) { if($2->token == REPEAT) printf("## $2 is repeat token, $1 = %s ##\n",tok2str($1->token)); if($1->token == REPEAT) printf("## $1 is repeat token, $2 = %s ##\n",tok2str($2->token)); } $$ = $2; } ; FormatExp: RepeatableItem { $$ = $1; } | UnRepeatableItem { $$ = $1; } | FormatSeparator { $$ = $1; } ; RepeatableItem: EDIT_DESC /* A, F, I, D, G, E, L, X */ { $$ = addnode(); $$->token = EDIT_DESC; strcpy($$->astnode.ident.name, yylval.lexeme); } | UndeclaredName { $$ = $1; } | UndeclaredName '.' Constant { /* ignore the constant part for now */ free_ast_node($3); $$ = $1; } | OP FormatExplist CP { $$ = addnode(); $$->token = REPEAT; $$->astnode.label.stmt = switchem($2); if(debug) printf("## setting number = 1\n"); $$->astnode.label.number = 1; } ; UnRepeatableItem: String { $$ = $1; } | RepeatSpec { $$ = $1; } ; FormatSeparator: CM { $$ = addnode(); $$->token = CM; } | DIV { $$ = addnode(); $$->token = DIV; } | CAT /* CAT is two DIVs "//" */ { $$ = addnode(); $$->token = CAT; } | COLON { $$ = addnode(); $$->token = COLON; } ; RepeatSpec: Integer { $$ = $1; } | PLUS Integer { $$ = $2; } /* this will stay commented out until I know the meaning of a negative repeat specification. | MINUS Integer { $$ = $1; } */ ; Continue: Integer CONTINUE NL { $$ = addnode(); $1->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Label; $$->astnode.label.number = atoi($1->astnode.constant.number); $$->astnode.label.stmt = NULL; free_ast_node($1); } ; EndDo: ENDDO NL { char *loop_label; $$ = addnode(); $$->nodetype = Label; loop_label = (char *)dl_pop(do_labels); $$->astnode.label.number = atoi(loop_label); $$->astnode.label.stmt = NULL; } ; Write: WRITE OP WriteFileDesc CM FormatSpec CP IoExplist NL { AST *temp; $$ = addnode(); $$->astnode.io_stmt.io_type = Write; $$->astnode.io_stmt.fmt_list = NULL; /* unimplemented $$->astnode.io_stmt.file_desc = ; */ if($5->nodetype == Constant) { if($5->astnode.constant.number[0] == '*') { $$->astnode.io_stmt.format_num = -1; free_ast_node($5); } else if($5->token == STRING) { $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.fmt_list = $5; } else { $$->astnode.io_stmt.format_num = atoi($5->astnode.constant.number); free_ast_node($5); } } else { /* is this case ever reached?? i don't think so. --kgs */ $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.fmt_list = $5; } $$->astnode.io_stmt.arg_list = switchem($7); for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; /* currently ignoring the file descriptor.. */ free_ast_node($3); } | PRINT Integer PrintIoList NL { AST *temp; $$ = addnode(); $$->astnode.io_stmt.io_type = Write; $$->astnode.io_stmt.fmt_list = NULL; $$->astnode.io_stmt.format_num = atoi($2->astnode.constant.number); $$->astnode.io_stmt.arg_list = switchem($3); for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; free_ast_node($2); } | PRINT STAR PrintIoList NL { AST *temp; $$ = addnode(); $$->astnode.io_stmt.io_type = Write; $$->astnode.io_stmt.fmt_list = NULL; $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.arg_list = switchem($3); for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; } | PRINT String PrintIoList NL { AST *temp; $$ = addnode(); $$->astnode.io_stmt.io_type = Write; $$->astnode.io_stmt.fmt_list = $2; $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.arg_list = switchem($3); for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; } ; PrintIoList: CM IoExplist { $$ = $2; } | /* empty */ { $$ = NULL; } ; /* Maybe I'll implement this stuff someday. */ WriteFileDesc: Exp { /* do nothing for now */ $$ = $1; } | STAR { /* do nothing for now */ $$ = addnode(); $$->token = INTEGER; $$->nodetype = Constant; $$->astnode.constant.number = strdup("*"); $$->vartype = Integer; } ; FormatSpec: FMT EQ Integer { $$ = $3; } | Integer { $$ = $1; } | FMT EQ STAR { $$ = addnode(); $$->token = INTEGER; $$->nodetype = Constant; $$->astnode.constant.number = strdup("*"); $$->vartype = Integer; } | STAR { $$ = addnode(); $$->token = INTEGER; $$->nodetype = Constant; $$->astnode.constant.number = strdup("*"); $$->vartype = Integer; } | FMT EQ String { $$ = $3; } | String { $$ = $1; } | FMT EQ UndeclaredName { fprintf(stderr,"Warning - ignoring FMT = %s\n", $3->astnode.ident.name); $$ = addnode(); $$->token = INTEGER; $$->nodetype = Constant; $$->astnode.constant.number = strdup("*"); $$->vartype = Integer; } ; Read: READ OP WriteFileDesc CM FormatSpec CP IoExplist NL { AST *temp; $$ = addnode(); $$->astnode.io_stmt.io_type = Read; $$->astnode.io_stmt.fmt_list = NULL; $$->astnode.io_stmt.end_num = -1; if($5->nodetype == Constant) { if($5->astnode.constant.number[0] == '*') { $$->astnode.io_stmt.format_num = -1; free_ast_node($5); } else if($5->token == STRING) { $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.fmt_list = $5; } else { $$->astnode.io_stmt.format_num = atoi($5->astnode.constant.number); free_ast_node($5); } } else { /* is this case ever reached?? i don't think so. --kgs */ $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.fmt_list = $5; } $$->astnode.io_stmt.arg_list = switchem($7); if($$->astnode.io_stmt.arg_list && $$->astnode.io_stmt.arg_list->parent) free_ast_node($$->astnode.io_stmt.arg_list->parent); for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent = $$; /* currently ignoring the file descriptor and format spec. */ free_ast_node($3); } | READ OP WriteFileDesc CM FormatSpec CM EndSpec CP IoExplist NL { AST *temp; $$ = addnode(); $$->astnode.io_stmt.io_type = Read; $$->astnode.io_stmt.fmt_list = NULL; if($5->nodetype == Constant) { if($5->astnode.constant.number[0] == '*') { $$->astnode.io_stmt.format_num = -1; free_ast_node($5); } else if($5->token == STRING) { $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.fmt_list = $5; } else { $$->astnode.io_stmt.format_num = atoi($5->astnode.constant.number); free_ast_node($5); } } else { /* is this case ever reached?? i don't think so. --kgs */ $$->astnode.io_stmt.format_num = -1; $$->astnode.io_stmt.fmt_list = $5; } $$->astnode.io_stmt.end_num = atoi($7->astnode.constant.number); free_ast_node($7); $$->astnode.io_stmt.arg_list = switchem($9); if($$->astnode.io_stmt.arg_list && $$->astnode.io_stmt.arg_list->parent) free_ast_node($$->astnode.io_stmt.arg_list->parent); for(temp=$$->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent = $$; /* currently ignoring the file descriptor.. */ free_ast_node($3); } ; IoExplist: IoExp { $1->parent = addnode(); $1->parent->nodetype = IoExplist; $$ = $1; } | IoExplist CM IoExp { $3->prevstmt = $1; $3->parent = $1->parent; $$ = $3; } | /* empty - should this be allowed for READ? */ { $$ = NULL; } ; IoExp: Exp { $$ = $1; } | OP Explist CM Name EQ Exp CM Exp CP /* implied do loop */ { AST *temp; $$ = addnode(); $$->nodetype = IoImpliedLoop; $$->astnode.forloop.start = $6; $$->astnode.forloop.stop = $8; $$->astnode.forloop.incr = NULL; $$->astnode.forloop.counter = $4; $$->astnode.forloop.Label = switchem($2); $$->astnode.forloop.iter_expr = gen_iter_expr($6,$8,NULL); $$->astnode.forloop.incr_expr = gen_incr_expr($4,NULL); $2->parent = $$; for(temp = $2; temp != NULL; temp = temp->nextstmt) temp->parent = $$; $4->parent = $$; $6->parent = $$; $8->parent = $$; } | OP Explist CM Name EQ Exp CM Exp CM Exp CP /* implied do loop */ { AST *temp; $$ = addnode(); $$->nodetype = IoImpliedLoop; $$->astnode.forloop.start = $6; $$->astnode.forloop.stop = $8; $$->astnode.forloop.incr = $10; $$->astnode.forloop.counter = $4; $$->astnode.forloop.Label = switchem($2); $$->astnode.forloop.iter_expr = gen_iter_expr($6,$8,$10); $$->astnode.forloop.incr_expr = gen_incr_expr($4,$10); $2->parent = $$; for(temp = $2; temp != NULL; temp = temp->nextstmt) temp->parent = $$; $4->parent = $$; $6->parent = $$; $8->parent = $$; $10->parent = $$; } ; EndSpec: END EQ Integer { $$ = $3; } ; /* Got a problem when a Blockif opens with a Blockif. The * first statement of the second Blockif doesn't get into the * tree. Might be able to use do loop for example to fix this. * * --apparently the problem mentioned in the comment above has * been fixed now. */ Blockif: IF OP Exp CP THEN NL IfBlock Elseifs Else EndIf NL { $$ = addnode(); $3->parent = $$; if($7 != NULL) $7->parent = $$; /* 9-4-97 - Keith */ if($8 != NULL) $8->parent = $$; /* 9-4-97 - Keith */ if($9 != NULL) $9->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Blockif; $$->astnode.blockif.conds = $3; $7 = switchem($7); $$->astnode.blockif.stmts = $7; /* If there are any `else if' statements, * switchem. Otherwise, NULL pointer checked * in code generating functions. */ $8 = switchem($8); $$->astnode.blockif.elseifstmts = $8; /* Might be NULL. */ $$->astnode.blockif.elsestmts = $9; /* Might be NULL. */ $$->astnode.blockif.endif_label = $10->astnode.blockif.endif_label; } ; IfBlock: /* Empty. */ {$$=0;} /* if block may be null */ | Statements { $$ = $1; } ; Elseifs: /* Empty. */ {$$=0;} /* No `else if' statements, NULL pointer. */ | Elseif { $$ = $1; } | Elseifs Elseif { $2->prevstmt = $1; $$ = $2; } ; Elseif: ELSEIF OP Exp CP THEN NL Statements { $$=addnode(); $3->parent = $$; $7->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Elseif; $$->astnode.blockif.conds = $3; $$->astnode.blockif.stmts = switchem($7); } ; Else: /* Empty. */ {$$=0;} /* No `else' statements, NULL pointer. */ | ELSE NL Statements { $$=addnode(); $3->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Else; $$->astnode.blockif.stmts = switchem($3); } | ELSE NL { $$ = 0; } ; EndIf: ENDIF { if(debug) printf("EndIf\n"); $$ = addnode(); $$->nodetype = Blockif; if(strlen(yylval.lexeme) > 0) $$->astnode.blockif.endif_label = atoi(yylval.lexeme); else $$->astnode.blockif.endif_label = -1; } ; Logicalif: IF OP Exp CP Statement { $$ = addnode(); $3->parent = $$; $5->parent = $$; /* 9-4-97 - Keith */ $$->astnode.logicalif.conds = $3; $$->astnode.logicalif.stmts = $5; } ; Arithmeticif: IF OP Exp CP Integer CM Integer CM Integer NL { $$ = addnode(); $$->nodetype = Arithmeticif; $3->parent = $$; $5->parent = $$; $7->parent = $$; $9->parent = $$; $$->astnode.arithmeticif.cond = $3; $$->astnode.arithmeticif.neg_label = atoi($5->astnode.constant.number); $$->astnode.arithmeticif.zero_label = atoi($7->astnode.constant.number); $$->astnode.arithmeticif.pos_label = atoi($9->astnode.constant.number); free_ast_node($5); free_ast_node($7); free_ast_node($9); } ; /* * This _may_ have to be extended to deal with * jasmin opcode. Variables of type array need * to have their arguments emitted in reverse order * so that java can increment in row instead of column * order. So we look each name up in the array table, * it is in there we leave the argument list reversed, * otherwise, it is a subroutine or function (method) * call and we reverse the arguments. * * I don't think the above comment makes sense anymore. * --kgs 7/2007 */ Subroutinecall: Name OP Explist CP { $$ = process_subroutine_call($1, $3); } ; SubstringOp: Name OP Exp COLON Exp CP { if(debug) printf("SubString! format = c(e1:e2)\n"); $$ = addnode(); $1->parent = $$; $3->parent = $$; $5->parent = $$; strcpy($$->astnode.ident.name, $1->astnode.ident.name); $$->nodetype = Substring; $$->token = NAME; $$->astnode.ident.startDim[0] = $3; $$->astnode.ident.endDim[0] = $5; free_ast_node($1); } | Name OP COLON Exp CP { if(debug) printf("SubString! format = c(:e2)\n"); $$ = addnode(); $1->parent = $$; $4->parent = $$; strcpy($$->astnode.ident.name, $1->astnode.ident.name); $$->nodetype = Substring; $$->token = NAME; $$->astnode.ident.startDim[0] = NULL; $$->astnode.ident.endDim[0] = $4; free_ast_node($1); } | Name OP Exp COLON CP { if(debug) printf("SubString! format = c(e1:)\n"); $$ = addnode(); $1->parent = $$; $3->parent = $$; strcpy($$->astnode.ident.name, $1->astnode.ident.name); $$->nodetype = Substring; $$->token = NAME; $$->astnode.ident.startDim[0] = $3; $$->astnode.ident.endDim[0] = NULL; free_ast_node($1); } | Name OP COLON CP { if(debug) printf("SubString! format = c(:)\n"); $$ = addnode(); $1->parent = $$; strcpy($$->astnode.ident.name, $1->astnode.ident.name); $$->nodetype = Substring; $$->token = NAME; $$->astnode.ident.startDim[0] = NULL; $$->astnode.ident.endDim[0] = NULL; free_ast_node($1); } ; /* * What I'm going to try to do here is have each element * of the list linked back to a single node through its * parent pointer. This will allow the code generator * to check the array context (whether it is being used * as part of an external call or part of a call to an * intrinsic function or some other use). --Keith */ Explist: Exp { AST *temp; temp = addnode(); temp->nodetype = Call; $1->parent = temp; $$ = $1; } | Explist CM Exp { $3->prevstmt = $1; $3->parent = $1->parent; $$ = $3; } | /* empty */ { $$ = NULL; } ; /* This is not exactly right. There will need to * be a struct to handle this. */ Call: CALL Subroutinecall NL { /* we don't want subroutines in the type_table * make a dlist to stuff the names in and check * them in initialize_name. */ if(in_dlist(subroutine_names, $2->astnode.ident.name)==0){ if(debug){ printf("inserting %s in dlist and del from type\n", $2->astnode.ident.name); } dl_insert_b(subroutine_names, strdup($2->astnode.ident.name)); hash_delete(type_table, $2->astnode.ident.name); } if(debug){ printf("call: %s\n", $2->astnode.ident.name); } $$ = $2; $$->nodetype = Call; } | CALL UndeclaredName NL { $$ = addnode(); $2->parent = $$; $$->nodetype = Identifier; strcpy($$->astnode.ident.name, $2->astnode.ident.name); $$->astnode.ident.arraylist = addnode(); $$->astnode.ident.arraylist->nodetype = EmptyArgList; free_ast_node($2); } ; /* again we borrowed from Moniot's grammar....from the Exp production down to * the primary production is from his ftnchek grammar. --keith 2/17/98. */ Exp: log_disjunct { $$ = $1; } | Exp EQV log_disjunct { $$=addnode(); $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->token = EQV; $$->nodetype = Logicalop; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; } | Exp NEQV log_disjunct { $$=addnode(); $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->token = NEQV; $$->nodetype = Logicalop; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; } ; log_disjunct: log_term { $$ = $1; } | log_disjunct OR log_term { $$=addnode(); $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->token = OR; $$->nodetype = Logicalop; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; } ; log_term: log_factor { $$ = $1; } | log_term AND log_factor { $$=addnode(); $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->token = AND; $$->nodetype = Logicalop; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; } ; log_factor: log_primary { $$ = $1; } | NOT log_primary { $$=addnode(); $2->parent = $$; /* 9-4-97 - Keith */ $$->token = NOT; $$->nodetype = Logicalop; $$->astnode.expression.lhs = 0; $$->astnode.expression.rhs = $2; } ; log_primary: arith_expr { $$ = $1; } | log_primary RELOP {temptok = yylval.tok;} log_primary { $$=addnode(); $1->expr_side = left; $4->expr_side = right; $1->parent = $$; $4->parent = $$; $$->nodetype = Relationalop; $$->token = temptok; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $4; } ; arith_expr: term { $$ = $1; } | MINUS term { if($2->nodetype == Constant) { char *neg_string; neg_string = unary_negate_string($2->astnode.constant.number); if(!neg_string) { fprintf(stderr, "Error generating negated string (arith_expr)\n"); exit(EXIT_FAILURE); } free($2->astnode.constant.number); $2->astnode.constant.number = neg_string; $$ = $2; } else { $$ = addnode(); $2->parent = $$; $$->astnode.expression.rhs = $2; $$->astnode.expression.lhs = 0; $$->astnode.expression.minus = '-'; $$->nodetype = Unaryop; $$->vartype = $2->vartype; } } | PLUS term { if($2->nodetype == Constant) { $$ = $2; } else { $$ = addnode(); $2->parent = $$; $$->astnode.expression.rhs = $2; $$->astnode.expression.lhs = 0; $$->astnode.expression.minus = '+'; $$->nodetype = Unaryop; $$->vartype = $2->vartype; } } | arith_expr PLUS term { $$=addnode(); $1->expr_side = left; $3->expr_side = right; $$->token = PLUS; $1->parent = $$; $3->parent = $$; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->vartype = MIN($1->vartype, $3->vartype); $$->nodetype = Binaryop; $$->astnode.expression.optype = '+'; } | arith_expr MINUS term { $$=addnode(); $$->token = MINUS; $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->vartype = MIN($1->vartype, $3->vartype); $$->nodetype = Binaryop; $$->astnode.expression.optype = '-'; } ; term: factor { $$ = $1; } | term DIV factor { $$=addnode(); $1->expr_side = left; $3->expr_side = right; $$->token = DIV; $1->parent = $$; $3->parent = $$; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->vartype = MIN($1->vartype, $3->vartype); $$->nodetype = Binaryop; $$->astnode.expression.optype = '/'; } | term STAR factor { $$=addnode(); $$->token = STAR; $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->vartype = MIN($1->vartype, $3->vartype); $$->nodetype = Binaryop; $$->astnode.expression.optype = '*'; } ; factor: char_expr { $$ = $1; } | char_expr POW factor { $$=addnode(); $1->parent = $$; $3->parent = $$; $$->nodetype = Power; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->vartype = MIN($1->vartype, $3->vartype); } ; char_expr: primary { $$ = $1; } | char_expr CAT primary { $$=addnode(); $$->token = CAT; $1->expr_side = left; $3->expr_side = right; $1->parent = $$; $3->parent = $$; $$->astnode.expression.lhs = $1; $$->astnode.expression.rhs = $3; $$->vartype = MIN($1->vartype, $3->vartype); $$->nodetype = Binaryop; $$->astnode.expression.optype = '+'; } ; primary: Name {$$=$1;} | Constant { $$ = $1; } /* | Complex {$$=$1;} */ | Subroutinecall {$$=$1;} | SubstringOp {$$=$1;} | OP Exp CP { $$ = addnode(); $2->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Expression; $$->astnode.expression.parens = TRUE; $$->astnode.expression.rhs = $2; $$->astnode.expression.lhs = NULL; $$->vartype = $2->vartype; } ; /* Complex: OP Constant CM Constant CP {$$=addnode();} ; */ /* `TRUE' and `FALSE' have already been typedefed * as BOOLEANs. */ Boolean: TrUE { $$ = addnode(); $$->token = TrUE; $$->nodetype = Constant; $$->astnode.constant.number = strdup("true"); $$->vartype = Logical; } | FaLSE { $$ = addnode(); $$->token = FaLSE; $$->nodetype = Constant; $$->astnode.constant.number = strdup("false"); $$->vartype = Logical; } ; Constant: Integer { $$ = $1; } | Float { $$ = $1; } | Double { $$ = $1; } | Exponential { $$ = $1; } | Boolean { $$ = $1; } | String /* 9-16-97, keith */ { $$ = $1; } ; Integer : INTEGER { if(debug)printf("Integer\n"); $$ = addnode(); $$->token = INTEGER; $$->nodetype = Constant; $$->astnode.constant.number = strdup(yylval.lexeme); $$->vartype = Integer; } ; Double: DOUBLE { $$ = addnode(); $$->token = DOUBLE; $$->nodetype = Constant; $$->astnode.constant.number = strdup(yylval.lexeme); $$->vartype = Double; } ; Float: FLOAT { $$ = addnode(); $$->token = FLOAT; $$->nodetype = Constant; $$->astnode.constant.number = (char *)malloc(strlen(yylval.lexeme) + 2); strcpy($$->astnode.constant.number, yylval.lexeme); strcat($$->astnode.constant.number, "f"); $$->vartype = Float; } ; /* * Call exp_to_double() to change the 'D' to 'e' for emitting * exponentials in Java source. */ Exponential: E_EXPONENTIAL { char tempname[60]; $$ = addnode(); $$->token = E_EXPONENTIAL; $$->nodetype = Constant; exp_to_double(yylval.lexeme, tempname); $$->astnode.constant.number = (char *)malloc(strlen(tempname) + 2); strcpy($$->astnode.constant.number, tempname); strcat($$->astnode.constant.number, "f"); $$->vartype = Float; } | D_EXPONENTIAL { char tempname[60]; $$ = addnode(); $$->token = D_EXPONENTIAL; $$->nodetype = Constant; exp_to_double(yylval.lexeme, tempname); $$->astnode.constant.number = strdup(tempname); $$->vartype = Double; } ; /* All the easy productions that work go here. */ Return: RETURN NL { $$= addnode(); } ; Pause: PAUSE NL { $$ = addnode(); $$->nodetype = Pause; $$->astnode.constant.number = strdup(""); } | PAUSE String NL { $$ = $2; $$->nodetype = Pause; } ; Stop: STOP NL { $$ = addnode(); $$->nodetype = Stop; $$->astnode.constant.number = strdup(""); } | STOP String NL { $$ = $2; $$->nodetype = Stop; } ; Goto: GOTO Integer NL { $$ = addnode(); $2->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Goto; if(debug) printf("goto label: %d\n", atoi(yylval.lexeme)); $$->astnode.go_to.label = atoi(yylval.lexeme); free_ast_node($2); } ; ComputedGoto: GOTO OP Intlist CP Exp NL { $$ = addnode(); $3->parent = $$; /* 9-4-97 - Keith */ $5->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = ComputedGoto; $$->astnode.computed_goto.name = $5; $$->astnode.computed_goto.intlist = switchem($3); if(debug) printf("Computed go to,\n"); } | GOTO OP Intlist CP CM Exp NL { $$ = addnode(); $3->parent = $$; /* 9-4-97 - Keith */ $6->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = ComputedGoto; $$->astnode.computed_goto.name = $6; $$->astnode.computed_goto.intlist = switchem($3); if(debug) printf("Computed go to,\n"); } ; AssignedGoto: GOTO Name OP Intlist CP NL { $$ = addnode(); $2->parent = $$; $4->parent = $$; $$->nodetype = AssignedGoto; $$->astnode.computed_goto.name = $2; $$->astnode.computed_goto.intlist = switchem($4); if(debug) printf("Assigned go to,\n"); } | GOTO Name CM OP Intlist CP NL { $$ = addnode(); $2->parent = $$; $5->parent = $$; $$->nodetype = AssignedGoto; $$->astnode.computed_goto.name = $2; $$->astnode.computed_goto.intlist = switchem($5); if(debug) printf("Assigned go to,\n"); } | GOTO Name NL { $$ = addnode(); $2->parent = $$; $$->nodetype = AssignedGoto; $$->astnode.computed_goto.name = $2; $$->astnode.computed_goto.intlist = NULL; if(debug) printf("Assigned go to (no intlist)\n"); } ; Intlist: Integer { $$ = $1; } | Intlist CM Integer { $3->prevstmt = $1; $$ = $3; } ; Parameter: PARAMETER OP Pdecs CP NL { $$ = addnode(); $3->parent = $$; /* 9-4-97 - Keith */ $$->nodetype = Specification; $$->astnode.typeunit.specification = Parameter; $$->astnode.typeunit.declist = switchem($3); } ; Pdecs: Pdec { $$=$1; } | Pdecs CM Pdec { $3->prevstmt = $1; $$=$3; } ; Pdec: Assignment { void add_decimal_point(char *); double constant_eval; HASHNODE *ht; char *cur_id; AST *temp; if(debug) printf("Parameter...\n"); $$ = $1; $$->nodetype = Assignment; constant_eval = eval_const_expr($$->astnode.assignment.rhs); if(debug) { printf("### constant_eval is %.40g\n", constant_eval); printf("### constant_eval is %.40e\n", constant_eval); } temp = addnode(); temp->nodetype = Constant; ht = type_lookup(type_table, $$->astnode.assignment.lhs->astnode.ident.name); if(ht) temp->vartype = ht->variable->vartype; else temp->vartype = $$->astnode.assignment.rhs->vartype; switch(temp->vartype) { case String: case Character: temp->token = STRING; temp->astnode.constant.number = strdup($$->astnode.assignment.rhs->astnode.constant.number); break; case Complex: fprintf(stderr,"Pdec: Complex not yet supported.\n"); break; case Logical: temp->token = $$->astnode.assignment.rhs->token; temp->astnode.constant.number = strdup(temp->token == TrUE ? "true" : "false"); break; case Float: temp->token = FLOAT; temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); sprintf(temp->astnode.constant.number,"%.40g",constant_eval); add_decimal_point(temp->astnode.constant.number); strcat(temp->astnode.constant.number, "f"); break; case Double: temp->token = DOUBLE; temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); sprintf(temp->astnode.constant.number,"%.40g",constant_eval); add_decimal_point(temp->astnode.constant.number); break; case Integer: temp->token = INTEGER; temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); sprintf(temp->astnode.constant.number,"%d",(int)constant_eval); break; default: fprintf(stderr,"Pdec: bad vartype!\n"); } free_ast_node($$->astnode.assignment.rhs); $$->astnode.assignment.rhs = temp; if(debug) printf("### the constant is '%s'\n", temp->astnode.constant.number); cur_id = strdup($$->astnode.assignment.lhs->astnode.ident.name); if(type_lookup(java_keyword_table,cur_id)) cur_id[0] = toupper(cur_id[0]); if(debug) printf("insert param_table %s\n", $$->astnode.assignment.lhs->astnode.ident.name); hash_delete(type_table, $$->astnode.assignment.lhs->astnode.ident.name); type_insert(parameter_table, temp, 0, cur_id); free_ast_node($$->astnode.assignment.lhs); } ; External: EXTERNAL UndeclaredNamelist NL { $$=addnode(); $2->parent = $$; /* 9-3-97 - Keith */ $$->nodetype = Specification; $$->token = EXTERNAL; $$->astnode.typeunit.declist = switchem($2); $$->astnode.typeunit.specification = External; } ; Intrinsic: INTRINSIC UndeclaredNamelist NL { $$=addnode(); $2->parent = $$; /* 9-3-97 - Keith */ $$->nodetype = Specification; $$->token = INTRINSIC; $$->astnode.typeunit.declist = switchem($2); $$->astnode.typeunit.specification = Intrinsic; } ; %% /***************************************************************************** * * * yyerror * * * * The standard yacc error routine. * * * *****************************************************************************/ void yyerror(char *s) { extern Dlist file_stack; INCLUDED_FILE *pfile; Dlist tmp; if(current_file_info) printf("%s:%d: %s\n", current_file_info->name, lineno, s); else printf("line %d: %s\n", lineno, s); dl_traverse_b(tmp, file_stack) { pfile = (INCLUDED_FILE *)dl_val(tmp); printf("\tincluded from: %s:%d\n", pfile->name, pfile->line_num); } } /***************************************************************************** * * * add_decimal_point * * * * this is just a hack to compensate for the fact that there's no printf * * specifier that does exactly what we want. assume the given string * * represents a floating point number. if there's no decimal point in the * * string, then append ".0" to it. However, if there's an 'e' in the string * * then javac will interpret it as floating point. The only real problem * * that occurs is when the constant is too big to fit as an integer, but has * * no decimal point, so javac flags it as an error (int constant too big). * * * *****************************************************************************/ void add_decimal_point(char *str) { BOOL found_dec = FALSE; char *p = str; while( *p != '\0' ) { if( *p == '.' ) { found_dec = TRUE; break; } if( *p == 'e' ) return; p++; } if(!found_dec) strcat(str, ".0"); } /***************************************************************************** * * * addnode * * * * To keep things simple, there is only one type of parse tree node. * * * *****************************************************************************/ AST * addnode() { return (AST*)f2jcalloc(1,sizeof(AST)); } /***************************************************************************** * * * switchem * * * * Need to turn the linked list around, * * so that it can traverse forward instead of in reverse. * * What I do here is create a doubly linked list. * * Note that there is no `sentinel' or `head' node * * in this list. It is acyclic and terminates in * * NULL pointers. * * * *****************************************************************************/ AST * switchem(AST * root) { if(root == NULL) return NULL; if (root->prevstmt == NULL) return root; while (root->prevstmt != NULL) { root->prevstmt->nextstmt = root; root = root->prevstmt; } return root; } /***************************************************************************** * * * assign_array_dims * * * * This is used by DIMENSION and COMMON to set the specified array * * dimensions, possibly in the absence of a type declaration. If we * * haven't seen a delcaration for this variable yet, create a new node. * * Otherwise, assign the array dimensions to the existing node. * * * *****************************************************************************/ void assign_array_dims(AST *var) { HASHNODE *hash_entry; AST *node; int i; hash_entry = type_lookup(type_table, var->astnode.ident.name); if(hash_entry) node = hash_entry->variable; else { if(debug){ printf("Calling initalize name from assign_array_dims\n"); } node = initialize_name(var->astnode.ident.name); /* if it's an intrinsic_named array */ if(node->astnode.ident.which_implicit == INTRIN_NAMED_ARRAY_OR_FUNC_CALL){ node->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY; type_insert(type_table, node, node->vartype, var->astnode.ident.name); } if(debug) printf("assign_array_dims: %s\n", var->astnode.ident.name); } node->astnode.ident.localvnum = -1; node->astnode.ident.arraylist = var->astnode.ident.arraylist; node->astnode.ident.dim = var->astnode.ident.dim; node->astnode.ident.leaddim = var->astnode.ident.leaddim; for(i=0;iastnode.ident.startDim[i] = var->astnode.ident.startDim[i]; node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i]; } /* do the same for the array table */ hash_entry = type_lookup(array_table, var->astnode.ident.name); if(hash_entry) node = hash_entry->variable; else { node = initialize_name(var->astnode.ident.name); type_insert(array_table, node, node->vartype, var->astnode.ident.name); hash_entry = type_lookup(array_table, var->astnode.ident.name); if(hash_entry) node = hash_entry->variable; else { fprintf(stderr, "internal error: lookup failed after insert\n"); return; } } node->astnode.ident.localvnum = -1; node->astnode.ident.arraylist = var->astnode.ident.arraylist; node->astnode.ident.dim = var->astnode.ident.dim; node->astnode.ident.leaddim = var->astnode.ident.leaddim; for(i=0;iastnode.ident.startDim[i] = var->astnode.ident.startDim[i]; node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i]; } } /***************************************************************************** * * * assign_common_array_dims * * * * For arrays declared in COMMON blocks, we go ahead and assign the * * dimensions in case they aren't dimensioned anywhere else. * * * *****************************************************************************/ void assign_common_array_dims(AST *root) { AST *Clist, *temp; for(Clist = root->astnode.common.nlist; Clist != NULL; Clist = Clist->nextstmt) { for(temp=Clist->astnode.common.nlist; temp!=NULL; temp=temp->nextstmt) { if(temp->astnode.ident.arraylist) assign_array_dims(temp); } } } /***************************************************************************** * * * type_hash * * * * For now, type_hash takes a tree (linked list) of type * * declarations from the Decblock rule. It will need to * * get those from Intrinsic, External, Parameter, etc. * * * *****************************************************************************/ void type_hash(AST * types) { HASHNODE *hash_entry; AST * temptypes, * tempnames; int return_type; /* Outer for loop traverses typestmts, inner for() * loop traverses declists. Code for stuffing symbol table is * is in inner for() loop. */ for (temptypes = types; temptypes; temptypes = temptypes->nextstmt) { /* Long assignment, set up the for() loop here instead of the expression list. */ tempnames = temptypes->astnode.typeunit.declist; /* Need to set the return value here before entering the next for() loop. */ return_type = temptypes->astnode.typeunit.returns; if(debug) printf("type_hash(): type dec is %s\n", print_nodetype(temptypes)); if(temptypes->nodetype == CommonList) { assign_common_array_dims(temptypes); continue; } /* skip parameter statements and data statements */ if(( (temptypes->nodetype == Specification) && (temptypes->astnode.typeunit.specification == Parameter)) || (temptypes->nodetype == DataList)) continue; for (; tempnames; tempnames = tempnames->nextstmt) { int i; /* ignore parameter assignment stmts */ if((tempnames->nodetype == Assignment) || (tempnames->nodetype == DataStmt)) continue; /* Stuff names and return types into the symbol table. */ if(debug) printf("Type hash: '%s' (%s)\n", tempnames->astnode.ident.name, print_nodetype(tempnames)); if(temptypes->nodetype == Dimension) assign_array_dims(tempnames); else { /* check whether there is already an array declaration for this ident. * this would be true in case of a normal type declaration with array * declarator, in which case we'll do a little extra work here. but * for idents that were previously dimensioned, we need to get this * info out of the table. */ hash_entry = type_lookup(array_table,tempnames->astnode.ident.name); if(hash_entry) { AST *var = hash_entry->variable; tempnames->astnode.ident.localvnum = -1; tempnames->astnode.ident.arraylist = var->astnode.ident.arraylist; tempnames->astnode.ident.dim = var->astnode.ident.dim; tempnames->astnode.ident.leaddim = var->astnode.ident.leaddim; for(i=0;iastnode.ident.startDim[i] = var->astnode.ident.startDim[i]; tempnames->astnode.ident.endDim[i] = var->astnode.ident.endDim[i]; } } if((temptypes->token != INTRINSIC) && (temptypes->token != EXTERNAL)) { hash_entry = type_lookup(type_table,tempnames->astnode.ident.name); if(hash_entry == NULL) { tempnames->vartype = return_type; tempnames->astnode.ident.localvnum = -1; if(debug){ printf("hh type_insert: %s\n", tempnames->astnode.ident.name); } type_insert(type_table, tempnames, return_type, tempnames->astnode.ident.name); if(debug) printf("Type hash (non-external): %s\n", tempnames->astnode.ident.name); } else { if(debug) { printf("type_hash: Entry already exists..."); printf("going to override the type.\n"); } hash_entry->variable->vartype = tempnames->vartype; } } } /* Now separate out the EXTERNAL from the INTRINSIC on the * fortran side. */ if(temptypes != NULL) { AST *newnode; /* create a new node to stick into the intrinsic/external table * so that the type_table isn't pointing to the same node. */ newnode = addnode(); strcpy(newnode->astnode.ident.name,tempnames->astnode.ident.name); newnode->vartype = return_type; newnode->nodetype = Identifier; switch (temptypes->token) { case INTRINSIC: type_insert(intrinsic_table, newnode, return_type, newnode->astnode.ident.name); if(debug) printf("Type hash (INTRINSIC): %s\n", newnode->astnode.ident.name); break; case EXTERNAL: type_insert(external_table, newnode, return_type, newnode->astnode.ident.name); if(debug) printf("Type hash (EXTERNAL): %s\n", newnode->astnode.ident.name); break; default: /* otherwise free the node that we didn't use. */ free_ast_node(newnode); break; /* ansi thing */ } /* Close switch(). */ } } /* Close inner for() loop. */ } /* Close outer for() loop. */ } /* Close type_hash(). */ /***************************************************************************** * * * exp_to_double * * * * Java recognizes numbers of the form 1.0e+1, so the `D' and `d' need * * to be replaced with 'e'. * * * *****************************************************************************/ void exp_to_double (char *lexeme, char *temp) { char *cp = lexeme; while (*cp) /* While *cp != '\0'... */ { if (*cp == 'd' || /* sscanf can recognize 'E'. */ *cp == 'D') { *cp = 'e'; /* Replace the 'd' or 'D' with 'e'. */ break; /* Should be only one 'd', 'D', etc. */ } cp++; /* Examine the next character. */ } /* Java should be able to handle exponential notation as part * of the float or double constant. */ strcpy(temp,lexeme); } /* Close exp_to_double(). */ /***************************************************************************** * * * arg_table_load * * * * Initialize and fill a table with the names of the * * variables passed in as arguments to the function or * * subroutine. This table is later checked when variable * * types are declared so that variables are not declared * * twice. * * * *****************************************************************************/ void arg_table_load(AST * arglist) { AST * temp; /* We traverse down `prevstmt' because the arglist is * built with right recursion, i.e. in reverse. This * procedure, 'arg_table_load()' is called when the non- * terminal `functionargs' is reduced, before the * argument list is reversed. Note that a NULL pointer * at either end of the list terminates the for() loop. */ for(temp = arglist; temp; temp = temp->nextstmt) { type_insert(args_table, temp, 0, temp->astnode.ident.name); if(debug) printf("#@Arglist var. name: %s\n", temp->astnode.ident.name); } } /***************************************************************************** * * * lowercase * * * * This function takes a string and converts all characters to * * lowercase. * * * *****************************************************************************/ char * lowercase(char * name) { char *ptr = name; while (*name) { *name = tolower(*name); name++; } return ptr; } /***************************************************************************** * * * store_array_var * * * * We need to make a table of array variables, because * * fortran accesses arrays by columns instead of rows * * as C and java does. During code generation, the array * * variables are emitted in reverse to get row order. * * * *****************************************************************************/ void store_array_var(AST * var) { if(type_lookup(array_table, var->astnode.ident.name) != NULL) fprintf(stderr,"Error: more than one array declarator for array '%s'\n", var->astnode.ident.name); else type_insert(array_table, var, 0, var->astnode.ident.name); if(debug) printf("Array name: %s\n", var->astnode.ident.name); } /***************************************************************************** * * * mypow * * * * Double power function. writing this here so that we * * dont have to link in the math library. * * * *****************************************************************************/ double mypow(double x, double y) { double result; int i; if(y < 0) { fprintf(stderr,"Warning: got negative exponent in mypow!\n"); return 0.0; } if(y == 0) return 1.0; if(y == 1) return x; result = x; for(i=0;inextstmt) { /* * First check whether this common block is already in * the table. */ ht=type_lookup(common_block_table,Clist->astnode.common.name); for(temp=Clist->astnode.common.nlist, count = 0; temp!=NULL; temp=temp->nextstmt) count++; name_array = (char **) f2jalloc( count * sizeof(name_array) ); /* foreach COMMON variable */ for(temp=Clist->astnode.common.nlist, count = 0; temp!=NULL; temp=temp->nextstmt, count++) { var = temp->astnode.ident.name; /* to merge two names we concatenate the second name * to the first name, separated by an underscore. */ if(ht != NULL) { comvar = ((char **)ht->variable)[count]; und_var[0] = '_'; und_var[1] = 0; strcat(und_var,var); strcpy(var_und,var); strcat(var_und,"_"); strcpy(und_var_und,und_var); strcat(und_var_und,"_"); } if(ht == NULL) { name_array[count] = (char *) f2jalloc( strlen(var) + 1 ); strcpy(name_array[count], var); } else { if(!strcmp(var,comvar) || strstr(comvar,und_var_und) || (((t=strstr(comvar,var_und)) != NULL) && t == comvar) || (((t=strstr(comvar,und_var)) != NULL) && (t+strlen(t) == comvar+strlen(comvar)))) { name_array[count] = (char *) f2jalloc( strlen(comvar) + 1 ); strcpy(name_array[count], comvar); } else { name_array[count] = (char *) f2jalloc(strlen(temp->astnode.ident.name) + strlen(((char **)ht->variable)[count]) + 2); strcpy(name_array[count],temp->astnode.ident.name); strcat(name_array[count],"_"); strcat(name_array[count],((char **)ht->variable)[count]); } } } type_insert(common_block_table, (AST *)name_array, Float, Clist->astnode.common.name); } } /***************************************************************************** * * * addEquiv * * * * Insert the given node (which is itself a list of variables) into a list * * of equivalences. We end up with a list of lists. * * * *****************************************************************************/ void addEquiv(AST *node) { static int id = 1; /* if the list is NULL, create one */ if(equivList == NULL) { equivList = addnode(); equivList->nodetype = Equivalence; equivList->token = id++; equivList->nextstmt = NULL; equivList->prevstmt = NULL; equivList->astnode.equiv.clist = node; } else { AST *temp = addnode(); temp->nodetype = Equivalence; temp->token = id++; temp->astnode.equiv.clist = node; temp->nextstmt = equivList; temp->prevstmt = NULL; equivList = temp; } } /***************************************************************************** * * * eval_const_expr * * * * This function evaluates a floating-point expression which should consist * * of only parameters and constants. The floating-point result is returned. * * * *****************************************************************************/ double eval_const_expr(AST *root) { HASHNODE *p; double result1, result2; if(root == NULL) return 0.0; switch (root->nodetype) { case Identifier: if(!strcmp(root->astnode.ident.name,"*")) return 0.0; p = type_lookup(parameter_table, root->astnode.ident.name); if(p) { if(p->variable->nodetype == Constant) { root->vartype = p->variable->vartype; return ( atof(p->variable->astnode.constant.number) ); } } /* else p==NULL, then the array size is specified with a * variable, but we cant find it in the parameter table. * it is probably an argument to the function. do nothing * here, just fall through and hit the 'return 0' below. --keith */ return 0.0; case Expression: if (root->astnode.expression.lhs != NULL) eval_const_expr (root->astnode.expression.lhs); result2 = eval_const_expr (root->astnode.expression.rhs); root->token = root->astnode.expression.rhs->token; root->vartype = root->astnode.expression.rhs->vartype; return (result2); case Power: result1 = eval_const_expr (root->astnode.expression.lhs); result2 = eval_const_expr (root->astnode.expression.rhs); root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); return( mypow(result1,result2) ); case Binaryop: result1 = eval_const_expr (root->astnode.expression.lhs); result2 = eval_const_expr (root->astnode.expression.rhs); root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); if(root->astnode.expression.optype == '-') return (result1 - result2); else if(root->astnode.expression.optype == '+') return (result1 + result2); else if(root->astnode.expression.optype == '*') return (result1 * result2); else if(root->astnode.expression.optype == '/') return (result1 / result2); else fprintf(stderr,"eval_const_expr: Bad optype!\n"); return 0.0; case Unaryop: root->vartype = root->astnode.expression.rhs->vartype; /* result1 = eval_const_expr (root->astnode.expression.rhs); if(root->astnode.expression.minus == '-') return -result1; */ break; case Constant: if(debug) printf("### its a constant.. %s\n", root->astnode.constant.number); if(root->token == STRING) { if(!strcmp(root->astnode.ident.name,"*")) return 0.0; else fprintf (stderr, "String in array dec (%s)!\n", root->astnode.constant.number); } else return( atof(root->astnode.constant.number) ); break; case ArrayIdxRange: /* I dont think it really matters what the type of this node is. --kgs */ root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); return( eval_const_expr(root->astnode.expression.rhs) - eval_const_expr(root->astnode.expression.lhs) ); case Logicalop: { int lhs=0, rhs; root->nodetype = Constant; root->vartype = Logical; eval_const_expr(root->astnode.expression.lhs); eval_const_expr(root->astnode.expression.rhs); if(root->token != NOT) lhs = root->astnode.expression.lhs->token == TrUE; rhs = root->astnode.expression.rhs->token == TrUE; switch (root->token) { case EQV: root->token = (lhs == rhs) ? TrUE : FaLSE; break; case NEQV: root->token = (lhs != rhs) ? TrUE : FaLSE; break; case AND: root->token = (lhs && rhs) ? TrUE : FaLSE; break; case OR: root->token = (lhs || rhs) ? TrUE : FaLSE; break; case NOT: root->token = (! rhs) ? TrUE : FaLSE; break; } return (double)root->token; } default: fprintf(stderr,"eval_const_expr(): bad nodetype!\n"); return 0.0; } return 0.0; } void printbits(char *header, void *var, int datalen) { int i; printf("%s: ", header); for(i=0;i> 7 ); printf("%1x", ((unsigned char *)var)[i] >> 6 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 5 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 4 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 3 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 2 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 1 & 1 ); printf("%1x", ((unsigned char *)var)[i] & 1 ); } printf("\n"); } /***************************************************************************** * * * unary_negate_string * * * * This function accepts a string and prepends a '-' in front of it. * * * *****************************************************************************/ char * unary_negate_string(char *num) { char *tempstr, *mchar; /* allocate enough for the number, minus sign, and null char */ tempstr = (char *)f2jalloc(strlen(num) + 5); if(!tempstr) return NULL; strcpy(tempstr, num); if((mchar = first_char_is_minus(tempstr)) != NULL) { *mchar = ' '; return tempstr; } strcpy(tempstr,"-"); strcat(tempstr,num); return tempstr; } /***************************************************************************** * * * first_char_is_minus * * * * Determines whether the number represented by this string is negative. * * If negative, this function returns a pointer to the minus sign. if non- * * negative, returns NULL. * * * *****************************************************************************/ char * first_char_is_minus(char *num) { char *ptr = num; while( *ptr ) { if( *ptr == '-' ) return ptr; if( *ptr != ' ' ) return NULL; ptr++; } return NULL; } /***************************************************************************** * * * gen_incr_expr * * * * this function creates an AST sub-tree representing a calculation of the * * increment for this loop. for null increments, add one. for non-null * * increments, add the appropriate value. * * *****************************************************************************/ AST * gen_incr_expr(AST *counter, AST *incr) { AST *plus_node, *const_node, *assign_node, *lhs_copy, *rhs_copy, *incr_copy; lhs_copy = addnode(); memcpy(lhs_copy, counter, sizeof(AST)); rhs_copy = addnode(); memcpy(rhs_copy, counter, sizeof(AST)); if(incr == NULL) { const_node = addnode(); const_node->token = INTEGER; const_node->nodetype = Constant; const_node->astnode.constant.number = strdup("1"); const_node->vartype = Integer; plus_node = addnode(); plus_node->token = PLUS; rhs_copy->parent = plus_node; const_node->parent = plus_node; plus_node->astnode.expression.lhs = rhs_copy; plus_node->astnode.expression.rhs = const_node; plus_node->nodetype = Binaryop; plus_node->astnode.expression.optype = '+'; } else { incr_copy = addnode(); memcpy(incr_copy, incr, sizeof(AST)); plus_node = addnode(); plus_node->token = PLUS; rhs_copy->parent = plus_node; incr_copy->parent = plus_node; plus_node->astnode.expression.lhs = rhs_copy; plus_node->astnode.expression.rhs = incr_copy; plus_node->nodetype = Binaryop; plus_node->astnode.expression.optype = '+'; } assign_node = addnode(); assign_node->nodetype = Assignment; lhs_copy->parent = assign_node; plus_node->parent = assign_node; assign_node->astnode.assignment.lhs = lhs_copy; assign_node->astnode.assignment.rhs = plus_node; return assign_node; } /***************************************************************************** * * * gen_iter_expr * * * * this function creates an AST sub-tree representing a calculation of the * * number of iterations of a DO loop: * * (stop-start+incr)/incr * * the full expression is MAX(INT((stop-start+incr)/incr),0) but we will * * worry about the rest of it at code generation time. * * * *****************************************************************************/ AST * gen_iter_expr(AST *start, AST *stop, AST *incr) { AST *minus_node, *plus_node, *div_node, *expr_node, *incr_node; minus_node = addnode(); minus_node->token = MINUS; minus_node->astnode.expression.lhs = stop; minus_node->astnode.expression.rhs = start; minus_node->nodetype = Binaryop; minus_node->astnode.expression.optype = '-'; if(incr == NULL) { incr_node = addnode(); incr_node->token = INTEGER; incr_node->nodetype = Constant; incr_node->astnode.constant.number = strdup("1"); incr_node->vartype = Integer; } else incr_node = incr; plus_node = addnode(); plus_node->token = PLUS; plus_node->astnode.expression.lhs = minus_node; plus_node->astnode.expression.rhs = incr_node; plus_node->nodetype = Binaryop; plus_node->astnode.expression.optype = '+'; if(incr == NULL) return plus_node; expr_node = addnode(); expr_node->nodetype = Expression; expr_node->astnode.expression.parens = TRUE; expr_node->astnode.expression.rhs = plus_node; expr_node->astnode.expression.lhs = NULL; div_node = addnode(); div_node->token = DIV; div_node->astnode.expression.lhs = expr_node; div_node->astnode.expression.rhs = incr_node; div_node->nodetype = Binaryop; div_node->astnode.expression.optype = '/'; return div_node; } /***************************************************************************** * * * initialize_name * * * * this function initializes an Identifier node with the given name. * * * *****************************************************************************/ AST * initialize_name(char *id) { HASHNODE *hashtemp; AST *tmp, *tnode; char *tempname; if(debug) printf("initialize_name: '%s'\n",id); tmp=addnode(); tmp->token = NAME; tmp->nodetype = Identifier; tmp->astnode.ident.needs_declaration = FALSE; tmp->astnode.ident.explicit = FALSE; tmp->astnode.ident.which_implicit = INTRIN_NOT_NAMED; tmp->astnode.ident.localvnum = -1; tmp->astnode.ident.array_len = -1; if(omitWrappers) tmp->astnode.ident.passByRef = FALSE; if(type_lookup(java_keyword_table,id)) id[0] = toupper(id[0]); strcpy(tmp->astnode.ident.name, id); tempname = strdup(tmp->astnode.ident.name); uppercase(tempname); if((type_lookup(parameter_table, tmp->astnode.ident.name) == NULL) && (in_dlist(subroutine_names, tmp->astnode.ident.name) == 0)) { if(type_table) { hashtemp = type_lookup(type_table, tmp->astnode.ident.name); if(hashtemp) { if(debug) printf("initialize_name:'%s' in already hash table (type=%s)..\n", id, returnstring[hashtemp->variable->vartype]); tmp->vartype = hashtemp->variable->vartype; if(debug) printf("now type is %s\n", returnstring[tmp->vartype]); tmp->astnode.ident.len = hashtemp->variable->astnode.ident.len; } else { enum returntype ret; if(debug) printf("initialize_name:cannot find name %s in hash table..\n",id); if(methodscan(intrinsic_toks, tempname) != NULL) { tmp->astnode.ident.which_implicit = intrinsic_or_implicit(tmp->astnode.ident.name); } ret = implicit_table[tolower(id[0]) - 'a'].type; if(debug) printf("initialize_name:insert with default implicit type %s\n", returnstring[ret]); tmp->vartype = ret; if(debug) printf("type_insert: %s %d\n", tmp->astnode.ident.name, tmp->nodetype); /* clone the ast node before inserting into the table */ tnode = clone_ident(tmp); tnode->nodetype = Identifier; if(tmp->astnode.ident.which_implicit != INTRIN_NAMED_ARRAY_OR_FUNC_CALL) { if(debug) printf("insert typetable init name\n"); type_insert(type_table, tnode, ret, tnode->astnode.ident.name); } } } } return tmp; } /***************************************************************************** * * * intrinsic_or_implict * * * * Only gets called if it is an intrinsic name. * * * * this functions tries to figure out if it's intrinsic call, array * * or variable. * * * ******************************************************************************/ int intrinsic_or_implicit(char *name) { char *p, *tempname, *space_buffer, *clean_buffer, *tmp_spot; char *words[12] = {"INTEGER", "DOUBLEPRECISION", "CHARACTER", "DATA", "PARAMETER", "LOGICAL", "INTRINSIC", "EXTERNAL", "SAVE", "IMPLICIT", "DIMENSION", "CALL"}; int i, ret_val = INTRIN_NAMED_VARIABLE; tempname = (char *)malloc((strlen(name)+2)*sizeof(char)); space_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char)); clean_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char)); strcpy(tempname, name); uppercase(tempname); strcat(tempname, "("); uppercase(line_buffer); tmp_spot = line_buffer; for(i=0; i<12; i++) { if(!strncmp(line_buffer, words[i], strlen(words[i]))) { tmp_spot = line_buffer + strlen(words[i]); break; } } strcpy(clean_buffer, " \0"); strcat(clean_buffer, tmp_spot); p = strstr(clean_buffer, tempname); while(p) { if((p)&&(!isalpha((int)*(p-1)))) { ret_val=INTRIN_NAMED_ARRAY_OR_FUNC_CALL; break; } for(i=0; i< strlen(tempname); i++) p++; strcpy(space_buffer, " \0"); strcat(space_buffer, p); p = strstr(space_buffer, tempname); } free(space_buffer); free(clean_buffer); free(tempname); return ret_val; } /***************************************************************************** * * * print_sym_table_names * * * * Routine to see what's in the symbol table. * * * *****************************************************************************/ void print_sym_table_names(SYMTABLE *table){ Dlist t_table, tmp; AST *node; t_table = enumerate_symtable(table); dl_traverse(tmp, t_table){ node = (AST *)dl_val(tmp); printf("sym_table %s\n", node->astnode.ident.name); } } /***************************************************************************** * * * insert_name * * * * this function inserts the given node into the symbol table, if it is not * * already there. * * * *****************************************************************************/ void insert_name(SYMTABLE * tt, AST *node, enum returntype ret) { HASHNODE *hash_entry; hash_entry = type_lookup(tt,node->astnode.ident.name); if(hash_entry == NULL) node->vartype = ret; else node->vartype = hash_entry->variable->vartype; type_insert(tt, node, node->vartype, node->astnode.ident.name); } /***************************************************************************** * * * initialize_implicit_table * * * * this function the implicit table, which indicates the implicit typing for * * the current program unit (i.e. which letters correspond to which data * * type). * * * *****************************************************************************/ void initialize_implicit_table(ITAB_ENTRY *itab) { int i; /* first initialize everything to float */ for(i = 0; i < 26; i++) { itab[i].type = Float; itab[i].declared = FALSE; } /* then change 'i' through 'n' to Integer */ for(i = 'i' - 'a'; i <= 'n' - 'a'; i++) itab[i].type = Integer; } /***************************************************************************** * * * add_implicit_to_tree * * * * this adds a node for an implicit variable to typedec * * * *****************************************************************************/ void add_implicit_to_tree(AST *typedec) { Dlist t_table, tmp; AST *ast, *new_node, *last_typedec; last_typedec = typedec; while(last_typedec->nextstmt!=NULL) { last_typedec = last_typedec->nextstmt; } t_table = enumerate_symtable(type_table); dl_traverse(tmp, t_table) { ast = (AST *)dl_val(tmp); if(ast->astnode.ident.explicit == FALSE) { if(debug)printf("implicit name=%s\n", ast->astnode.ident.name); new_node = addnode(); new_node->astnode.typeunit.returns = ast->vartype; new_node->nodetype = Typedec; ast->parent = new_node; new_node->astnode.typeunit.declist = clone_ident(ast); last_typedec->nextstmt = new_node; last_typedec = last_typedec->nextstmt; } } } /***************************************************************************** * * * clone_ident * * * * this function clones an astnode(ident) and passes back the new node * * * *****************************************************************************/ AST * clone_ident(AST *ast) { AST *new_node; int i; new_node = addnode(); new_node->parent = ast->parent; new_node->vartype = ast->vartype; new_node->astnode.ident.dim = ast->astnode.ident.dim; new_node->astnode.ident.position = ast->astnode.ident.position; new_node->astnode.ident.len = ast->astnode.ident.len; new_node->astnode.ident.localvnum = ast->astnode.ident.localvnum; new_node->astnode.ident.which_implicit = ast->astnode.ident.which_implicit; new_node->astnode.ident.passByRef = ast->astnode.ident.passByRef; new_node->astnode.ident.needs_declaration = ast->astnode.ident.needs_declaration; new_node->astnode.ident.explicit = FALSE; for(i=0; i<=MAX_ARRAY_DIM; i++) { new_node->astnode.ident.startDim[i] = ast->astnode.ident.startDim[i]; new_node->astnode.ident.endDim[i] = ast->astnode.ident.endDim[i]; } new_node->astnode.ident.arraylist = ast->astnode.ident.arraylist; if(ast->astnode.ident.leaddim) new_node->astnode.ident.leaddim = strdup(ast->astnode.ident.leaddim); if(ast->astnode.ident.opcode) new_node->astnode.ident.opcode = strdup(ast->astnode.ident.opcode); if(ast->astnode.ident.commonBlockName) new_node->astnode.ident.commonBlockName = strdup(ast->astnode.ident.commonBlockName); strcpy(new_node->astnode.ident.name, ast->astnode.ident.name); if(ast->astnode.ident.merged_name) new_node->astnode.ident.merged_name = strdup(ast->astnode.ident.merged_name); if(ast->astnode.ident.descriptor) new_node->astnode.ident.descriptor = strdup(ast->astnode.ident.descriptor); return new_node; } /***************************************************************************** * * * in_dlist * * * * Returns 1 if the given name is in the list, returns 0 otherwise. * * Assumes that the list contains char pointers. * * * *****************************************************************************/ int in_dlist(Dlist list, char *name) { Dlist ptr; char *list_name; dl_traverse(ptr, list){ list_name = (char *)dl_val(ptr); if(!strcmp(list_name, name)) return 1; } return 0; } /***************************************************************************** * * * in_dlist_stmt_label * * * * Returns 1 if the given label is in the list, returns 0 otherwise. * * Assumes that the list contains AST pointers. * * * *****************************************************************************/ int in_dlist_stmt_label(Dlist list, AST *label) { Dlist ptr; AST *tmp; dl_traverse(ptr, list){ tmp = (AST *)dl_val(ptr); if(!strcmp(tmp->astnode.constant.number, label->astnode.constant.number)) return 1; } return 0; } /***************************************************************************** * * * process_typestmt * * * * Performs processing to handle a list of variable declarations. * * * *****************************************************************************/ AST * process_typestmt(enum returntype this_type, AST *tvlist) { AST *temp, *new; enum returntype ret; HASHNODE *hashtemp, *hashtemp2; new = addnode(); free_ast_node(tvlist->parent); tvlist = switchem(tvlist); new->nodetype = Typedec; for(temp = tvlist; temp != NULL; temp = temp->nextstmt) { temp->vartype = this_type; ret = this_type; if(temp->astnode.ident.len < 0) temp->astnode.ident.len = len; temp->parent = new; hashtemp = type_lookup(args_table, temp->astnode.ident.name); if(hashtemp) hashtemp->variable->vartype = this_type; hashtemp2 = type_lookup(type_table, temp->astnode.ident.name); if(hashtemp2) { temp->vartype = this_type; temp->astnode.ident.explicit = TRUE; hashtemp2->variable = temp; if(debug) printf("explicit: %s\n", hashtemp2->variable->astnode.ident.name); } if(hashtemp) { if(temp->vartype != hashtemp->variable->vartype){ if(debug) printf("different vartypes\n"); hashtemp->variable->vartype=temp->vartype; hashtemp2->variable->vartype=temp->vartype; } } } new->astnode.typeunit.declist = tvlist; new->astnode.typeunit.returns = this_type; return new; } /***************************************************************************** * * * process_array_declaration * * * * Performs processing to handle an array declaration. * * * *****************************************************************************/ AST * process_array_declaration(AST *varname, AST *dimlist) { AST *new, *temp, *tmp, *tnode; int count, i, alen; char *tempname, *id; enum returntype ret; if(debug) printf("we have an array declaration %s\n", varname->astnode.ident.name); tempname = strdup(varname->astnode.ident.name); uppercase(tempname); /* put in type table. we now know this intrinsic name is an array */ if(methodscan(intrinsic_toks, tempname) != NULL) { tmp=addnode(); tmp->token = NAME; tmp->nodetype = Identifier; tmp->astnode.ident.needs_declaration = FALSE; tmp->astnode.ident.explicit = FALSE; tmp->astnode.ident.localvnum = -1; id = strdup(varname->astnode.ident.name); strcpy(tmp->astnode.ident.name, id); ret = implicit_table[tolower(id[0]) - 'a'].type; tmp->vartype = ret; tnode = clone_ident(tmp); tnode->nodetype = Identifier; tnode->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY; type_insert(type_table, tnode, ret, tnode->astnode.ident.name); } new = varname; if(debug) printf("reduced arraydeclaration... calling switchem\n"); new->astnode.ident.arraylist = switchem(dimlist); count = 0; for(temp=new->astnode.ident.arraylist; temp != NULL; temp=temp->nextstmt) count++; if(count > MAX_ARRAY_DIM) { fprintf(stderr,"Error: array %s exceeds max ", new->astnode.ident.name); fprintf(stderr,"number of dimensions: %d\n", MAX_ARRAY_DIM); exit(EXIT_FAILURE); } new->astnode.ident.dim = count; /* * If this is a one-dimensional one-length character array, for example: * character foo(12) * character*1 bar(12) * then don't treat as an array. Set dimension to zero and arraylist * to NULL. Save the arraylist in startDim[2] since we will need it * during code generation. */ if((typedec_context == String) && (len == 1) && (count == 1)) { new->astnode.ident.dim = 0; new->astnode.ident.startDim[2] = new->astnode.ident.arraylist; new->astnode.ident.arraylist = NULL; return new; } alen = 1; for(temp = new->astnode.ident.arraylist, i = 0; temp != NULL; temp=temp->nextstmt, i++) { /* if this dimension is an implied size, then set both * start and end to NULL. */ if((temp->nodetype == Identifier) && (temp->astnode.ident.name[0] == '*')) { new->astnode.ident.startDim[i] = NULL; new->astnode.ident.endDim[i] = NULL; alen = 0; } else if(temp->nodetype == ArrayIdxRange) { new->astnode.ident.startDim[i] = temp->astnode.expression.lhs; new->astnode.ident.endDim[i] = temp->astnode.expression.rhs; alen *= (int)(eval_const_expr(new->astnode.ident.endDim[i]) - eval_const_expr(new->astnode.ident.startDim[i])) + 1; } else { new->astnode.ident.startDim[i] = NULL; new->astnode.ident.endDim[i] = temp; alen *= (int) eval_const_expr(new->astnode.ident.endDim[i]); } } if(alen) new->astnode.ident.array_len = alen; else new->astnode.ident.array_len = -1; new->astnode.ident.leaddim = NULL; /* leaddim might be a constant, so check for that. --keith */ if(new->astnode.ident.arraylist->nodetype == Constant) { new->astnode.ident.leaddim = strdup(new->astnode.ident.arraylist->astnode.constant.number); } else { new->astnode.ident.leaddim = strdup(new->astnode.ident.arraylist->astnode.ident.name); } store_array_var(new); return new; } /***************************************************************************** * * * process_subroutine_call * * * * Performs processing to handle a subroutine/function call or array access. * * * *****************************************************************************/ AST * process_subroutine_call(AST *varname, AST *explist) { char *tempname; AST *new; new = addnode(); varname->parent = new; if(explist != NULL) strcpy(explist->parent->astnode.ident.name, varname->astnode.ident.name); /* * Here we could look up the name in the array table and set * the nodetype to ArrayAccess if it is found. Then the code * generator could easily distinguish between array accesses * and function calls. I'll have to implement the rest of * this soon. -- Keith * * if(type_lookup(array_table, varname->astnode.ident.name)) * new->nodetype = ArrayAccess; * else * new->nodetype = Identifier; */ new->nodetype = Identifier; strcpy(new->astnode.ident.name, varname->astnode.ident.name); /* We don't switch index order. */ if(explist == NULL) { new->astnode.ident.arraylist = addnode(); new->astnode.ident.arraylist->nodetype = EmptyArgList; } else new->astnode.ident.arraylist = switchem(explist); tempname = strdup(new->astnode.ident.name); uppercase(tempname); if(!type_lookup(external_table, new->astnode.ident.name) && !type_lookup(array_table, new->astnode.ident.name) && methodscan(intrinsic_toks, tempname)) { HASHNODE *ife; /* this must be an intrinsic function call, so remove * the entry from the type table (because the code * generator checks whether something is an intrinsic * or not by checking whether it's in the type table). */ ife = type_lookup(type_table, new->astnode.ident.name); if(ife) ife = hash_delete(type_table, new->astnode.ident.name); } free_ast_node(varname); free(tempname); return new; } /***************************************************************************** * * * assign_function_return_type * * * * This function scans the type declarations to see if this function was * * declared. If so, we reset the return type of the function to the * * type declared here. e.g.: * * function dlaneg(n) * * integer n * * integer dlaneg * * Normally the function would have an implicit type of REAL, but it * * will be set to INTEGER in this case. * * * *****************************************************************************/ void assign_function_return_type(AST *func, AST *specs) { AST *temp, *dec_temp; HASHNODE *ht; for(temp = specs; temp; temp=temp->nextstmt) { if(temp->nodetype == Typedec) { for(dec_temp = temp->astnode.typeunit.declist; dec_temp; dec_temp = dec_temp->nextstmt) { if(!strcmp(dec_temp->astnode.ident.name, func->astnode.source.name->astnode.ident.name)) { func->astnode.source.returns = temp->astnode.typeunit.returns; func->vartype = temp->astnode.typeunit.returns; func->astnode.source.name->vartype = temp->astnode.typeunit.returns; ht = type_lookup(type_table, dec_temp->astnode.ident.name); /* the else case shouldn't be hit since the implied variable * should have been inserted already. */ if(ht) ht->variable->vartype = temp->astnode.typeunit.returns; else insert_name(type_table, dec_temp, temp->astnode.typeunit.returns); } } } } } f2j-0.8.1/src/getopt.c0000600000077700002310000000402611031241064014502 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/getopt.c,v $ * $Revision: 1.3 $ * $Date: 2004/02/04 06:25:43 $ * $Author: keithseymour $ */ /* ** GETOPT PROGRAM AND LIBRARY ROUTINE ** ** I wrote main() and AT&T wrote getopt() and we both put our efforts into ** the public domain via mod.sources. ** Rich $alz ** Mirror Systems ** (mirror!rs, rs@mirror.TMC.COM) ** August 10, 1986 */ #include #include #include /* ** This is the public-domain AT&T getopt(3) code. I added the ** #ifndef stuff because I include for the program; ** getopt, per se, doesn't need it. I also added the INDEX/index ** hack (the original used strchr, of course). And, note that ** technically the casts in the write(2) calls shouldn't be there. */ #ifndef NULL #define NULL 0 #endif #ifndef EOF #define EOF (-1) #endif #ifndef INDEX #define INDEX strchr #endif #define ERR(s, c) if(opterr){\ char errbuf[2];\ errbuf[0] = c; errbuf[1] = '\n';\ (void) write(2, argv[0], (unsigned)strlen(argv[0]));\ (void) write(2, s, (unsigned)strlen(s));\ (void) write(2, errbuf, 2);} extern int strcmp(); extern char *INDEX(const char *, int); int opterr = 1; int optind = 1; int optopt; char *optarg; int getopt(argc, argv, opts) int argc; char **argv, *opts; { static int sp = 1; register int c; register char *cp; if(sp == 1) if(optind >= argc || argv[optind][0] != '-' || argv[optind][1] == '\0') return(EOF); else if(strcmp(argv[optind], "--") == NULL) { optind++; return(EOF); } optopt = c = argv[optind][sp]; if(c == ':' || (cp=INDEX(opts, c)) == NULL) { ERR(": illegal option -- ", c); if(argv[optind][++sp] == '\0') { optind++; sp = 1; } return('?'); } if(*++cp == ':') { if(argv[optind][sp+1] != '\0') optarg = &argv[optind++][sp+1]; else if(++optind >= argc) { ERR(": option requires an argument -- ", c); sp = 1; return('?'); } else optarg = argv[optind++]; sp = 1; } else { if(argv[optind][++sp] == '\0') { sp = 1; optind++; } optarg = NULL; } return(c); } f2j-0.8.1/src/globals.c0000600000077700002310000010625211031241064014627 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/globals.c,v $ * $Revision: 1.30 $ * $Date: 2007/07/30 20:52:25 $ * $Author: keithseymour $ */ /***************************************************************************** * globals.c * * * * This file contains a lot of globals that are common to many parts of the * * f2java system. * * * * The following several tables have their last entry initialized * * to `NULL'. This allows each table to be traversed by a while() * * loop: 'while (tab->entry)' loops until entry is NULL, then * * gracefully exits. Similarly, a for() loop can be used, for example: * * 'for (tab;tab;tab++)' traverses tab until the NULL last entry is * * reached. See the 'keyscan()' and 'methodscan()' procedures. * * * *****************************************************************************/ #include"f2j.h" #include"codegen.h" #include"y.tab.h" int lineno, /* current line number */ statementno, /* current statement number */ func_stmt_num, /* current statement number within this function */ ignored_formatting, /* number of format statements ignored */ bad_format_count; /* number of invalid format stmts encountered */ FILE *ifp, /* input file pointer */ *vcgfp, /* VCG output file pointer */ *indexfp; /* method and descriptor index for all prog units */ char *inputfilename, /* name of the input file */ *package_name, /* what to name the package, e.g. org.netlib.blas */ *output_dir; /* path to which f2java should store class files */ BOOL strictFp, /* should we declare generated code as strictfp */ strictMath, /* should we use Java's StrictMath library */ omitWrappers, /* should we try to optimize use of wrappers */ genInterfaces, /* should we generate simplified interfaces */ genJavadoc, /* should we generate javadoc-compatible comments */ noOffset, /* should we generate offset args in interfaces */ f2j_arrays_static, /* force all arrays to be declared static. */ save_all_override; /* force all variables to be declared static. */ SYMTABLE *type_table, /* General symbol table */ *external_table, /* external functions */ *intrinsic_table, /* intrinsic functions */ *args_table, /* arguments to the current unit */ *array_table, /* array variables */ *format_table, /* format statements */ *data_table, /* variables contained in DATA statements */ *save_table, /* variables contained in SAVE statements */ *common_table, /* variables contained in COMMON statements */ *parameter_table, /* PARAMETER variables */ *function_table, /* table of functions */ *java_keyword_table, /* table of Java reserved words */ *blas_routine_table, /* table of BLAS routines */ *common_block_table, /* COMMON blocks */ *global_func_table, /* Global function table */ *global_common_table, /* Global COMMON table */ *generic_table; /* table of the generic intrinsic functions */ Dlist constants_table, /* constants (for bytecode constant pool gen.) */ descriptor_table, /* list of method descriptors from *.f2j files */ include_paths, /* list of paths to search for included files */ file_stack; /* file stack for handling include statements */ INCLUDED_FILE *current_file_info; /* lexer information about the current file */ /***************************************************************************** * Statement starting keywords. The only violation of this * * in fortran 77 is the keyword THEN following a closing * * parentheses (')'). * *****************************************************************************/ KWDTAB tab_stmt[] = { {"CALL", CALL, 0}, {"CLOSE", CLOSE, 0}, {"COMMON", COMMON, 0}, {"CONTINUE", CONTINUE, 0}, {"DATA", DATA, 0}, {"DIMENSION", DIMENSION, 0}, {"DO", DO, 0}, {"ENDDO", ENDDO, 0}, {"ENDIF", ENDIF, 0}, {"END", END, 0}, {"ELSEIF", ELSEIF, 0}, {"ELSE", ELSE, 0}, {"ENTRY", ENTRY, 0}, {"EQUIVALENCE", EQUIVALENCE, 0}, {"EXTERNAL", EXTERNAL, 0}, {"FORMAT", FORMAT, 0}, {"FUNCTION", FUNCTION, 0}, {"GOTO", GOTO, 0}, {"IF", IF, 0}, {"NONE", NONE, 0}, {"OPEN", OPEN, 0}, {"IMPLICIT", IMPLICIT, 0}, {"INTRINSIC", INTRINSIC, 0}, {"PARAMETER", PARAMETER, 0}, {"PROGRAM", PROGRAM, 0}, {"READ", READ, 0}, {"RETURN", RETURN, 0}, {"REWIND", REWIND, 0}, {"SAVE", SAVE, 0}, {"STOP", STOP, 0}, {"PAUSE", PAUSE, 0}, {"SUBROUTINE", SUBROUTINE, 0}, {"THEN", THEN, 0}, {"WRITE", WRITE, 0}, {"PRINT", PRINT, 0}, {"ASSIGN", ASSIGN, 0}, { NULL, 0, 0} /* Ends a scanning loop. See comment above. */ }; /***************************************************************************** * The type tokens MUST appear at the beginning of a * * statement, and must occur before any of the * * executable statements. * *****************************************************************************/ KWDTAB tab_type[] = { {"DOUBLEPRECISION", ARITH_TYPE, Double}, {"REAL*8", ARITH_TYPE, Double}, {"REAL*4", ARITH_TYPE, Float}, {"REAL", ARITH_TYPE, Float}, {"INTEGER*4", ARITH_TYPE, Integer}, {"INTEGER", ARITH_TYPE, Integer}, {"LOGICAL*4", ARITH_TYPE, Logical}, {"LOGICAL", ARITH_TYPE, Logical}, {"DOUBLECOMPLEX", ARITH_TYPE, Complex}, {"COMPLEX*16", ARITH_TYPE, Complex}, {"COMPLEX*8", ARITH_TYPE, Complex}, {"COMPLEX", ARITH_TYPE, Complex}, {"CHARACTER", CHAR_TYPE, String}, { NULL, 0, 0} /* Ends a scanning loop. See comment above. */ }; /***************************************************************************** * Miscellaneous tokens. None of these tokens may * * appear at the beginning fo a statement. * *****************************************************************************/ KWDTAB tab_toks[] = { {"\n", NL, 0}, /* Statement separator. */ {"+", PLUS, 0}, {"-", MINUS, 0}, {"(", OP, 0}, {")", CP, 0}, {"**", POW, 0}, {"*", STAR, 0}, {"//", CAT, 0}, {"/", DIV, 0}, {",", CM, 0}, {"=", EQ, 0}, {":", COLON, 0}, {".NOT.", NOT, 0}, {".AND.", AND, 0}, {".OR.", OR, 0}, {".EQV.", EQV, 0}, {".NEQV.", NEQV, 0}, {".EQ.", RELOP, rel_eq}, {".NE.", RELOP, rel_ne}, {".LT.", RELOP, rel_lt}, {".LE.", RELOP, rel_le}, {".GT.", RELOP, rel_gt}, {".GE.", RELOP, rel_ge}, {".TRUE.", TrUE, 1}, {".FALSE.", FaLSE, 0}, {"FMT", FMT, 0}, { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */ }; /***************************************************************************** * Tokens found within a READ statement. There are probably more that * * should be here, but so far I just have END. * *****************************************************************************/ KWDTAB read_toks[] = { {"END", END, 0}, { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */ }; /***************************************************************************** * Tokens found within an OPEN statement. There are probably more that * * should be here. * *****************************************************************************/ KWDTAB open_toks[] = { {"IOSTAT", OPEN_IOSTAT, 0}, {"ERR", OPEN_ERR, 0}, {"FILE", OPEN_FILE, 0}, {"STATUS", OPEN_STATUS, 0}, {"ACCESS", OPEN_ACCESS, 0}, {"FORM", OPEN_FORM, 0}, {"UNIT", OPEN_UNIT, 0}, {"RECL", OPEN_RECL, 0}, {"BLANK", OPEN_BLANK, 0}, { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */ }; /***************************************************************************** * Tokens found within an ASSIGN statement. * *****************************************************************************/ KWDTAB assign_toks[] = { {"TO", TO, 0}, { NULL, 0, 0} /* Ensures that the scanning loop ends if nothing is matched. */ }; /***************************************************************************** * This table lists stuff that can be handled with java methods. The * * pattern is {"fortran name", "java method"}. Some of the fortran names * * are intrinsic to fortran and java, others are intrinsic only to java and * * replace function or sub-routine calls in the lapack or blas source. * *****************************************************************************/ METHODTAB intrinsic_toks[]= { /* Type conversion intrinsics */ {ifunc_INT, "INT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Integer}, {ifunc_IFIX, "IFIX", "(int)", NULL, "Unused", NULL, "Unused", "Unused", REAL_ARG, Integer}, {ifunc_IDINT, "IDINT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Integer}, {ifunc_REAL, "REAL", "(float)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Float}, {ifunc_FLOAT, "FLOAT", "(float)", NULL, "Unused", NULL, "Unused", "Unused", INT_ARG, Float}, {ifunc_SNGL, "SNGL", "(float)", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Float}, {ifunc_DBLE, "DBLE", "(double)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Double}, {ifunc_CMPLX, "CMPLX", "(Complex)", NULL, "Unused", NULL, "Unused", "Unused", IRDC_ARGS, Complex}, {ifunc_ICHAR, "ICHAR", "(int)", NULL, "Unused", NULL, "Unused", "Unused", CS_ARGS, Integer}, {ifunc_CHAR, "CHAR", "(char)", NULL, "Unused", NULL, "Unused", "Unused", INT_ARG, Character}, /* Truncation */ {ifunc_AINT, "AINT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", RD_ARGS, Float}, {ifunc_DINT, "DINT", "(int)", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Double}, /* Nearest Whole Number - call NINT/IDNINT and then cast to Float/Double */ {ifunc_ANINT, "ANINT", "Util.nint", "StrictUtil.nint", UTIL_CLASS, STRICT_UTIL_CLASS, "nint", "(F)I", RD_ARGS, Float}, {ifunc_DNINT, "DNINT", "Util.idnint", "StrictUtil.idnint", UTIL_CLASS, STRICT_UTIL_CLASS, "idnint", "(D)I", DOUBLE_ARG, Double}, /* Nearest Integer */ {ifunc_NINT, "NINT", "Util.nint", "StrictUtil.nint", UTIL_CLASS, STRICT_UTIL_CLASS, "nint", "(F)I", RD_ARGS, Integer}, {ifunc_IDNINT, "IDNINT", "Util.idnint", "StrictUtil.idnint", UTIL_CLASS, STRICT_UTIL_CLASS, "idnint", "(D)I", DOUBLE_ARG, Integer}, /* Absolute Value */ {ifunc_ABS, "ABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(F)F", IRDC_ARGS, Double}, {ifunc_IABS, "IABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(I)I", INT_ARG, Integer}, {ifunc_DABS, "DABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(D)D", DOUBLE_ARG, Double}, {ifunc_CABS, "CABS", "Math.abs", "StrictMath.abs", "java/lang/Math", "java/lang/StrictMath", "abs", "(F)F", COMPLEX_ARG, Float}, /* Remaindering - directly supported in bytecode by irem, drem, etc */ {ifunc_MOD, "MOD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", IRD_ARGS, Integer}, {ifunc_AMOD, "AMOD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", REAL_ARG, Float}, {ifunc_DMOD, "DMOD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", DOUBLE_ARG, Double}, /* Transfer of Sign */ {ifunc_SIGN, "SIGN", "Util.sign", "StrictUtil.sign", UTIL_CLASS, STRICT_UTIL_CLASS, "sign", "(FF)F", IRD_ARGS, Float}, {ifunc_ISIGN, "ISIGN", "Util.isign", "StrictUtil.isign", UTIL_CLASS, STRICT_UTIL_CLASS, "isign", "(II)I", INT_ARG, Integer}, {ifunc_DSIGN, "DSIGN", "Util.dsign", "StrictUtil.dsign", UTIL_CLASS, STRICT_UTIL_CLASS, "dsign", "(DD)D", DOUBLE_ARG, Double}, /* Positive Difference */ {ifunc_DIM, "DIM", "Util.dim", "StrictUtil.dim", UTIL_CLASS, STRICT_UTIL_CLASS, "dim", "(FF)F", IRD_ARGS, Float}, {ifunc_IDIM, "IDIM", "Util.idim", "StrictUtil.idim", UTIL_CLASS, STRICT_UTIL_CLASS, "idim", "(II)I", INT_ARG, Integer}, {ifunc_DDIM, "DDIM", "Util.ddim", "StrictUtil.ddim", UTIL_CLASS, STRICT_UTIL_CLASS, "ddim", "(DD)D", DOUBLE_ARG, Double}, /* Double Precision Product of two reals. implement as (double)a1 * (double)a2 */ {ifunc_DPROD, "DPROD", "Unused", NULL, "Unused", NULL, "Unused", "Unused", REAL_ARG, Double}, /* Choosing Largest Value */ {ifunc_MAX, "MAX", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(DD)D", IRD_ARGS, Double}, {ifunc_MAX0, "MAX0", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(II)I", INT_ARG, Integer}, {ifunc_AMAX1, "AMAX1", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(FF)F", REAL_ARG, Float}, {ifunc_DMAX1, "DMAX1", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(DD)D", DOUBLE_ARG, Double}, {ifunc_AMAX0, "AMAX0", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(FF)F", INT_ARG, Float}, {ifunc_MAX1, "MAX1", "Math.max", "StrictMath.max", "java/lang/Math", "java/lang/StrictMath", "max", "(FF)F", REAL_ARG, Integer}, /* Choosing Smallest Value */ {ifunc_MIN, "MIN", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(DD)D", IRD_ARGS, Double}, {ifunc_MIN0, "MIN0", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(II)I", INT_ARG, Integer}, {ifunc_AMIN1, "AMIN1", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(FF)F", REAL_ARG, Float}, {ifunc_DMIN1, "DMIN1", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(DD)D", DOUBLE_ARG, Double}, {ifunc_AMIN0, "AMIN0", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(FF)F", INT_ARG, Float}, {ifunc_MIN1, "MIN1", "Math.min", "StrictMath.min", "java/lang/Math", "java/lang/StrictMath", "min", "(FF)F", REAL_ARG, Integer}, /* Length of Character Entity */ {ifunc_LEN, "LEN", "Unused", NULL, "Unused", NULL, "Unused", "Unused", CS_ARGS, Integer}, /* Location of Substring a2 in String a1 */ {ifunc_INDEX, "INDEX", "(int)", NULL, "Unused", NULL, "Unused", "Unused", CS_ARGS, Integer}, /* Imaginary Part of Complex Arg */ {ifunc_AIMAG, "AIMAG", "(int)", NULL, "Unused", NULL, "Unused", "Unused", COMPLEX_ARG, Float}, /* Conjuagate of Complex Argument */ {ifunc_CONJG, "CONJG", "(int)", NULL, "Unused", NULL, "Unused", "Unused", COMPLEX_ARG, Complex}, /* Sqare Root */ {ifunc_SQRT, "SQRT", "Math.sqrt", "StrictMath.sqrt", "java/lang/Math", "java/lang/StrictMath", "sqrt", "(F)F", RDC_ARGS, Double}, {ifunc_DSQRT, "DSQRT", "Math.sqrt", "StrictMath.sqrt", "java/lang/Math", "java/lang/StrictMath", "sqrt", "(D)D", DOUBLE_ARG, Double}, {ifunc_CSQRT, "CSQRT", "Math.sqrt", "StrictMath.sqrt", "java/lang/Math", "java/lang/StrictMath", "sqrt", "(D)D", COMPLEX_ARG, Complex}, /* Exponential */ {ifunc_EXP, "EXP", "Math.exp", "StrictMath.exp", "java/lang/Math", "java/lang/StrictMath", "exp", "(D)D", RDC_ARGS, Double}, {ifunc_DEXP, "DEXP", "Math.exp", "StrictMath.exp", "java/lang/Math", "java/lang/StrictMath", "exp", "(D)D", DOUBLE_ARG, Double}, {ifunc_CEXP, "CEXP", "Math.exp", "StrictMath.exp", "java/lang/Math", "java/lang/StrictMath", "exp", "(D)D", COMPLEX_ARG, Complex}, /* Natural Logarithm */ {ifunc_LOG, "LOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", RDC_ARGS, Double}, {ifunc_ALOG, "ALOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", REAL_ARG, Double}, {ifunc_DLOG, "DLOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", DOUBLE_ARG, Double}, {ifunc_CLOG, "CLOG", "Math.log", "StrictMath.log", "java/lang/Math", "java/lang/StrictMath", "log", "(D)D", COMPLEX_ARG, Complex}, /* Common Logarithm - use java's log function then divide by 2.30258509 */ {ifunc_LOG10, "LOG10", "Util.log10", "StrictUtil.log10", UTIL_CLASS, STRICT_UTIL_CLASS, "log10", "(D)D", RD_ARGS, Double}, {ifunc_ALOG10, "ALOG10", "Util.log10", "StrictUtil.log10", UTIL_CLASS, STRICT_UTIL_CLASS, "log10", "(D)D", REAL_ARG, Double}, {ifunc_DLOG10, "DLOG10", "Util.log10", "StrictUtil.log10", UTIL_CLASS, STRICT_UTIL_CLASS, "log10", "(D)D", DOUBLE_ARG, Double}, /* Sine */ {ifunc_SIN, "SIN", "Math.sin", "StrictMath.sin", "java/lang/Math", "java/lang/StrictMath", "sin", "(D)D", RDC_ARGS, Double}, {ifunc_DSIN, "DSIN", "Math.sin", "StrictMath.sin", "java/lang/Math", "java/lang/StrictMath", "sin", "(D)D", DOUBLE_ARG, Double}, {ifunc_CSIN, "CSIN", "Math.sin", "StrictMath.sin", "java/lang/Math", "java/lang/StrictMath", "sin", "(D)D", COMPLEX_ARG, Complex}, /* Cosine */ {ifunc_COS, "COS", "Math.cos", "StrictMath.cos", "java/lang/Math", "java/lang/StrictMath", "cos", "(D)D", RDC_ARGS, Double}, {ifunc_DCOS, "DCOS", "Math.cos", "StrictMath.cos", "java/lang/Math", "java/lang/StrictMath", "cos", "(D)D", DOUBLE_ARG, Double}, {ifunc_CCOS, "CCOS", "Math.cos", "StrictMath.cos", "java/lang/Math", "java/lang/StrictMath", "cos", "(D)D", COMPLEX_ARG, Complex}, /* Tangent */ {ifunc_TAN, "TAN", "Math.tan", "StrictMath.tan", "java/lang/Math", "java/lang/StrictMath", "tan", "(D)D", RD_ARGS, Double}, {ifunc_DTAN, "DTAN", "Math.tan", "StrictMath.tan", "java/lang/Math", "java/lang/StrictMath", "tan", "(D)D", DOUBLE_ARG, Double}, /* Arcsine */ {ifunc_ASIN, "ASIN", "Math.asin", "StrictMath.asin", "java/lang/Math", "java/lang/StrictMath", "asin", "(D)D", RD_ARGS, Double}, {ifunc_DASIN, "DASIN", "Math.asin", "StrictMath.asin", "java/lang/Math", "java/lang/StrictMath", "asin", "(D)D", DOUBLE_ARG, Double}, /* Arccosine */ {ifunc_ACOS, "ACOS", "Math.acos", "StrictMath.acos", "java/lang/Math", "java/lang/StrictMath", "acos", "(D)D", RD_ARGS, Double}, {ifunc_DACOS, "DACOS", "Math.acos", "StrictMath.acos", "java/lang/Math", "java/lang/StrictMath", "acos", "(D)D", DOUBLE_ARG, Double}, /* Arctangent */ {ifunc_ATAN, "ATAN", "Math.atan", "StrictMath.atan", "java/lang/Math", "java/lang/StrictMath", "atan", "(D)D", RD_ARGS, Double}, {ifunc_DATAN, "DATAN", "Math.atan", "StrictMath.atan", "java/lang/Math", "java/lang/StrictMath", "atan", "(D)D", DOUBLE_ARG, Double}, {ifunc_ATAN2, "ATAN2", "Math.atan2", "StrictMath.atan2", "java/lang/Math", "java/lang/StrictMath", "atan2", "(DD)D", RD_ARGS, Double}, {ifunc_DATAN2, "DATAN2", "Math.atan2", "StrictMath.atan2", "java/lang/Math", "java/lang/StrictMath", "atan2", "(DD)D", DOUBLE_ARG, Double}, /* Hyperbolic Sine */ {ifunc_SINH, "SINH", "Util.sinh", "StrictUtil.sinh", UTIL_CLASS, STRICT_UTIL_CLASS, "sinh", "(D)D", RD_ARGS, Double}, {ifunc_DSINH, "DSINH", "Util.sinh", "StrictUtil.sinh", UTIL_CLASS, STRICT_UTIL_CLASS, "sinh", "(D)D", DOUBLE_ARG, Double}, /* Hyperbolic Cosine */ {ifunc_COSH, "COSH", "Util.cosh", "StrictUtil.cosh", UTIL_CLASS, STRICT_UTIL_CLASS, "cosh", "(D)D", RD_ARGS, Double}, {ifunc_DCOSH, "DCOSH", "Util.cosh", "StrictUtil.cosh", UTIL_CLASS, STRICT_UTIL_CLASS, "cosh", "(D)D", DOUBLE_ARG, Double}, /* Hyperbolic Tangent */ {ifunc_TANH, "TANH", "Util.tanh", "StrictUtil.tanh", UTIL_CLASS, STRICT_UTIL_CLASS, "tanh", "(D)D", RD_ARGS, Double}, {ifunc_DTANH, "DTANH", "Util.tanh", "StrictUtil.tanh", UTIL_CLASS, STRICT_UTIL_CLASS, "tanh", "(D)D", DOUBLE_ARG, Double}, /* Lexically Greater than or Equal to */ {ifunc_LGE, "LGE", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical}, /* Lexically Greater than */ {ifunc_LGT, "LGT", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical}, /* Lexically Less than or Equal to */ {ifunc_LLE, "LLE", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical}, /* Lexically Less than */ {ifunc_LLT, "LLT", ".compareTo", NULL, "java/lang/String", NULL, "compareTo", "(Ljava/lang/String;)I", CS_ARGS, Logical}, /* fortran pseudo intrinsic */ {ifunc_ETIME, "ETIME", ".etime", NULL, ETIME_CLASS, NULL, "etime", "([FI)F", IRDC_ARGS, Float}, {ifunc_SECOND, "SECOND", ".second", NULL, SECOND_CLASS, NULL, "second", "()F", NO_ARG, Float}, /* Ends a scanning loop. See comment above. */ {0, NULL , NULL, NULL, NULL, NULL, NULL, NULL, 0, 0} }; /***************************************************************************** * Fortran intrinsics have "generic" versions which can take several data * * types. we search this list before generating code so that we know * * whether to set the return type based on the arguments. * *****************************************************************************/ char *generic_intrinsics[] = { "INT", "REAL", "DBLE", "CMPLX", "AINT", "ANINT", "NINT", "ABS", "MOD", "SIGN", "DIM", "MAX", "MIN", "SQRT", "EXP", "LOG", "LOG10", "SIN", "COS", "TAN", "ASIN", "ACOS", "ATAN", "ATAN2", "SINH", "COSH", "TANH", 0 }; /***************************************************************************** * This is a list of Java reserved words. If a variable in * * the Fortran source matches one of these words, it must be * * transformed before generating the Java source. * * * * This list comes from p. 181 of Java in a Nutshell (David * * Flanagan) so it should be fairly complete for Java versions * * 1.0.x. There will probably need to be some added to comply * * with versions 1.1.x. * *****************************************************************************/ char *java_reserved_words[] = { "abstract" , "boolean" , "break" , "byte" , "byvalue" , "cast" , "catch" , "char" , "class" , "const" , "default" , "do" , "double" , "else" , "extends" , "final" , "finally" , "float" , "for" , "future" , "goto" , "implements", "if" , "import" , "inner" , "int" , "interface" , "long" , "native" , "new" , "operator" , "outer" , "package" , "private" , "protected" , "rest" , "return" , "short" , "static" , "super" , "synchronized" , "this" , "throw" ,"transient" , "true" , "var" , "void" ,"volatile" , "while" , "null" , "continue" , "false" , "case" , "generic" ,"instanceof" , "public" , "switch" , "try" , 0 }; /***************************************************************************** * This is a list of the BLAS routines. When translating * * some code, we need to know whether to import the blas * * library or not. so we can use this list to determine * * whether a call is to a BLAS routine or not. * *****************************************************************************/ char *blas_routines[] = { "dasum", "daxpy", "dcopy", "ddot", "dgbmv", "dgemm", "dgemv", "dger", "dnrm2", "drot", "drotg", "dsbmv", "dscal", "dspmv", "dspr", "dspr2", "dswap", "dsymm", "dsymv", "dsyr", "dsyr2", "dsyr2k", "dsyrk", "dtbmv", "dtbsv", "dtpmv", "dtpsv", "dtrmm", "dtrmv", "dtrsm", "dtrsv", "idamax", 0 }; /* data types for f2java primitives: */ char *returnstring[MAX_RETURNS+1] = { "String", "String", "complex", "double", "float", "int", "boolean", "Object" }; /* Mapping between f2java data types and array data types.. used when */ /* issuing the newarray opcode: */ u2 jvm_array_type[MAX_RETURNS+1] = { JVM_T_UNUSED, JVM_T_UNUSED, JVM_T_DOUBLE, JVM_T_DOUBLE, JVM_T_FLOAT, JVM_T_INT, JVM_T_BOOLEAN, JVM_T_UNUSED }; /* The jvm_data_types array maps from the f2j data types to the Java Virtual */ /* Machine data types. */ enum jvm_data_type jvm_data_types[MAX_RETURNS+1] = { jvm_Object, /* String */ jvm_Object, /* Character */ jvm_Object, /* Complex */ jvm_Double, /* Double */ jvm_Float, /* Float */ jvm_Int, /* Integer */ jvm_Byte, /* Logical */ jvm_Object /* Object */ }; /* descriptors for the valueOf() method for the various wrapper classes. */ char * wrapper_valueOf_descriptor[MAX_RETURNS+1] = { "(Ljava/lang/Object;)Ljava/lang/String;", "(Ljava/lang/Object;)Ljava/lang/String;", "(Ljava/lang/String;)Ljava/lang/Double;", "(Ljava/lang/String;)Ljava/lang/Double;", "(Ljava/lang/String;)Ljava/lang/Float;", "(Ljava/lang/String;)Ljava/lang/Integer;", "(Ljava/lang/String;)Ljava/lang/Boolean;", "(Ljava/lang/Object;)Ljava/lang/Object;" /* invalid, but not used */ }; /* descriptors for java/lang/String's valueOf() methods */ char * string_valueOf_descriptor[MAX_RETURNS+1] = { "asdfjklasdfjkldjf", /* not used */ "asdfjklasdfjkldjf", /* not used */ "(D)Ljava/lang/String;", "(D)Ljava/lang/String;", "(F)Ljava/lang/String;", "(I)Ljava/lang/String;", "(Z)Ljava/lang/String;", "asdfjklasdfjkldjf" /* not used */ }; /* descriptors for the StringBuffer.append() methods */ char * append_descriptor[MAX_RETURNS+1] = { "(Ljava/lang/String;)Ljava/lang/StringBuffer;", "(Ljava/lang/String;)Ljava/lang/StringBuffer;", "(D)Ljava/lang/StringBuffer;", "(D)Ljava/lang/StringBuffer;", "(F)Ljava/lang/StringBuffer;", "(I)Ljava/lang/StringBuffer;", "(Z)Ljava/lang/StringBuffer;", "(Ljava/lang/Object;)Ljava/lang/StringBuffer;", }; /* descriptors for the numeric wrapper classes' toString() methods */ char * toString_descriptor[MAX_RETURNS+1] = { "()Ljava/lang/String;", "()Ljava/lang/String;", "(D)Ljava/lang/String;", "(D)Ljava/lang/String;", "(F)Ljava/lang/String;", "(I)Ljava/lang/String;", "(Z)Ljava/lang/String;", "()Ljava/lang/String;" }; /* descriptors of PrintStream's print() and println() methods */ char * println_descriptor[MAX_RETURNS+1] = { "(Ljava/lang/String;)V", "(Ljava/lang/String;)V", "(D)V", "(D)V", "(F)V", "(I)V", "(Z)V", "(Ljava/lang/Object;)V", }; /* descriptors of ArraySpec constructors */ char * array_spec_descriptor[MAX_RETURNS+1] = { "([Ljava/lang/String;II)V", "([Ljava/lang/String;II)V", "()V", /* not implemented */ "([DII)V", "([FII)V", "([III)V", "([ZII)V", "()V" /* not implemented */ }; /* table of numericValue methods (e.g. doubleValue(), intValue(), etc. * again, we do not expect to look up String data types in this table, * so those values may be invalid. */ char * numericValue_method[MAX_RETURNS+1] = { "toString", "toString", "doubleValue", "doubleValue", "floatValue", "intValue", "booleanValue", "toString" }; /* method descriptors corresponding to the above methods. */ char * numericValue_descriptor[MAX_RETURNS+1] = { "()Ljava/lang/String;", "()Ljava/lang/String;", "()D", "()D", "()F", "()I", "()Z", "()Ljava/lang/String;" }; #define JSTR "Ljava/lang/String;" #define JSTR_ARR "[Ljava/lang/String;" #define JOBJ "Ljava/lang/Object;" #define JOBJ_ARR "[Ljava/lang/Object;" /* you'll notice that both the 1D and 2D descriptors are both actually * declared 1D. if we want to implement 'real' 2D arrays, then this * matrix (and the following wrapped_field_descriptor) should be updated. */ char *field_descriptor[MAX_RETURNS+1][2] = { {JSTR, JSTR_ARR}, {JSTR, JSTR_ARR}, {"D", "[D"}, {"D", "[D"}, {"F", "[F"}, {"I", "[I"}, {"Z", "[Z"}, {JOBJ, JOBJ_ARR} }; char *wrapped_field_descriptor[MAX_RETURNS+1][2] = { {"Lorg/netlib/util/StringW;", "[Ljava/lang/String;"}, {"Lorg/netlib/util/StringW;", "[Ljava/lang/String;"}, {"Lorg/netlib/util/complexW;", "[Lorg/netlib/util/complexW;"}, {"Lorg/netlib/util/doubleW;", "[D"}, {"Lorg/netlib/util/floatW;", "[F"}, {"Lorg/netlib/util/intW;", "[I"}, {"Lorg/netlib/util/booleanW;", "[Z"}, {"Ljava/lang/Object;", "[Ljava/lang/Object;"} }; /* types for scalars passed by reference: */ char *wrapper_returns[MAX_RETURNS+1] = { "StringW", "StringW", "complexW", "doubleW", "floatW", "intW", "booleanW", "Object" }; /* fully qualified wrapper names: */ char *full_wrappername[MAX_RETURNS+1] = { "org/netlib/util/StringW", "org/netlib/util/StringW", "org/netlib/util/complexW", "org/netlib/util/doubleW", "org/netlib/util/floatW", "org/netlib/util/intW", "org/netlib/util/booleanW", "java/lang/Object" }; /* descriptors of the wrappers' .val fields */ char *val_descriptor[MAX_RETURNS+1] = { "Ljava/lang/String;", "Ljava/lang/String;", "D", "D", "F", "I", "Z", "Ljava/lang/Object;" }; /* names of the standard Java wrappers: */ char *java_wrapper[MAX_RETURNS+1] = { "String", "String", "Complex", "Double", "Float", "Integer", "Boolean", "Object" }; /* descriptors for the wrapper classes' constructors: */ char *wrapper_descriptor[MAX_RETURNS+1] = { "(Ljava/lang/String;)V", "(Ljava/lang/String;)V", "(Lorg/netlib/Complex;)V", "(D)V", "(F)V", "(I)V", "(Z)V", "(Ljava/lang/Object;)V", }; /* table of Java's wrapper classes. we only expect to use the numeric ones */ char * numeric_wrapper[MAX_RETURNS+1] = { "java/lang/String", "java/lang/String", "java/lang/Double", "java/lang/Double", "java/lang/Float", "java/lang/Integer", "java/lang/Boolean", "java/lang/Object" }; /* opcodes to push initial primitive values: */ enum _opcode init_opcodes[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_dconst_0, jvm_dconst_0, jvm_fconst_0, jvm_iconst_0, jvm_iconst_0, jvm_aconst_null }; /* opcodes to return a value from a function: */ enum _opcode return_opcodes[MAX_RETURNS+1] = { jvm_areturn, jvm_areturn, jvm_dreturn, jvm_dreturn, jvm_freturn, jvm_ireturn, jvm_ireturn, jvm_areturn }; /* initial values for above data types: */ char *init_vals[MAX_RETURNS+1] = { "\" \"", "\" \"", "0", "0.0d", "0.0f", "0", "false" }; /* descriptors for EasyIn's read methods */ char *input_descriptors[MAX_RETURNS+1] = { "(I)Ljava/lang/String;", "(I)Ljava/lang/String;", "Unimplemented", "()D", "()F", "()I", "()Z" }; /* input functions to read various data types: */ char *input_func[MAX_RETURNS+1] = { "readChars", "readChars", "readComplex", "readDouble", "readFloat", "readInt", "readBoolean" }; /* input functions that detect EOF: */ char *input_func_eof[MAX_RETURNS+1] = { "readchars", "readchars", "readcomplex", "readdouble", "readfloat", "readint", "readboolean" }; /* addition opcodes, indexed by vartype: */ enum _opcode add_opcode[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_nop, jvm_dadd, jvm_fadd, jvm_iadd, jvm_nop }; /* subtraction opcodes, indexed by vartype: */ enum _opcode sub_opcode[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_nop, jvm_dsub, jvm_fsub, jvm_isub, jvm_nop }; /* division opcodes, indexed by vartype: */ enum _opcode div_opcode[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_nop, jvm_ddiv, jvm_fdiv, jvm_idiv, jvm_nop }; /* multiplication opcodes, indexed by vartype: */ enum _opcode mul_opcode[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_nop, jvm_dmul, jvm_fmul, jvm_imul, jvm_nop }; /* negation opcodes, indexed by vartype: */ enum _opcode neg_opcode[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_nop, jvm_dneg, jvm_fneg, jvm_ineg, jvm_nop }; /* integer comparison opcodes, indexed by vartype. * * first entry is unused because enum _relop starts at 1 */ enum _opcode icmp_opcode[] = { jvm_nop, jvm_if_icmpeq, jvm_if_icmpne, jvm_if_icmplt, jvm_if_icmple, jvm_if_icmpgt, jvm_if_icmpge, jvm_if_icmpge }; /* comparison ops for relational expressions. note that the logic is * reversed.. that is, this array is indexed by the relops, but each entry * contains the reverse relop (e.g. .lt. -> ifgt) except for .eq. and .ne. * first entry is unused because enum _relop starts at 1 */ enum _opcode dcmp_opcode[] = { jvm_nop, jvm_ifeq, jvm_ifne, jvm_iflt, jvm_ifle, jvm_ifgt, jvm_ifge }; /* * Comparison ops for floating point. I'm adding this to support * code gen for "Arithmetic IF" statements, which is already split * into integer and non-integer cases, so here I only put the single * and double versions. */ enum _opcode cmpg_opcode[MAX_RETURNS+1] = { jvm_nop, jvm_nop, jvm_nop, jvm_dcmpg, jvm_fcmpg, jvm_nop, jvm_nop }; /* The following is a table of type conversion opcodes. to find the * appropriate opcode for the conversion, go to the row of the type to * convert FROM and scan across to the column of the type to convert TO. * most of these entries are blank (NOP) because type promotion does not * apply to strings, booleans, etc. note: most of these are nop because * we dont intend to encounter such conversions (or they are unsupported). */ enum _opcode typeconv_matrix[MAX_RETURNS+1][MAX_RETURNS+1] = { /* char |string |complex|double |float |integer|logical|obj */ /* char */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop}, /* string */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop}, /* complex */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop}, /* double */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_d2f,jvm_d2i,jvm_nop,jvm_nop}, /* float */ {jvm_nop,jvm_nop,jvm_nop,jvm_f2d,jvm_nop,jvm_f2i,jvm_nop,jvm_nop}, /* integer */ {jvm_nop,jvm_nop,jvm_nop,jvm_i2d,jvm_i2f,jvm_nop,jvm_nop,jvm_nop}, /* logical */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop}, /* object */ {jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop,jvm_nop} }; f2j-0.8.1/src/initialize.h0000600000077700002310000000325711031241064015353 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/initialize.h,v $ * $Revision: 1.31 $ * $Date: 2007/07/30 20:52:25 $ * $Author: keithseymour $ */ #ifndef _INITIALIZE_H #define _INITIALIZE_H /***************************************************************************** * initialize.h * * * * Header file containing initialization of f2java's translation tables. * * See globals.c for more detailed descriptions of each table. * * * *****************************************************************************/ #include #include #include"f2j.h" #include"y.tab.h" extern KWDTAB tab_stmt[]; /* statement starting keywords */ extern KWDTAB tab_type[]; /* TYPE tokens */ extern KWDTAB tab_toks[]; /* misc tokens */ extern KWDTAB read_toks[]; /* tokens found in read stmts */ extern KWDTAB open_toks[]; /* tokens found in open stmts */ extern KWDTAB assign_toks[]; /* tokens found in ASSIGN stmts */ extern METHODTAB intrinsic_toks[]; /* fortran intrinsic functions */ extern char *generic_intrinsics[]; /* table of 'generic' intrinsics */ extern char *java_reserved_words[]; /* list of Java reserved words */ extern char *blas_routines[]; /* list of the routines in BLAS */ extern enum returntype default_implicit_table[]; /* letters -> data types */ #endif f2j-0.8.1/src/opcodes.h0000600000077700002310000001100311031241064014632 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/opcodes.h,v $ * $Revision: 1.13 $ * $Date: 2007/04/19 20:25:49 $ * $Author: keithseymour $ */ /***************************************************************************** * opcodes.h * * * * Definitions of opcodes related to code generation. * * * *****************************************************************************/ #ifndef _OPCODES_H #define _OPCODES_H /***************************************************************************** * MAX_RETURNS is the number of data types. * * OBJECT_TYPE identifies the type 'Object'. * *****************************************************************************/ #define OBJECT_TYPE 7 #define MAX_RETURNS 7 #define JSTR "Ljava/lang/String;" #define JSTR_ARR "[Ljava/lang/String;" #define JOBJ "Ljava/lang/Object;" #define JOBJ_ARR "[Ljava/lang/Object;" /* data types for f2java primitives: */ extern char *returnstring[MAX_RETURNS+1]; /* Mapping between f2java data types and array data types.. */ extern u2 jvm_array_type[MAX_RETURNS+1]; /* descriptors for the valueOf() method for the various wrapper classes. */ extern char * wrapper_valueOf_descriptor[MAX_RETURNS+1]; /* descriptors for java/lang/String's valueOf() methods */ extern char * string_valueOf_descriptor[MAX_RETURNS+1]; /* descriptors for the StringBuffer.append() methods */ extern char * append_descriptor[MAX_RETURNS+1]; /* descriptors for the numeric wrapper classes' toString() methods */ extern char * toString_descriptor[MAX_RETURNS+1]; /* descriptors for the ArraySpec class */ char * array_spec_descriptor[MAX_RETURNS+1]; /* descriptors of PrintStream's print() and println() methods */ extern char * println_descriptor[MAX_RETURNS+1]; /* table of numericValue methods (e.g. doubleValue(), intValue(), etc. */ extern char * numericValue_method[MAX_RETURNS+1]; /* method descriptors corresponding to the above methods. */ extern char * numericValue_descriptor[MAX_RETURNS+1]; extern char *field_descriptor[MAX_RETURNS+1][2]; extern char *wrapped_field_descriptor[MAX_RETURNS+1][2]; /* types for scalars passed by reference: */ extern char *wrapper_returns[MAX_RETURNS+1]; /* fully qualified wrapper names: */ extern char *full_wrappername[MAX_RETURNS+1]; /* descriptors of the wrappers' .val fields */ extern char *val_descriptor[MAX_RETURNS+1]; /* descriptors for the wrapper classes' constructors: */ extern char *wrapper_descriptor[MAX_RETURNS+1]; /* names of the standard Java wrappers: */ extern char *java_wrapper[MAX_RETURNS+1]; /* opcodes to push initial primitive values: */ extern enum _opcode init_opcodes[MAX_RETURNS+1]; /* opcodes to return a value from a function: */ extern enum _opcode return_opcodes[MAX_RETURNS+1]; /* initial values for above data types: */ extern char *init_vals[MAX_RETURNS+1]; /* descriptors for EasyIn's read methods */ extern char *input_descriptors[MAX_RETURNS+1]; /* input functions to read various data types: */ extern char *input_func[MAX_RETURNS+1]; /* input functions that detect EOF: */ extern char *input_func_eof[MAX_RETURNS+1]; /* addition opcodes, indexed by vartype: */ extern enum _opcode add_opcode[MAX_RETURNS+1]; /* subtraction opcodes, indexed by vartype: */ extern enum _opcode sub_opcode[MAX_RETURNS+1]; /* division opcodes, indexed by vartype: */ extern enum _opcode div_opcode[MAX_RETURNS+1]; /* multiplication opcodes, indexed by vartype: */ extern enum _opcode mul_opcode[MAX_RETURNS+1]; /* negation opcodes, indexed by vartype: */ extern enum _opcode neg_opcode[MAX_RETURNS+1]; /* integer comparison opcodes, indexed by vartype. */ extern enum _opcode icmp_opcode[]; /* comparison ops for relational expressions. */ extern enum _opcode dcmp_opcode[]; /* comparison ops for floating point comparison. */ extern enum _opcode cmpg_opcode[]; /* The following is a table of type conversion opcodes. */ extern enum _opcode typeconv_matrix[MAX_RETURNS+1][MAX_RETURNS+1]; /* mapping of f2j data types to jvm data types. */ extern enum jvm_data_type jvm_data_types[MAX_RETURNS+1]; /* table of Java's wrapper classes. we only expect to use the numeric ones */ extern char * numeric_wrapper[MAX_RETURNS+1]; #endif f2j-0.8.1/src/optimize.c0000600000077700002310000014030711031241064015043 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/optimize.c,v $ * $Revision: 1.57 $ * $Date: 2007/04/10 04:48:57 $ * $Author: keithseymour $ */ /***************************************************************************** * optimize.c * * * * Determines which scalars really need to be wrapped in objects * * for emulation of pass-by-reference. For the most part, this file * * mimics codegen.c since we must traverse the AST in the same way * * for both operations. * * * * Basically, all we're doing here is trying to determine which variables * * are modified within this function (and functions called from this one). * * So, we are looking for three cases: * * * * 1. the variable is an argument to this function and it is on the LHS * * of an assignment * * 2. the variable is an argument to this function and it is an argument * * to a READ statement * * 3. the variable is passed to a function/subroutine that modifies it * * * * If any of the three cases are met, we classify the variable as a * * 'pass by reference' variable, meaning that it must be wrapped in an * * object. * * * *****************************************************************************/ #include #include #include #include #include"f2j.h" #include"codegen.h" #include"f2jmem.h" #include"f2j_externs.h" /***************************************************************************** * Set optdebug to TRUE to get debugging output from the optimization * * routines. * *****************************************************************************/ int optdebug = FALSE; char *unit_name; /* name of this function/subroutine */ /***************************************************************************** * Function prototypes: * *****************************************************************************/ char * lowercase ( char * ); METHODTAB * methodscan (METHODTAB * , char * ); void external_optimize(AST *, AST *), expr_optimize (AST *, AST *), args_optimize(AST *, AST *), optimize (AST *, AST *), optScalar(AST *), assign_optimize(AST *, AST*), call_optimize(AST *, AST*), forloop_optimize(AST *, AST*), blockif_optimize(AST *, AST*), elseif_optimize(AST *, AST*), else_optimize(AST *, AST*), logicalif_optimize(AST *, AST*), read_optimize(AST *, AST*), write_optimize(AST *, AST*), spec_optimize(AST *, AST*), read_implied_loop_optimize(AST *, AST *), name_optimize (AST *, AST *), subcall_optimize(AST *, AST *), while_optimize(AST *, AST *), set_passByRef(AST *, AST *); extern METHODTAB intrinsic_toks[]; /***************************************************************************** * * * optScalar * * * * This is the main entry point for the optimization routines. Here we look * * up the current function name to determine whether it has been optimized * * yet. If so, skip it - otherwise, optimize. * * * *****************************************************************************/ void optScalar(AST *root) { AST *temp; HASHNODE *ht; SYMTABLE *opt_type_table = root->astnode.source.type_table; SYMTABLE *opt_common_table = root->astnode.source.common_table; SYMTABLE *opt_external_table = root->astnode.source.external_table; /* look up this function name */ ht = type_lookup(global_func_table, root->astnode.source.progtype->astnode.source.name->astnode.ident.name); if(!ht) { fprintf(stderr,"optScalar: Cant find %s in global function table\n", root->astnode.source.progtype->astnode.source.name->astnode.ident.name); return; } if(optdebug) { printf("attempting to optimize %s\n", root->astnode.source.progtype->astnode.source.name->astnode.ident.name); if(ht->variable->astnode.source.scalarOptStatus == NOT_VISITED) printf("%s has not been visited yet\n", root->astnode.source.progtype->astnode.source.name->astnode.ident.name); else if(ht->variable->astnode.source.scalarOptStatus == VISITED) printf("%s has been visited but not finished\n", root->astnode.source.progtype->astnode.source.name->astnode.ident.name); else if(ht->variable->astnode.source.scalarOptStatus == FINISHED) printf("%s has been finished\n", root->astnode.source.progtype->astnode.source.name->astnode.ident.name); else printf("%s has an invalid status field\n", root->astnode.source.progtype->astnode.source.name->astnode.ident.name); } /* if this function hasn't been visited yet, set the status to 'VISITED' * and start optimizing it. */ if(ht->variable->astnode.source.scalarOptStatus == NOT_VISITED) { ht->variable->astnode.source.scalarOptStatus = VISITED; optimize(root, root); } /* afterwards, make sure the status is set to 'FINISHED' */ ht->variable->astnode.source.scalarOptStatus = FINISHED; /* for each argument in the function, set its passByRef field from * the values in the symbol table. This saves some time later on * when we want to know which arguments are pass by reference and * which aren't. we wont have to do symbol table lookups - just * loop through each arg in the function. */ temp = root->astnode.source.progtype->astnode.source.args; for(;temp != NULL;temp = temp->nextstmt) if((ht = type_lookup(opt_type_table,temp->astnode.ident.name)) != NULL) if(ht->variable->astnode.ident.passByRef) temp->astnode.ident.passByRef = TRUE; ht = type_lookup(function_table, root->astnode.source.progtype->astnode.source.name->astnode.ident.name); if(ht) { if(ht->variable->astnode.source.descriptor) f2jfree(ht->variable->astnode.source.descriptor, strlen(ht->variable->astnode.source.descriptor)+1); ht->variable->astnode.source.descriptor = get_method_descriptor(root->astnode.source.progtype, opt_type_table, opt_common_table, opt_external_table); } } /***************************************************************************** * * * optimize * * * * This is the main optimization routine. It just determines what kind of * * node we're looking at and calls the appropriate function to handle it. * * * *****************************************************************************/ void optimize (AST * root, AST * rptr) { switch (root->nodetype) { case 0: if (optdebug) fprintf (stderr,"Bad node\n"); optimize (root->nextstmt, rptr); break; case Progunit: if (optdebug) printf ("Source.\n"); optimize(root->astnode.source.typedecs, rptr); optimize(root->astnode.source.progtype, rptr); optimize(root->astnode.source.statements, rptr); break; case Subroutine: case Function: case Program: unit_name = root->astnode.source.name->astnode.ident.name; if (optdebug) printf ("Unit name: %s\n", root->astnode.source.name->astnode.ident.name); break; case Assignment: if (optdebug) printf ("Assignment.\n"); assign_optimize (root, rptr); if (root->nextstmt != NULL) optimize (root->nextstmt, rptr); break; case Call: if (optdebug) printf ("Call.\n"); call_optimize (root, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Forloop: if (optdebug) printf ("Forloop.\n"); forloop_optimize (root, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Blockif: if (optdebug) printf ("Blockif.\n"); blockif_optimize (root, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Elseif: if (optdebug) printf ("Elseif.\n"); elseif_optimize (root, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Else: if (optdebug) printf ("Else.\n"); else_optimize (root, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Logicalif: if (optdebug) printf ("Logicalif.\n"); logicalif_optimize (root, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Arithmeticif: if (optdebug) printf ("ArithmeticIf.\n"); if (root->astnode.arithmeticif.cond != NULL) expr_optimize (root->astnode.arithmeticif.cond, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Label: if (optdebug) printf ("Label.\n"); if((root->astnode.label.stmt != NULL) && (root->astnode.label.stmt->nodetype != Format)) optimize(root->astnode.label.stmt, rptr); if (root->nextstmt != NULL) /* End of typestmt list. */ optimize (root->nextstmt, rptr); break; case Write: if (optdebug) printf ("Write statement.\n"); write_optimize(root, rptr); if (root->nextstmt != NULL) optimize (root->nextstmt, rptr); break; case Read: if (optdebug) printf ("Read statement.\n"); read_optimize (root, rptr); if (root->nextstmt != NULL) optimize (root->nextstmt, rptr); break; case StmtLabelAssign: if (optdebug) printf ("StmtLabelAssign.\n"); assign_optimize (root, rptr); if (root->nextstmt != NULL) optimize (root->nextstmt, rptr); break; case Format: case Stop: case Pause: case Save: case CommonList: case ComputedGoto: case AssignedGoto: case Dimension: case Goto: case Return: case Statement: case Comment: case MainComment: case DataList: case Equivalence: case Typedec: case Unimplemented: if (root->nextstmt != NULL) optimize (root->nextstmt, rptr); break; case Specification: spec_optimize(root, rptr); if (root->nextstmt != NULL) optimize (root->nextstmt, rptr); break; case End: break; case Constant: default: fprintf(stderr,"optimize(): Error, bad nodetype (%s)\n", print_nodetype(root)); } /* switch on nodetype. */ } /***************************************************************************** * * * spec_optimize * * * * The only Specification we really care about here is the EXTERNAL * * declaration. For each function declared external, we attempt to * * optimize that function. This way we can be assured that when we're * * optimizing the executable code for this function, we already know * * which args to each function must be passed by reference. * * * *****************************************************************************/ void spec_optimize(AST *root, AST *rptr) { SYMTABLE *opt_external_table = rptr->astnode.source.external_table; AST *temp; HASHNODE *ht; switch (root->astnode.typeunit.specification) { case Parameter: case Implicit: break; case Intrinsic: /* name_optimize will ignore Intrinsics */ name_optimize (root,rptr); break; case External: temp = root->astnode.typeunit.declist; for(;temp != NULL;temp = temp->nextstmt) { if(optdebug) printf("external %s\n", temp->astnode.ident.name); if(type_lookup(opt_external_table,temp->astnode.ident.name)) { if(optdebug) printf("going to optimize external %s\n",temp->astnode.ident.name); ht = type_lookup(global_func_table,temp->astnode.ident.name); if(!ht) continue; optScalar(ht->variable); } } break; } } /***************************************************************************** * * * external_optimize * * * * This function is called when we're looking at a name that is declared * * EXTERNAL. Normally, this corresponds to a function/subroutine call. * * * *****************************************************************************/ void external_optimize(AST *root, AST *rptr) { char *tempname; if(optdebug) { printf("here we are in external_optimize\n"); printf("nodetype = %s, parent nodetype = %s\n", print_nodetype(root),print_nodetype(root->parent)); } tempname = strdup(root->astnode.ident.name); uppercase(tempname); /* * This block of code is only called if the identifier * absolutely does not have an entry in any table, * and corresponds to a method invocation of * something in the blas or lapack packages. */ if (methodscan(intrinsic_toks,tempname) == NULL) { if (root->astnode.ident.arraylist != NULL) call_optimize (root, rptr); f2jfree(tempname, strlen(tempname)+1); return; } f2jfree(tempname, strlen(tempname)+1); } /***************************************************************************** * * * name_optimize * * * * Surprisingly, we dont do much here in name_optimze. If the name looks * * like an EXTERNAL, call external_optimize. If it looks like a call of * * some sort, but we didn't find it in the external or intrinsic tables, * * call subcall_optimize. * * * *****************************************************************************/ void name_optimize (AST * root, AST *rptr) { HASHNODE *hashtemp; char * tempname; SYMTABLE *opt_external_table = rptr->astnode.source.external_table; SYMTABLE *opt_intrinsic_table = rptr->astnode.source.intrinsic_table; SYMTABLE *opt_type_table = rptr->astnode.source.type_table; SYMTABLE *opt_array_table = rptr->astnode.source.array_table; if(optdebug) { printf("here in name_optimize... %s\n",print_nodetype(root)); if(root->nodetype == Identifier) printf("name is %s\n",root->astnode.ident.name); } /* * Check to see whether name is in external table. Names are * loaded into the external table from the parser. */ tempname = strdup(root->astnode.ident.name); uppercase(tempname); hashtemp = type_lookup (opt_array_table, root->astnode.ident.name); if(root->astnode.ident.arraylist == NULL){ return; } else if(hashtemp){ return; } /* * If the name is in the external table, then check to see if * it is an intrinsic function instead (e.g. SQRT, ABS, etc). */ hashtemp = type_lookup (global_func_table, root->astnode.ident.name); if ((hashtemp != NULL)||(type_lookup(opt_external_table, root->astnode.ident.name)) ||(find_method(root->astnode.ident.name, descriptor_table))) { if(hashtemp){ optScalar(hashtemp->variable); if(optdebug) printf("going to external_optimize\n"); } external_optimize(root, rptr); } else if(( methodscan (intrinsic_toks, tempname) != NULL) && ( (type_lookup(opt_intrinsic_table, root->astnode.ident.name) != NULL) || (type_lookup(opt_type_table, root->astnode.ident.name) == NULL))) { if(optdebug) printf("looks like an intrinsic\n"); } else switch (root->token) { case STRING: case CHAR: case INTRINSIC: /* do nothing */ break; case NAME: default: if(optdebug) printf("going to subcall_optimize\n"); subcall_optimize(root, rptr); break; } f2jfree(tempname, strlen(tempname) +1); } /***************************************************************************** * * * subcall_optimize * * * * This function optimizes a function call. I think this function * * is only called in cases where the function or subroutine is * * not declared external or intrinsic and we dont know what * * else to do with it. in that case, we may not have visited the * * function yet, so we do that if necessary. * * * *****************************************************************************/ void subcall_optimize(AST *root, AST *rptr) { AST *temp; char *tempstr; tempstr = strdup (root->astnode.ident.name); *tempstr = toupper (*tempstr); temp = root->astnode.ident.arraylist; if(temp->nodetype != EmptyArgList) args_optimize(root,rptr); /* for (; temp != NULL; temp = temp->nextstmt) { if (*temp->astnode.ident.name != '*') expr_optimize (temp, rptr); } */ } /***************************************************************************** * * * expr_optimize * * * * All this will do is optimize an expression. * * Needs to be extended for arrays, etc. Consider using * * a switch/case structure for this. * * * *****************************************************************************/ void expr_optimize (AST * root, AST *rptr) { if(root == NULL) { fprintf(stderr,"Warning: NULL root in expr_optimize\n"); return; } switch (root->nodetype) { case Identifier: name_optimize (root, rptr); break; case Unaryop: expr_optimize (root->astnode.expression.rhs, rptr); break; case Constant: /* * here we need to determine if this is a parameter to a function * or subroutine. if so, and we are using wrappers, then we need * to create a temporary wrapper and pass that in instead of the * constant. 10/9/97 -- Keith */ /* * if(root->parent != NULL) * { * tempname = strdup(root->parent->astnode.ident.name); * uppercase(tempname); * } */ break; case Expression: case Logicalop: if (root->astnode.expression.lhs != NULL) expr_optimize (root->astnode.expression.lhs, rptr); expr_optimize (root->astnode.expression.rhs, rptr); break; case Power: case Binaryop: case Relationalop: expr_optimize (root->astnode.expression.lhs, rptr); expr_optimize (root->astnode.expression.rhs, rptr); break; case Substring: if(root->astnode.ident.startDim[0]) expr_optimize(root->astnode.ident.startDim[0], rptr); if(root->astnode.ident.endDim[0]) expr_optimize(root->astnode.ident.endDim[0], rptr); if(root->astnode.ident.startDim[1]) expr_optimize(root->astnode.ident.startDim[1], rptr); break; default: fprintf(stderr,"Warning: Unknown nodetype in expr_optimize(): %s\n", print_nodetype(root)); } } /***************************************************************************** * * * forloop_optimize * * * * This function traverses forloops. Nothing much happens here. * * * *****************************************************************************/ void forloop_optimize (AST * root, AST *rptr) { /* * char *indexname; * int *tmp_int; * * tmp_int = (int*)f2jalloc(sizeof(int)); * * *tmp_int = atoi(root->astnode.forloop.Label->astnode.constant.number); */ /* * Some point I will need to test whether this is really a name * because it will crash if not. * * indexname = * root->astnode.forloop.start->astnode.assignment.lhs->astnode.ident.name; */ if(root->astnode.forloop.incr != NULL) expr_optimize (root->astnode.forloop.incr, rptr); assign_optimize (root->astnode.forloop.start, rptr); if(root->astnode.forloop.incr == NULL) { name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr); expr_optimize (root->astnode.forloop.stop, rptr); name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr); } else { name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr); expr_optimize (root->astnode.forloop.stop, rptr); name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr); expr_optimize (root->astnode.forloop.stop, rptr); name_optimize(root->astnode.forloop.start->astnode.assignment.lhs, rptr); } } /***************************************************************************** * * * logicalif_optimize * * * * Optimize a logical if statement. * * * *****************************************************************************/ void logicalif_optimize (AST * root, AST *rptr) { if (root->astnode.logicalif.conds != NULL) expr_optimize (root->astnode.logicalif.conds, rptr); optimize (root->astnode.logicalif.stmts, rptr); } /***************************************************************************** * * * write_optimize * * * * Optimize a WRITE statement. * * * *****************************************************************************/ void write_optimize (AST * root, AST *rptr) { AST *temp; for(temp = root->astnode.io_stmt.arg_list; temp!=NULL;temp=temp->nextstmt) if(temp->nodetype != IoImpliedLoop) expr_optimize(temp, rptr); } /***************************************************************************** * * * read_optimize * * * * Optimize a READ statement. Here we examine each argument of the READ * * statement to determine whether it's an argument to the current function. * * If so, we must mark it as pass by reference. * * *****************************************************************************/ void read_optimize (AST * root, AST *rptr) { SYMTABLE *opt_args_table = rptr->astnode.source.args_table; SYMTABLE *opt_type_table = rptr->astnode.source.type_table; SYMTABLE *opt_common_table = rptr->astnode.source.common_table; SYMTABLE *opt_array_table = rptr->astnode.source.array_table; HASHNODE *ht; AST *temp; if(root->astnode.io_stmt.arg_list == NULL) { return; } /* for each arg... */ for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) { if(temp->nodetype == IoImpliedLoop) read_implied_loop_optimize(temp, rptr); else if(temp->nodetype == Identifier) { name_optimize(temp, rptr); ht = type_lookup(opt_type_table,temp->astnode.ident.name); if(ht) { if((type_lookup(opt_args_table, temp->astnode.ident.name) != NULL) && (type_lookup(opt_common_table, temp->astnode.ident.name) == NULL) && (type_lookup(opt_array_table, temp->astnode.ident.name) == NULL)) ht->variable->astnode.ident.passByRef = TRUE; } } else { fprintf(stderr,"Read list must consist of idents or implied loops\n"); fprintf(stderr," nodetype is %s\n", print_nodetype(temp)); continue; } } } /***************************************************************************** * * * read_implied_loop_optimize * * * * We're looking at an implied loop in a READ statement. The only time we * * care about arrays being 'pass by reference' is when we're generating * * the front-end inteerface. In that case, we use the passByRef field * * to determine which arrays must be copied back after the call. * * * *****************************************************************************/ void read_implied_loop_optimize(AST *node, AST *rptr) { AST *temp; /* NOTE: we need to set the passByRef field of the array somewhere in here */ expr_optimize(node->astnode.forloop.start, rptr); expr_optimize(node->astnode.forloop.stop, rptr); if(node->astnode.forloop.incr != NULL) expr_optimize(node->astnode.forloop.incr, rptr); for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt) { if(temp->nodetype != Identifier) { fprintf(stderr,"Cant handle this nodetype (%s) ", print_nodetype(temp)); fprintf(stderr," in implied loop (read stmt)\n"); } else { name_optimize(temp, rptr); } } } /***************************************************************************** * * * blockif_optimize * * * * Here we have a block IF statement. We should optimize the expression * * and the statements. * * *****************************************************************************/ void blockif_optimize (AST * root, AST *rptr) { AST *prev = root->prevstmt; AST *temp; /* int *tmp_int; */ /* This function could probably be simplified by getting rid of all the * while detection code. It isn't really necessary here. */ /* tmp_int = (int*)f2jalloc(sizeof(int)); */ /* if the previous node was a label, this could be a simulated * while loop. */ if(prev != NULL) if(prev->nodetype == Label) { /* *tmp_int = root->prevstmt->astnode.label.number; */ if(prev->astnode.label.stmt == NULL) if((root->astnode.blockif.elseifstmts == NULL) && (root->astnode.blockif.elsestmts == NULL)) { /* it appears that we are looking at a simulated while loop. * bypass all the statements in the body of this if block * and look at the last one. if it is a goto and the * target is the label of the current if statement, then * we generate a Java while loop. otherwise, we generate * an if statement. */ for ( temp=root->astnode.blockif.stmts; temp->nextstmt!=NULL; temp = temp->nextstmt ) ; /* do nothing */ if(temp->nodetype == Goto) if(temp->astnode.go_to.label == prev->astnode.label.number) { while_optimize(root, rptr); return; } } } if (root->astnode.blockif.conds != NULL) expr_optimize (root->astnode.blockif.conds, rptr); if (root->astnode.blockif.stmts != NULL) optimize (root->astnode.blockif.stmts, rptr); for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt) elseif_optimize (temp, rptr); if (root->astnode.blockif.elsestmts != NULL) else_optimize (root->astnode.blockif.elsestmts, rptr); } /***************************************************************************** * * * while_optimize * * * * while_optimize() is called when an if statement has been identified * * as a simulated while loop. This could probably be inlined into the * * block if routine. * * * *****************************************************************************/ void while_optimize(AST *root, AST *rptr) { if (root->astnode.blockif.conds != NULL) expr_optimize (root->astnode.blockif.conds, rptr); optimize (root->astnode.blockif.stmts, rptr); } /***************************************************************************** * * * elseif_optimize * * * * Nothing special here. we examine the elseif portion of a block if. * * * *****************************************************************************/ void elseif_optimize (AST * root, AST *rptr) { if (root->astnode.blockif.conds != NULL) expr_optimize (root->astnode.blockif.conds, rptr); optimize (root->astnode.blockif.stmts, rptr); } /***************************************************************************** * * * else_optimize * * * * Here we examine the else portion of a block if. * * * *****************************************************************************/ void else_optimize (AST * root, AST *rptr) { optimize (root->astnode.blockif.stmts, rptr); } /***************************************************************************** * * * call_optimize * * * * Handles external calls. What we really want to know is whether any of * * the arguments to the function we're calling are passed by reference. * * If so, we must wrap the corresponding variable in this function. * * * *****************************************************************************/ void call_optimize (AST * root, AST *rptr) { SYMTABLE *opt_args_table = rptr->astnode.source.args_table; AST *temp; HASHNODE *hashtemp; if(optdebug) printf("enter call_optimize\n"); assert (root != NULL); /* If this function was passed in as an argument, we call an * 'adapter' which performs the reflective method invocation.. */ if(root->astnode.ident.arraylist->nodetype == EmptyArgList){ hashtemp = type_lookup(global_func_table, root->astnode.ident.name); if(hashtemp) optScalar(hashtemp->variable); return; } if(type_lookup(opt_args_table, root->astnode.ident.name)) { /* if this function has no args, we can simplify the calling * process by not creating an argument array or calling a * method adapter. */ if((root->astnode.ident.arraylist->nodetype == EmptyArgList) || (root->astnode.ident.arraylist == NULL)) { /* no args. either function or subroutine. */ return; } else if (root->nodetype == Call) { /* subroutine with args. */ for( temp = root->astnode.ident.arraylist; temp; temp = temp->nextstmt) expr_optimize (temp, rptr); return; } } if(root->astnode.ident.arraylist->nodetype == EmptyArgList) return; /* look up the function name so that we may compare the parameters */ if(optdebug) printf("looking up %s in the global func table\n",root->astnode.ident.name); args_optimize(root, rptr); } /***************************************************************************** * * * args_optimize * * * * this function handles the args to a function/subroutine call. If the * * arguments to the function we're calling are passed by reference, then * * we must wrap the corresponding variable in this function. * * * *****************************************************************************/ void args_optimize(AST *root, AST *rptr) { SYMTABLE *opt_array_table = rptr->astnode.source.array_table; HASHNODE *hashtemp; JVM_METHODREF *mref; AST *temp; if((hashtemp=type_lookup(global_func_table,root->astnode.ident.name))!=NULL) { AST *t2; if(optdebug) printf("call_optimize(): found %s in global function table.\n", root->astnode.ident.name); if(hashtemp->variable->astnode.source.scalarOptStatus == NOT_VISITED) optScalar(hashtemp->variable); temp = root->astnode.ident.arraylist; t2=hashtemp->variable->astnode.source.progtype->astnode.source.args; for( ; temp != NULL; temp = temp->nextstmt) { expr_optimize(temp, rptr); if(temp->nodetype == Identifier) { /* now we check whether the function/subroutine expects this * to be passed by reference. */ if(t2->astnode.ident.passByRef) { if(optdebug) printf("call_optimize(): '%s' is pass by ref.\n", temp->astnode.ident.name); if((!temp->astnode.ident.arraylist) && !type_lookup(opt_array_table, temp->astnode.ident.name)) set_passByRef(temp, rptr); } else { if(optdebug) printf("call_optimize(): '%s' is NOT pass by ref.\n", temp->astnode.ident.name); } } /* if the function/subroutine expects an array, but * the arg is a scalar, then pass by reference. */ if( !type_lookup(opt_array_table,temp->astnode.ident.name) && t2->astnode.ident.arraylist ) { set_passByRef(temp, rptr); } if(t2 != NULL) t2 = t2->nextstmt; } } else if((mref=find_method(root->astnode.ident.name,descriptor_table))!=NULL) { char *p; if(optdebug) { printf("call_optimize(): found %s in descriptor table.\n", root->astnode.ident.name); printf("call_optimize() - class: %s\n", mref->classname); printf("call_optimize() - method: %s\n", mref->methodname); printf("call_optimize() - desc: %s\n", mref->descriptor); } temp = root->astnode.ident.arraylist; p = mref->descriptor; for( ; temp != NULL; temp = temp->nextstmt) { expr_optimize(temp, rptr); p = bc_next_desc_token(p); if(optdebug) printf("call_optimize() - p = %s\n",p); if(temp->nodetype == Identifier) { /* now we check whether the function/subroutine expects this * to be passed by reference. in this case, we check the first * character of the argument descriptor. if it's 'L', then it * must be an object reference. */ if(isPassByRef_desc(p)) if((!temp->astnode.ident.arraylist) && !type_lookup(opt_array_table, temp->astnode.ident.name)) set_passByRef(temp, rptr); } /* skip extra element to compensate for array offset arg */ if(p[0] == '[') { if(!type_lookup(opt_array_table, temp->astnode.ident.name)) set_passByRef(temp, rptr); p = bc_next_desc_token(p); } } } else { if(optdebug) printf("call_optimize(): %s not found in global function table.\n", root->astnode.ident.name); temp = root->astnode.ident.arraylist; for( ; temp != NULL; temp = temp->nextstmt) expr_optimize (temp, rptr); } } /***************************************************************************** * * * isPassByRef_desc * * * * given the field descriptor for a method argument, determine whether this * * arg is passed by reference. returns BOOL. * * * *****************************************************************************/ BOOL isPassByRef_desc(char *desc) { char *desc_copy, *dptr; if(optdebug) printf("isPassByRef_desc, desc = %s\n", desc); /* quick check.. if the first char is not L then this can't be * pass by reference. */ if(desc[0] != 'L') { if(optdebug) printf("returning FALSE\n"); return FALSE; } /* copy the descriptor and chop off the remainder. */ desc_copy = strdup(desc); dptr = bc_next_desc_token(desc_copy); if(dptr != NULL) *dptr = '\0'; /* if the data type is String or Object, then it's not really * pass by reference, even though it's a reference data type. */ if(!strcmp(desc_copy,"Ljava/lang/String;") || !strcmp(desc_copy,"Ljava/lang/Object;")) { if(optdebug) printf("returning FALSE\n"); f2jfree(desc_copy, strlen(desc_copy)+1); return FALSE; } f2jfree(desc_copy, strlen(desc_copy)+1); /* didn't hit any of the above cases, so this must be * pass by reference. */ return TRUE; } /***************************************************************************** * * * set_passByRef * * * * this function sets the passByRef field of this ident & any corresponding * * COMMON block to TRUE. * * * *****************************************************************************/ void set_passByRef(AST *temp, AST *rptr) { SYMTABLE *opt_common_table = rptr->astnode.source.common_table; SYMTABLE *opt_type_table = rptr->astnode.source.type_table; HASHNODE *ht, *ht2, *ht3; AST *temp2; int cnt; ht = type_lookup(opt_type_table,temp->astnode.ident.name); if(ht) { ht->variable->astnode.ident.passByRef = TRUE; ht2 = type_lookup(opt_common_table,temp->astnode.ident.name); if(ht2) { ht3 = type_lookup(global_common_table, ht2->variable->astnode.ident.commonBlockName); if(ht3) { /* special handling for COMMON variables */ temp2 = ht3->variable->astnode.common.nlist; cnt = 0; while((cnt < ht2->variable->astnode.ident.position) && (temp2 != NULL)) { cnt++; temp2 = temp2->nextstmt; } if(temp2 != NULL) { temp2->astnode.ident.passByRef = TRUE; } else { fprintf(stderr, "optimize(): Common block length "); fprintf(stderr, "does not match position of ident\n"); } } else { fprintf(stderr,"Cant find common block %s\n", ht2->variable->astnode.ident.commonBlockName); } } } } /***************************************************************************** * * * assign_optimize * * * * We're looking at an assignment statement. If the LHS of this assignment * * is an argument to the current function, then it must be classified as * * pass by reference. * * * *****************************************************************************/ void assign_optimize (AST * root, AST *rptr) { SYMTABLE *opt_args_table = rptr->astnode.source.args_table; SYMTABLE *opt_type_table = rptr->astnode.source.type_table; SYMTABLE *opt_common_table = rptr->astnode.source.common_table; SYMTABLE *opt_array_table = rptr->astnode.source.array_table; HASHNODE *ht; AST *lhs; lhs = root->astnode.assignment.lhs; name_optimize (lhs, rptr); ht=type_lookup(opt_type_table,lhs->astnode.ident.name); if(ht) { /* check if the LHS is an array access. if so, then we really * should not set passByRef to TRUE here because setting an array * element does not require wrapping the array (not that we support * wrapping array references anyway). * * also check if the LHS is in a common block. shouldn't need to * wrap common variables. */ if(lhs->astnode.ident.arraylist == NULL) if((type_lookup(opt_args_table, lhs->astnode.ident.name) != NULL) && (type_lookup(opt_common_table, lhs->astnode.ident.name) == NULL) && (type_lookup(opt_array_table, lhs->astnode.ident.name) == NULL)) ht->variable->astnode.ident.passByRef = TRUE; if( optdebug ) if( ht->variable->astnode.ident.passByRef == TRUE ) printf("set passByRef for '%s'\n", lhs->astnode.ident.name); } else fprintf(stderr,"Can't find lhs of assignment: %s\n", root->astnode.assignment.lhs->astnode.ident.name); expr_optimize (root->astnode.assignment.rhs, rptr); } /***************************************************************************** * * * get_method_descriptor * * * * this returns the method descriptor for this program unit. * * * *****************************************************************************/ char * get_method_descriptor(AST *root, SYMTABLE *ttable, SYMTABLE *ctable, SYMTABLE *etable) { struct _str * temp_desc = NULL; enum returntype returns; HASHNODE *hashtemp; AST * tempnode; int isArray; char *ret_desc; char *p; temp_desc = strAppend(temp_desc, "("); if (root->nodetype == Function) { returns = root->astnode.source.returns; ret_desc = field_descriptor[returns][0]; } else /* Program or Subroutine */ ret_desc = "V"; /* * Now traverse the list of constructor arguments for either * functions or subroutines. This is where I will * have to check what the variable type is in the * symbol table. */ tempnode = root->astnode.source.args; for (; tempnode != NULL; tempnode = tempnode->nextstmt) { hashtemp = type_lookup (ttable, tempnode->astnode.ident.name); if (hashtemp == NULL) { if(type_lookup(etable, tempnode->astnode.ident.name) != NULL) { temp_desc = strAppend(temp_desc, field_descriptor[Object][0]); continue; } else { fprintf (stderr,"Type table is screwed (optimize.c).\n"); fprintf (stderr," (looked up: %s)\n", tempnode->astnode.ident.name); exit(EXIT_FAILURE); } } isArray = hashtemp->variable->astnode.ident.arraylist != NULL; /* If this variable is declared external and it is an argument to * this program unit, it must be declared as Object in Java. */ if(type_lookup(etable, tempnode->astnode.ident.name) != NULL) returns = OBJECT_TYPE; else returns = hashtemp->variable->vartype; /* * Check the numerical value returns. It should not * exceed the value of the enum returntypes. */ if (returns > MAX_RETURNS) fprintf (stderr,"Bad return value, check types.\n"); if(optdebug) printf("@#OPTIMIZE(%s) - arg = '%s'\n", root->astnode.source.name->astnode.ident.name, tempnode->astnode.ident.name); if(omitWrappers) { if((hashtemp->variable->astnode.ident.arraylist == NULL) && isPassByRef(tempnode->astnode.ident.name,ttable,ctable,etable)) temp_desc = strAppend(temp_desc, wrapped_field_descriptor[returns][isArray]); else temp_desc = strAppend(temp_desc, field_descriptor[returns][isArray]); } else { if (hashtemp->variable->astnode.ident.arraylist == NULL) temp_desc = strAppend(temp_desc, wrapped_field_descriptor[returns][isArray]); else temp_desc = strAppend(temp_desc, field_descriptor[returns][isArray]); } /* if this is an array, then append an I to the descriptor to * represent the integer offset arg. */ if(isArray) temp_desc = strAppend(temp_desc, "I"); } /* finish off the method descriptor. * for Functions, use the return descriptor calculated above. * for Programs, the descriptor must be ([Ljava/lang/String;)V. * for Subroutines, use void as the return type. */ if(root->nodetype == Function) { temp_desc = strAppend(temp_desc, ")"); temp_desc = strAppend(temp_desc, ret_desc); } else if(root->nodetype == Program) { temp_desc = strAppend(temp_desc, "[Ljava/lang/String;)V"); } else { temp_desc = strAppend(temp_desc, ")V"); } p = temp_desc->val; f2jfree(temp_desc, sizeof(struct _str)); return p; } f2j-0.8.1/src/symtab.c0000600000077700002310000002521211031241064014477 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/symtab.c,v $ * $Revision: 1.23 $ * $Date: 2007/01/18 22:02:37 $ * $Author: keithseymour $ */ /***************************************************************************** * symtab.c * * * * Contains routines for creating and manipulating symbol tables. * * * *****************************************************************************/ #include #include #include"string.h" #include"f2j.h" #include"symtab.h" #include"f2jmem.h" /***************************************************************************** * Globals and Function prototypes: * *****************************************************************************/ BOOL symdebug = FALSE; /* set TRUE for debugging output */ /* define which of three possible hashing functions to use. */ #define HASH(x) hash(x) unsigned int HashPJW (const char *); unsigned int hash (const char *); SYMTABLE * new_symtable (unsigned int); void type_insert (SYMTABLE *, AST *, enum returntype, char *); HASHNODE * format_lookup(SYMTABLE *, char *); /***************************************************************************** * * * new_symtable * * * * Create a new symbol table with the given number of entries. Return a * * pointer to the table. * * * *****************************************************************************/ SYMTABLE * new_symtable (unsigned int numentries) { SYMTABLE *newtable; newtable = (SYMTABLE *) f2jalloc (sizeof (SYMTABLE)); newtable->num_entries = numentries; newtable->num_items = 0; newtable->entry = (HASHNODE **) f2jcalloc (numentries, sizeof (HASHNODE *)); return (newtable); } /* Close new_symtable(). */ /***************************************************************************** * * * type_insert * * * * Insert a node into the given table. * * * * now accepts entire symbol table as argument instead of just one entry. * * this allows removing a lot of redundant code throughout the parser... * * e.g. computing the hash index. kgs 3/30/00 * * * *****************************************************************************/ void type_insert (SYMTABLE * table, AST * node_val, enum returntype rt, char *tag) { HASHNODE *newnode; int idx; idx = HASH(tag) % table->num_entries; /*fprintf(stderr,"type_insert(): table = %p, tag = '%s', idx = %d\n", table, tag, idx);*/ newnode = (HASHNODE *) f2jalloc (sizeof (HASHNODE)); newnode->ident = tag; newnode->type = rt; newnode->variable = node_val; newnode->next = table->entry[idx]; table->entry[idx] = newnode; table->num_items++; } /***************************************************************************** * * * type_lookup * * * * This is a specific lookup routine to match an id with * * its associated type. I will need others for matching * * externals, intrinsics, etc. * * * *****************************************************************************/ HASHNODE * type_lookup (SYMTABLE * table, char *id) { int index; HASHNODE *hash_entry; if((table == NULL) || (id == NULL)) { return NULL; } index = HASH (id) % table->num_entries; hash_entry = search_hashlist (table->entry[index], id); if (hash_entry == NULL) { if(symdebug) printf("Not in table.\n"); return NULL; } else /* Attempt to return the value pointed to by "type". */ { if(symdebug) printf("In table.\n"); return (hash_entry); } } /***************************************************************************** * * * format_lookup * * * * Look for a FORMAT statement in the given table. * * * *****************************************************************************/ HASHNODE * format_lookup(SYMTABLE *table, char *label) { /* why does this function exist?? kgs */ return type_lookup(table,label); } /***************************************************************************** * * * search_hashlist * * * * If there is an entry corresponding to the given id in this list, return * * a pointer to it. otherwise return NULL. * * * *****************************************************************************/ HASHNODE * search_hashlist (HASHNODE * list, char *id) { if(id == NULL) return NULL; for (; list; list = list->next) { if(list->ident){ if(!strcmp(list->ident, id)) return (list); } } return NULL; /* Not in list. */ } /***************************************************************************** * * * hash * * * * Simple hash function: just add the ascii integer * * values of each character in the string. * * * * Added error check for null string and made some * * other minor changes. 12/5/97 --Keith * * * *****************************************************************************/ unsigned int hash (const char *str) { int sum = 0; if(str == NULL) return 0; while(*str) sum += *str++; return sum; } /***************************************************************************** * HashPJW * * * * An adaptation of Peter Weinberger's (PJW) generic hashing * * algorithm based on Allen Holub's version. Accepts a pointer * * to a datum to be hashed and returns an unsigned integer. * * * *****************************************************************************/ #include #define BITS_IN_int ( sizeof(int) * CHAR_BIT ) #define THREE_QUARTERS ((int) ((BITS_IN_int * 3) / 4)) #define ONE_EIGHTH ((int) (BITS_IN_int / 8)) #define HIGH_BITS ( ~((unsigned int)(~0) >> ONE_EIGHTH )) unsigned int HashPJW ( const char * datum ) { unsigned int hash_value, i; for ( hash_value = 0; *datum; ++datum ) { hash_value = ( hash_value << ONE_EIGHTH ) + *datum; if (( i = hash_value & HIGH_BITS ) != 0 ) hash_value = ( hash_value ^ ( i >> THREE_QUARTERS )) & ~HIGH_BITS; } return ( hash_value ); } /***************************************************************************** * * * enumerate_symtable * * * * Create a doubly linked list containing all entries in the given * * symbol table. * * * *****************************************************************************/ Dlist enumerate_symtable(SYMTABLE *table) { Dlist newList = make_dl(); HASHNODE *tmp; int i; for(i=0;inum_entries;i++){ for(tmp = table->entry[i]; tmp != NULL; tmp = tmp->next){ dl_insert_b(newList,tmp->variable); } } return newList; } /****************************************************************************** * * * hash_delete * * * * This function removes the entry corresponding to the given tag. The * * deleted node is returned if found, otherwise return NULL. * * * *******************************************************************************/ HASHNODE * hash_delete(SYMTABLE *table, char *tag) { HASHNODE *list, *prev; int idx; if((table == NULL) || (tag == NULL)) return NULL; idx = HASH (tag) % table->num_entries; list = table->entry[idx]; for (prev = NULL; list; list = list->next) { if(list->ident == NULL) prev = list; else if (!strcmp (list->ident, tag)) { if(prev) prev->next = list->next; else table->entry[idx] = list->next; return (list); } prev = list; } return NULL; /* Not in list. */ } f2j-0.8.1/src/symtab.h0000600000077700002310000000446711031241064014515 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/symtab.h,v $ * $Revision: 1.12 $ * $Date: 2004/02/04 06:25:44 $ * $Author: keithseymour $ */ #ifndef _SYMTAB_H #define _SYMTAB_H /***************************************************************************** * symtab.h * * * * Header file for the symbol table routines. * * * *****************************************************************************/ #include #include "dlist.h" /* Enumeration of the different return types */ enum returntype { String, Character, Complex, Double, Float, Integer, Logical, Object }; /***************************************************************************** * Structure of a hash table node. * *****************************************************************************/ typedef struct hash_node { struct ast_node *variable; /* The variable corresponding to this entry */ char *ident; /* String tag */ enum returntype type; /* The variable's data type */ struct hash_node *next; /* Next node */ } HASHNODE; /***************************************************************************** * Function prototypes to keep the compiler from complaining. * *****************************************************************************/ typedef struct sym_table { int num_entries, /* Number of entries in this hash table */ num_items; /* Number of items stored in hash table */ HASHNODE **entry; /* Pointer to the entries */ } SYMTABLE; /***************************************************************************** * Function prototypes to keep the compiler from complaining. * *****************************************************************************/ HASHNODE * search_hashlist(HASHNODE *, char *), * type_lookup(SYMTABLE *, char *), * hash_delete(SYMTABLE *, char *); Dlist enumerate_symtable(SYMTABLE *); #endif f2j-0.8.1/src/typecheck.c0000600000077700002310000014125111031241064015161 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/typecheck.c,v $ * $Revision: 1.75 $ * $Date: 2007/12/14 20:56:39 $ * $Author: keithseymour $ */ /***************************************************************************** * typecheck.c * * * * Traverses the AST to determine the data type for all expressions. * * * *****************************************************************************/ #include #include #include #include"f2j.h" #include"y.tab.h" #include"f2jmem.h" #include"f2j_externs.h" /***************************************************************************** * Function prototypes: * *****************************************************************************/ char * merge_names(AST *); METHODTAB * methodscan (METHODTAB *, char *); void print_eqv_list(AST *, FILE *), remove_duplicates(AST *), typecheck (AST *), elseif_check(AST *), func_array_check(AST *), else_check (AST *), expr_check (AST *), assign_check (AST *), name_check (AST *), data_check(AST *), common_check(AST *), call_check (AST *), forloop_check (AST *), blockif_check (AST *), logicalif_check (AST *), check_implied_loop(AST *), read_write_check (AST *), merge_equivalences(AST *), check_equivalences(AST *), insertEquivalences(AST *), type_insert(SYMTABLE *, AST *, enum returntype, char *), external_check(AST *), typedec_check(AST *), intrinsic_check(AST *), array_check(AST *), subcall_check(AST *); SYMTABLE * new_symtable(int); extern METHODTAB intrinsic_toks[]; /***************************************************************************** * Global variables. * *****************************************************************************/ int checkdebug = FALSE; /* set to TRUE for debugging output */ AST *cur_check_unit; /* program unit currently being checked */ SYMTABLE * chk_type_table, /* ptr to this unit's symbol table */ * chk_external_table, /* ptr to table of external functions */ * chk_intrinsic_table, /* ptr to table of intrinsics */ * chk_array_table; /* ptr to array table */ char bitfields[] = { /* for typechecking intrinsics */ STRING_ARG,CHAR_ARG,COMPLEX_ARG,DOUBLE_ARG,REAL_ARG,INT_ARG,LOGICAL_ARG }; /***************************************************************************** * * * typecheck * * * * This is the main typechecking function. We traverse the * * AST and recursively call typecheck() on each node. This * * function figures out what kind of node it's looking at and * * calls the appropriate function to handle the typechecking. * * * *****************************************************************************/ void typecheck (AST * root) { switch (root->nodetype) { case 0: if (checkdebug) printf ("typecheck(): Bad node\n"); typecheck (root->nextstmt); break; case Progunit: if (checkdebug) printf ("typecheck(): Source.\n"); chk_type_table = root->astnode.source.type_table; chk_external_table = root->astnode.source.external_table; chk_intrinsic_table = root->astnode.source.intrinsic_table; chk_array_table = root->astnode.source.array_table; /* if there is a block of prologue comments, count the * number of lines here and set it in the comment node. */ if(root->astnode.source.prologComments) { int prolog_len = 0; AST *pltemp; pltemp = root->astnode.source.prologComments; while(pltemp != NULL && pltemp->nodetype == Comment) { prolog_len++; pltemp = pltemp->nextstmt; } root->astnode.source.prologComments->astnode.ident.len = prolog_len; } merge_equivalences(root->astnode.source.equivalences); /* now that the equivalences have been merged and duplicates * removed, we insert the variable names into a symbol table. */ root->astnode.source.equivalence_table = new_symtable(211); insertEquivalences(root); check_equivalences(root->astnode.source.equivalences); typecheck (root->astnode.source.progtype); typecheck (root->astnode.source.typedecs); typecheck (root->astnode.source.statements); break; case Subroutine: case Function: case Program: { AST *temp; cur_check_unit = root; for(temp = root->astnode.source.args;temp!=NULL;temp=temp->nextstmt) if(type_lookup(chk_external_table,temp->astnode.ident.name) != NULL) cur_check_unit->astnode.source.needs_reflection = TRUE; } break; case End: if (checkdebug) printf ("typecheck(): %s.\n", print_nodetype(root)); break; case DataList: data_check(root); if(root->nextstmt != NULL) typecheck(root->nextstmt); break; case Label: if(root->astnode.label.stmt != NULL) typecheck(root->astnode.label.stmt); if(root->nextstmt != NULL) typecheck(root->nextstmt); break; case Equivalence: if(checkdebug) printf("ignoring equivalence in typechecking\n"); if(root->nextstmt != NULL) typecheck(root->nextstmt); break; case Arithmeticif: if(checkdebug) printf("typecheck(): ArithmeticIf.\n"); if (root->astnode.arithmeticif.cond != NULL) expr_check (root->astnode.arithmeticif.cond); if(root->nextstmt != NULL) typecheck(root->nextstmt); break; case ComputedGoto: if (root->astnode.computed_goto.name) expr_check(root->astnode.computed_goto.name); if(root->nextstmt != NULL) typecheck(root->nextstmt); break; case AssignedGoto: if (root->astnode.computed_goto.name) expr_check(root->astnode.computed_goto.name); if(root->nextstmt != NULL) typecheck(root->nextstmt); break; case StmtLabelAssign: if (checkdebug) printf ("typecheck(): StmtLabelAssign.\n"); assign_check (root); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Typedec: typedec_check(root); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Specification: case Dimension: case Statement: case Return: case Goto: case Format: case Stop: case Pause: case Save: case MainComment: case Unimplemented: if (checkdebug) printf ("typecheck(): %s.\n", print_nodetype(root)); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Comment: /* we're looking at a comment - possibly several lines * of comments. Here we count the number of lines in * this comment. If this is the biggest (ie, longest * in terms of number of lines), then we make it the * MainComment which is generated in javadoc format. * * Deciding that the longest comment must be the description * of the function is definitely a hack and is specific to * BLAS/LAPACK. we should find a more elegant solution. */ /* if the previous statement is NULL (and we already know * that the current statement is a comment) then this must * be the first line of the comment block. * OR * if the previous statement is non-NULL and is not Comment, * then this must be the first line of the comment block. */ if(genJavadoc) { if( (root->prevstmt == NULL) || (root->prevstmt != NULL && root->prevstmt->nodetype != Comment && root->prevstmt->nodetype != MainComment)) { AST *ctemp; ctemp = root; root->astnode.ident.len = 0; while(ctemp != NULL && ctemp->nodetype == Comment) { root->astnode.ident.len++; ctemp = ctemp->nextstmt; } ctemp = cur_check_unit->astnode.source.javadocComments; if(ctemp == NULL) { root->nodetype = MainComment; cur_check_unit->astnode.source.javadocComments = root; } else if(root->astnode.ident.len > ctemp->astnode.ident.len) { ctemp->nodetype = Comment; root->nodetype = MainComment; cur_check_unit->astnode.source.javadocComments = root; } } } if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Common: fprintf(stderr,"Warning: hit case Common in typecheck()\n"); case CommonList: common_check(root); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Assignment: if (checkdebug) printf ("typecheck(): Assignment.\n"); assign_check (root); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Call: if (checkdebug) printf ("typecheck(): Call.\n"); call_check (root); if (root->nextstmt != NULL) /* End of typestmt list. */ typecheck (root->nextstmt); break; case Forloop: if (checkdebug) printf ("typecheck(): Forloop.\n"); forloop_check (root); if (root->nextstmt != NULL) /* End of typestmt list. */ typecheck (root->nextstmt); break; case Blockif: if (checkdebug) printf ("typecheck(): Blockif.\n"); blockif_check (root); if (root->nextstmt != NULL) /* End of typestmt list. */ typecheck (root->nextstmt); break; case Elseif: if (checkdebug) printf ("typecheck(): Elseif.\n"); elseif_check (root); if (root->nextstmt != NULL) /* End of typestmt list. */ typecheck (root->nextstmt); break; case Else: if (checkdebug) printf ("typecheck(): Else.\n"); else_check (root); if (root->nextstmt != NULL) /* End of typestmt list. */ typecheck (root->nextstmt); break; case Logicalif: if (checkdebug) printf ("typecheck(): Logicalif.\n"); logicalif_check (root); if (root->nextstmt != NULL) /* End of typestmt list. */ typecheck (root->nextstmt); break; case Write: if (checkdebug) printf ("typecheck(): Write statement.\n"); cur_check_unit->astnode.source.needs_output = TRUE; read_write_check (root); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Read: if (checkdebug) printf ("typecheck(): Read statement.\n"); cur_check_unit->astnode.source.needs_input = TRUE; read_write_check (root); if (root->nextstmt != NULL) typecheck (root->nextstmt); break; case Constant: default: fprintf(stderr,"typecheck(): Error, bad nodetype (%s)\n", print_nodetype(root)); } /* switch on nodetype. */ } void typedec_check (AST * root) { AST *temp, *temp2; for(temp=root->astnode.typeunit.declist; temp != NULL; temp = temp->nextstmt) { if(temp->astnode.ident.arraylist != NULL) { temp2 = temp->astnode.ident.arraylist; for( ;temp2!=NULL;temp2=temp2->nextstmt) { if(temp2->nodetype == ArrayIdxRange) { expr_check(temp2->astnode.expression.lhs); expr_check(temp2->astnode.expression.rhs); } else expr_check(temp2); } } } } /***************************************************************************** * * * merge_equivalences * * * * ok, this is a very poorly written subroutine. I admit it. * * but I dont think that most programs will have a ton of equivalences * * to merge, so it should not impose too much of a performance * * penalty. basically what we're doing here is looking at all * * the equivalences in the unit and determining if some variable * * is contained within more than one equivalence. If so, we * * merge those two equivalence statements. * * * *****************************************************************************/ void merge_equivalences(AST *root) { AST *temp, *ctemp; AST *temp2, *ctemp2; int needsMerge = FALSE; if(checkdebug) printf("M_EQV Equivalences:\n"); /* foreach equivalence statement... */ for(temp=root; temp != NULL; temp = temp->nextstmt) { if(checkdebug) printf("M_EQV (%d)", temp->token); /* foreach variable in the equivalence statement... */ for(ctemp=temp->astnode.equiv.clist;ctemp!=NULL;ctemp=ctemp->nextstmt) { if(checkdebug) printf(" %s, ", ctemp->astnode.ident.name); /* foreach equivalence statement (again)... */ for(temp2=root;temp2!=NULL;temp2=temp2->nextstmt) { /* foreach variable in the second equivalence statement... */ for(ctemp2=temp2->astnode.equiv.clist;ctemp2!=NULL;ctemp2=ctemp2->nextstmt) { if(!strcmp(ctemp->astnode.ident.name,ctemp2->astnode.ident.name) && temp->token != temp2->token) { /* the two names are the same, but arent in the same node. * the two equivalences pointed to by temp and temp2 should * be merged. */ temp2->token = temp->token; needsMerge = TRUE; } } } } if(checkdebug) printf("\n"); } /* if we dont need to merge anything, go ahead and return, skipping * this last chunk of code. */ if(!needsMerge) return; /* * Now we do the actual merging. */ /* foreach equivalence statement... */ for(temp=root; temp != NULL; temp = temp->nextstmt) { /* foreach equivalence statement (again)... */ for(temp2=root;temp2!=NULL;temp2=temp2->nextstmt) { if((temp->token == temp2->token) && (temp != temp2)) { /* the token pointers are equal and the nodes are distinct */ /* loop until the end of the first equivalence list */ ctemp=temp->astnode.equiv.clist; while(ctemp->nextstmt != NULL) ctemp = ctemp->nextstmt; /* add the second equivalence list to the end of the first */ ctemp->nextstmt = temp2->astnode.equiv.clist; /* now remove the second equivalence list from the list of * equivalences. */ ctemp = root; while(ctemp->nextstmt != temp2) ctemp = ctemp->nextstmt; ctemp->nextstmt = temp2->nextstmt; } } /* the merging process may produce duplicate entries. remove * them now. */ remove_duplicates(temp->astnode.equiv.clist); } } /***************************************************************************** * * * remove_duplicates * * * * This function removes duplicate names from a list of idents. * * * *****************************************************************************/ void remove_duplicates(AST *root) { AST *temp, *temp2, *prev; for(temp = root; temp != NULL; temp = temp->nextstmt) { prev = root; for(temp2 = root; temp2 != NULL; temp2 = temp2->nextstmt) { if(!strcmp(temp->astnode.ident.name,temp2->astnode.ident.name) && temp != temp2) { prev->nextstmt = temp2->nextstmt; } prev = temp2; } } } /***************************************************************************** * * * insertEquivalences * * * * This function inserts the equivalenced variable names into the symbol * * table. * * * *****************************************************************************/ void insertEquivalences(AST *root) { AST *temp, *ctemp; AST *eqvList = root->astnode.source.equivalences; SYMTABLE *eqvSymTab = root->astnode.source.equivalence_table; char *merged_name; /* foreach equivalence statement... */ for(temp = eqvList; temp != NULL; temp = temp->nextstmt) { /* merge the names in this list into one name */ merged_name = merge_names(temp->astnode.equiv.clist); for(ctemp = temp->astnode.equiv.clist;ctemp!=NULL;ctemp = ctemp->nextstmt) { /* store the merged name into the node before sticking the node into * the symbol table. */ ctemp->astnode.ident.merged_name = merged_name; type_insert(eqvSymTab, ctemp, Float, ctemp->astnode.ident.name); } } } /***************************************************************************** * * * merge_names * * * * This function merges a list of variable names into one name. Basically * * it just concatenates the names together, separated by an underscore. * * * *****************************************************************************/ char * merge_names(AST *root) { AST *temp; char *newName; unsigned int len = 0, num = 0; /* determine how long the merged name will be */ for(temp = root;temp != NULL;temp=temp->nextstmt, num++) len += strlen(temp->astnode.ident.name); /* the length of the merged name is the sum of: * * - the sum of the lengths of the variable names * - the number of variables * - one */ newName = (char *)f2jalloc(len + num + 1); newName[0] = 0; /* foreach name in the list... */ for(temp = root;temp != NULL;temp=temp->nextstmt, num++) { strcat(newName,temp->astnode.ident.name); if(temp->nextstmt != NULL) strcat(newName,"_"); } return newName; } /***************************************************************************** * * * check_equivalences * * * * Perform typechecking on equivalences. Loop through the equivalences and * * look up the type in the symbol table. * * * *****************************************************************************/ void check_equivalences(AST *root) { AST *temp, *ctemp; enum returntype curType; HASHNODE *hashtemp; int mismatch = FALSE; for(temp=root; temp != NULL; temp = temp->nextstmt) { if(temp->astnode.equiv.clist != NULL) { hashtemp = type_lookup(chk_type_table, temp->astnode.equiv.clist->astnode.ident.name); if(hashtemp) curType = hashtemp->variable->vartype; else continue; } else continue; for(ctemp=temp->astnode.equiv.clist;ctemp!=NULL;ctemp=ctemp->nextstmt) { hashtemp = type_lookup(chk_type_table,ctemp->astnode.ident.name); if(hashtemp) { if(hashtemp->variable->vartype != curType) mismatch = TRUE; } else continue; curType = hashtemp->variable->vartype; } if(mismatch) { fprintf(stderr, "Error with equivalenced variables: "); print_eqv_list(temp,stderr); fprintf(stderr, "...I can't handle equivalenced variables with differing types.\n"); } } } /***************************************************************************** * * * data_check * * * * Perform typechecking of DATA statements. Set the needs_declaration flag * * of the node depending on whether it is an array or not. * * * *****************************************************************************/ void data_check(AST * root) { HASHNODE *hashtemp; AST *Dtemp, *Ntemp, *var; for(Dtemp = root->astnode.label.stmt; Dtemp != NULL; Dtemp = Dtemp->prevstmt) { for(Ntemp = Dtemp->astnode.data.nlist;Ntemp != NULL;Ntemp=Ntemp->nextstmt) { if(Ntemp->nodetype == DataImpliedLoop) var = Ntemp->astnode.forloop.Label; else var = Ntemp; name_check(var); hashtemp = type_lookup(chk_type_table,var->astnode.ident.name); if(hashtemp != NULL) { if((var->astnode.ident.arraylist != NULL) && (type_lookup(chk_array_table,var->astnode.ident.name) != NULL)) hashtemp->variable->astnode.ident.needs_declaration = TRUE; else hashtemp->variable->astnode.ident.needs_declaration = FALSE; var->vartype = hashtemp->variable->vartype; } } } } /***************************************************************************** * * * common_check * * * * Perform typechecking of COMMON statements. * * * *****************************************************************************/ void common_check(AST *root) { HASHNODE *ht; AST *Ctemp, *Ntemp; int i; char **names; for(Ctemp=root->astnode.common.nlist;Ctemp!=NULL;Ctemp=Ctemp->nextstmt) { if(Ctemp->astnode.common.name != NULL) { if((ht=type_lookup(common_block_table, Ctemp->astnode.common.name))==NULL) { fprintf(stderr,"typecheck: can't find common block %s in table\n", Ctemp->astnode.common.name); continue; } names = (char **)ht->variable; i=0; for(Ntemp=Ctemp->astnode.common.nlist;Ntemp!=NULL;Ntemp=Ntemp->nextstmt,i++) { if (checkdebug) { printf("typecheck:Common block %s -- %s\n",Ctemp->astnode.common.name, Ntemp->astnode.ident.name); printf("typecheck:Looking up %s in the type table\n", Ntemp->astnode.ident.name); } if((ht=type_lookup(chk_type_table,Ntemp->astnode.ident.name)) == NULL) { fprintf(stderr,"typecheck Error: can't find type for common %s\n", Ntemp->astnode.ident.name); if (checkdebug) printf("Not Found\n"); continue; } ht->variable->astnode.ident.merged_name = names[i]; if(checkdebug) printf("# @#Typecheck: inserting %s into the type table, merged = %s\n", ht->variable->astnode.ident.name, ht->variable->astnode.ident.merged_name); ht->variable->astnode.ident.passByRef = TRUE; type_insert(chk_type_table,ht->variable,ht->variable->vartype, ht->variable->astnode.ident.name); } } } } /***************************************************************************** * * * name_check * * * * Perform typechecking of identifiers. * * * *****************************************************************************/ void name_check (AST * root) { HASHNODE *hashtemp; HASHNODE *ht; char * tempname; if (checkdebug) printf("here checking name %s, type is %s\n",root->astnode.ident.name, returnstring[root->vartype]); tempname = strdup(root->astnode.ident.name); uppercase(tempname); /* If the name is in the external table, then check to see if it is an intrinsic function instead (e.g. SQRT, ABS, etc). */ if (checkdebug) printf("tempname = %s\n", tempname); if (type_lookup (chk_external_table, root->astnode.ident.name) != NULL) { if (checkdebug) printf("going to external_check\n"); external_check(root); } else if(( methodscan (intrinsic_toks, tempname) != NULL) && ((type_lookup(chk_intrinsic_table,root->astnode.ident.name) != NULL) || (type_lookup(chk_type_table,root->astnode.ident.name) == NULL))) { if (checkdebug) printf("going to intrinsic_check\n"); intrinsic_check(root); } else { if (checkdebug) printf("NOt intrinsic or external (%s)\n", root->astnode.ident.name); switch (root->token) { case STRING: case CHAR: if(checkdebug) printf("typecheck(): ** I am going to check a String/char literal!\n"); break; case INTRINSIC: /* do nothing */ break; case NAME: default: hashtemp = type_lookup (chk_array_table, root->astnode.ident.name); if(checkdebug) printf("looking for %s in the type table\n",root->astnode.ident.name); if((ht = type_lookup(chk_type_table,root->astnode.ident.name)) != NULL) { if(checkdebug) printf("@# Found! setting type to %s\n", returnstring[ht->variable->vartype]); root->vartype = ht->variable->vartype; } else if( (cur_check_unit->nodetype == Function) && !strcmp(cur_check_unit->astnode.source.name->astnode.ident.name, root->astnode.ident.name)) { if(checkdebug) { printf("@# this is the implicit function var\n"); printf("@# ...setting vartype = %s\n", returnstring[cur_check_unit->astnode.source.returns]); } root->vartype = cur_check_unit->astnode.source.returns; } else { /* this is a hack for typechecking expressions within * an array declaration - just set type of * to Integer. */ if(!strcmp(root->astnode.ident.name,"*")) { root->vartype = Integer; } else { fprintf(stderr,"Undeclared variable: %s\n",root->astnode.ident.name); root->vartype = 0; } } if (root->astnode.ident.arraylist == NULL) ; /* nothin for now */ else if ((hashtemp != NULL) || ((root->vartype == String) && root->astnode.ident.arraylist != NULL)) array_check(root); else if (root->nodetype == Substring) root->vartype = String; else subcall_check(root); } } f2jfree(tempname, strlen(tempname)+1); } /***************************************************************************** * * * subcall_check * * * * This function checks a subroutine call. * * * *****************************************************************************/ void subcall_check(AST *root) { AST *temp; char *tempstr; tempstr = strdup (root->astnode.ident.name); *tempstr = toupper (*tempstr); temp = root->astnode.ident.arraylist; for (; temp != NULL; temp = temp->nextstmt) if (*temp->astnode.ident.name != '*') { if(temp == NULL) fprintf(stderr,"subcall_check: calling expr_check with null pointer!\n"); expr_check (temp); } /* * here we need to figure out if this is a function * call and if so, what the return type is. this will * require keeping track of all the functions/subroutines * during parsing. and there will still be some that * we can't figure out. * * for now, we'll just assign integer to every call */ root->vartype = Integer; } /***************************************************************************** * * * func_array_check * * * * Typecheck an array access. This could be merged with array_check()... * * * *****************************************************************************/ void func_array_check(AST *root) { AST *tmp; if(root == NULL) fprintf(stderr,"func_array_check1: calling expr_check with null pointer!\n"); for(tmp = root; tmp != NULL; tmp = tmp->nextstmt) expr_check(tmp); /* * expr_check (root); * * if( (hashtemp->variable->astnode.ident.leaddim != NULL) * && (hashtemp->variable->astnode.ident.leaddim[0] != '*') * && (root->nextstmt != NULL)) * { * expr_check (root->nextstmt); * * if(root->nextstmt->nextstmt) * expr_check (root->nextstmt->nextstmt); * } */ } /***************************************************************************** * * * array_check * * * * Typecheck an array access. * * * *****************************************************************************/ void array_check(AST *root) { AST *temp; if (checkdebug) printf ("typecheck(): Array... %s, My node type is %s\n", root->astnode.ident.name, print_nodetype(root)); temp = root->astnode.ident.arraylist; func_array_check(temp); } /***************************************************************************** * * * external_check * * * * Check an external variable. * * * *****************************************************************************/ void external_check(AST *root) { char *tempname; tempname = strdup(root->astnode.ident.name); uppercase(tempname); /* first, make sure this isn't in the list of intrinsic functions... */ if (methodscan(intrinsic_toks,tempname) == NULL) { if (root->astnode.ident.arraylist != NULL) call_check (root); f2jfree(tempname,strlen(tempname)+1); return; } if (root->astnode.ident.arraylist != NULL) { /* this is some sort of intrinsic. maybe it's ETIME or SECOND, which * are declared EXTERNAL since they really aren't intrinsics, but we * treat them as such since there is a corresponding Java function to * handle them. */ if( !strcmp(tempname, "ETIME") ) { expr_check (root->astnode.ident.arraylist); root->vartype = Float; } else if( !strcmp(tempname, "SECOND") ) { root->vartype = Float; } } f2jfree(tempname,strlen(tempname)+1); } /***************************************************************************** * * * intrinsic_check * * * * Here we have an intrinsic to check. We have to explicitly handle all * * the intrinsics that we know about. First determine which one we're * * looking at and then assign a type depending on the return type of the * * actual Java function (e.g. SQRT will return double because Math.sqrt() * * returns double). * * * *****************************************************************************/ void intrinsic_check(AST *root) { AST *temp; METHODTAB *entry; char *tempname; enum _intrinsics id; enum returntype min_type = Integer; tempname = strdup(root->astnode.ident.name); uppercase(tempname); entry = methodscan (intrinsic_toks, tempname); if(checkdebug) printf("Tempname=%s\n", tempname); f2jfree(tempname, strlen(tempname)+1); if(!entry) { fprintf(stderr,"Error: not expecting null entry at this point.\n"); exit(EXIT_FAILURE); } id = entry->intrinsic; if(root->astnode.ident.arraylist == NULL) fprintf(stderr,"WARNING: intrinsic with no args!\n"); /* check each argument to this intrinsic and determine the widest type * in case this is a generic intrinsic (so we may correctly determine * which typecasts to make). */ if(root->astnode.ident.arraylist->nodetype != EmptyArgList) { for(temp = root->astnode.ident.arraylist;temp != NULL;temp=temp->nextstmt) { expr_check (temp); if(temp->vartype < min_type) min_type = temp->vartype; /* * printbits("This is the bitmask ", &bitfields[temp->vartype], 1); * printbits("This is the entry-args ", &entry->args, 1); */ if(checkdebug) printf("temp->vartype=%s\n", returnstring[temp->vartype]); if(! (bitfields[temp->vartype] & entry->args)) { fprintf(stderr, "++%s %s\n", temp->astnode.ident.name, returnstring[temp->vartype]); fprintf(stderr, "--%s\n", cur_check_unit->astnode.source.name->astnode.ident.name); fprintf(stderr,"Error: bad argument type to intrinsic %s\n", entry->fortran_name); exit(EXIT_FAILURE); } } } /* if this is a generic intrinsic, then set the return type of the * intrinsic to the type of the widest argument. */ if(type_lookup(generic_table, intrinsic_toks[id].fortran_name) != NULL) { /* we must make a special case for type conversion intrinsics because * they always have the same return type regardless of whether the * generic form is used. */ switch(id) { case ifunc_INT: root->vartype = Integer; break; case ifunc_REAL: root->vartype = Float; break; case ifunc_DBLE: root->vartype = Double; break; case ifunc_CMPLX: root->vartype = Complex; break; case ifunc_NINT: root->vartype = Integer; break; default: root->vartype = min_type; break; /* ansi c */ } } else root->vartype = intrinsic_toks[id].ret; } /***************************************************************************** * * * expr_check * * * * Recursive procedure to check expressions. * * * *****************************************************************************/ void expr_check (AST * root) { if(root == NULL) { fprintf(stderr,"expr_check(): NULL root!\n"); return; } switch (root->nodetype) { /*if (checkdebug) printf("before hit case identifier (%s), now type is %s\n", root->astnode.ident.name,returnstring[root->vartype]); */ case Identifier: name_check (root); if (checkdebug) printf("after hit case identifier (%s), now type is %s\n", root->astnode.ident.name,returnstring[root->vartype]); break; case Expression: if (root->astnode.expression.lhs != NULL) expr_check (root->astnode.expression.lhs); if(root->astnode.expression.rhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.rhs); root->vartype = root->astnode.expression.rhs->vartype; break; case Power: if(root->astnode.expression.lhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.lhs); if(root->astnode.expression.rhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.rhs); /* * if the exponent is integer, the expression type should inherit the * type of the LHS, otherwise it would be the wider of the two. */ if(root->astnode.expression.rhs->vartype == Integer) root->vartype = root->astnode.expression.lhs->vartype; else root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); break; case Binaryop: if(root->astnode.expression.lhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null LHS!\n"); expr_check (root->astnode.expression.lhs); if(root->astnode.expression.rhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null RHS!\n"); expr_check (root->astnode.expression.rhs); if (checkdebug) { printf("here checking binaryOp, optype = '%c'\n", root->astnode.expression.optype); printf("lhs type: %s\n", returnstring[root->astnode.expression.lhs->vartype]); printf("rhs type: %s\n", returnstring[root->astnode.expression.rhs->vartype]); } root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); break; case Unaryop: if(root->astnode.expression.rhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.rhs); root->vartype = root->astnode.expression.rhs->vartype; break; case Constant: /* constant's type is already known */ break; case Logicalop: if (root->astnode.expression.lhs != NULL) expr_check (root->astnode.expression.lhs); if(root->astnode.expression.rhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.rhs); root->vartype = Logical; break; case Relationalop: if(root->astnode.expression.lhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.lhs); if(root->astnode.expression.rhs == NULL) fprintf(stderr,"expr_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.expression.rhs); root->vartype = Logical; break; case Substring: if(root->astnode.ident.startDim[0]) expr_check(root->astnode.ident.startDim[0]); if(root->astnode.ident.endDim[0]) expr_check(root->astnode.ident.endDim[0]); if(root->astnode.ident.startDim[1]) expr_check(root->astnode.ident.startDim[1]); root->vartype = String; break; case EmptyArgList: /* do nothing */ break; default: fprintf(stderr,"Warning: Unknown nodetype in expr_check(): %s\n", print_nodetype(root)); } } /***************************************************************************** * * * forloop_check * * * * Check a DO loop. * * * *****************************************************************************/ void forloop_check (AST * root) { expr_check (root->astnode.forloop.iter_expr); assign_check (root->astnode.forloop.incr_expr); assign_check (root->astnode.forloop.start); if(root->astnode.forloop.stop == NULL) fprintf(stderr,"forloop_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.forloop.stop); if (root->astnode.forloop.incr != NULL) expr_check (root->astnode.forloop.incr); } /***************************************************************************** * * * logicalif_check * * * * Check a Logical IF statement. * * * *****************************************************************************/ void logicalif_check (AST * root) { if (root->astnode.logicalif.conds != NULL) expr_check (root->astnode.logicalif.conds); typecheck (root->astnode.logicalif.stmts); } /***************************************************************************** * * * read_write_check * * * * Performs typechecking on READ and WRITE statements. * * * *****************************************************************************/ void read_write_check (AST * root) { AST *temp; for(temp=root->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) { if(temp->nodetype == IoImpliedLoop) check_implied_loop(temp); else expr_check (temp); } } /***************************************************************************** * * * check_implied_loop * * * * Performs typechecking on an implied DO loop. * * * *****************************************************************************/ void check_implied_loop(AST *node) { AST *temp; for(temp = node->astnode.forloop.Label; temp != NULL; temp = temp->nextstmt) expr_check(temp); expr_check(node->astnode.forloop.iter_expr); assign_check(node->astnode.forloop.incr_expr); } /***************************************************************************** * * * blockif_check * * * * Check a block IF statement, including elseif and else blocks. * * * *****************************************************************************/ void blockif_check (AST * root) { AST *temp; if (root->astnode.blockif.conds != NULL) expr_check (root->astnode.blockif.conds); if (root->astnode.blockif.stmts != NULL) typecheck (root->astnode.blockif.stmts); for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt) elseif_check (temp); if (root->astnode.blockif.elsestmts != NULL) else_check (root->astnode.blockif.elsestmts); } /***************************************************************************** * * * elseif_check * * * * Check the "else if" of a block IF statement. This is short enough to * * be inlined with blockif_check at some point. * * * *****************************************************************************/ void elseif_check (AST * root) { if (root->astnode.blockif.conds != NULL) expr_check (root->astnode.blockif.conds); typecheck (root->astnode.blockif.stmts); } /***************************************************************************** * * * elseif_check * * * * Check the "else if" of a block IF statement. This is definitely short * * enough to be inlined with blockif_check at some point. * * * *****************************************************************************/ void else_check (AST * root) { typecheck (root->astnode.blockif.stmts); } /***************************************************************************** * * * call_check * * * * Check a function/subroutine call. This node's type is based on the * * declaration in the original Fortran code. * * * *****************************************************************************/ void call_check (AST * root) { AST *temp; HASHNODE *ht; assert (root != NULL); if(root->astnode.ident.arraylist == NULL) return; if(checkdebug) printf("the name of this function/subroutine is %s\n", root->astnode.ident.name); /* now is a convenient time to determine whether we should import the * BLAS library. */ if(type_lookup(blas_routine_table,root->astnode.ident.name)) cur_check_unit->astnode.source.needs_blas = TRUE; if( (ht = type_lookup(chk_type_table,root->astnode.ident.name)) != NULL) { if(checkdebug) printf("SETting type to %s\n", returnstring[ht->variable->vartype]); root->vartype = ht->variable->vartype; } temp = root->astnode.ident.arraylist; while (temp->nextstmt != NULL) { if(temp == NULL) fprintf(stderr,"call_check: calling expr_check with null pointer!\n"); expr_check (temp); temp = temp->nextstmt; } if(temp == NULL) fprintf(stderr,"call_check: calling expr_check with null pointer!\n"); expr_check (temp); } /***************************************************************************** * * * assign_check * * * * Check an assignment statement. This info is very important to the code * * generator. * * * *****************************************************************************/ void assign_check (AST * root) { name_check (root->astnode.assignment.lhs); if(root->astnode.assignment.rhs == NULL) fprintf(stderr,"assign_check: calling expr_check with null pointer!\n"); expr_check (root->astnode.assignment.rhs); } f2j-0.8.1/src/vcg_emitter.c0000600000077700002310000010024511031241064015510 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/vcg_emitter.c,v $ * $Revision: 1.16 $ * $Date: 2007/01/18 22:02:38 $ * $Author: keithseymour $ */ /***************************************************************************** * vcg_emitter.c * * * * Emits a graph representing the syntax tree for the * * fortran program. The file is compatible with the * * VCG tool (Visualization of Compiler Graphs). * * I'm afraid this routine is horribly out of date. * * * *****************************************************************************/ #include #include #include #include"f2j.h" #include"y.tab.h" #include"f2j_externs.h" /***************************************************************************** * Function prototypes: * *****************************************************************************/ char * lowercase(char *); void start_vcg(AST *), emit_vcg(AST *,int), vcg_elseif_emit(AST *,int), vcg_else_emit(AST *,int), vcg_typedec_emit (AST *, int), vcg_spec_emit (AST *, int), vcg_assign_emit (AST *, int), vcg_call_emit (AST *, int), vcg_forloop_emit (AST *, int), vcg_blockif_emit (AST *, int), vcg_logicalif_emit (AST *, int), vcg_label_emit (AST *, int), vcg_expr_emit (AST *, int); int vcg_name_emit (AST *); METHODTAB * methodscan (METHODTAB *, char *); /***************************************************************************** * Global variables. * *****************************************************************************/ int vcg_debug = FALSE, /* set to TRUE to get debugging output */ node_num = 1; /* initialize node counter */ char temp_buf[200], /* temporary buffer for node titles */ *vcg_returns; /* return type of the current program unit */ extern METHODTAB intrinsic_toks[]; /***************************************************************************** * * * start_vcg * * * * Print graph header (width, height, etc.) and call emit_vcg() to generate * * the rest of the graph. * * * *****************************************************************************/ void start_vcg(AST *root) { /* print header information */ print_vcg_header(vcgfp, "SYNTAX TREE"); emit_vcg(root, 0); print_vcg_trailer(vcgfp); } /***************************************************************************** * * * print_vcg_header * * * * this function prints the VCG header, with the given title. * * * *****************************************************************************/ void print_vcg_header(FILE *gfp, char *title) { fprintf(gfp,"graph: { title: \"%s\"\n", title); fprintf(gfp,"x: 30\n"); fprintf(gfp,"y: 30\n"); fprintf(gfp,"width: 850\n"); fprintf(gfp,"height: 800\n"); fprintf(gfp,"color: lightcyan\n"); fprintf(gfp,"stretch: 4\n"); fprintf(gfp,"shrink: 10\n"); fprintf(gfp,"layout_upfactor: 10\n"); fprintf(gfp,"manhatten_edges: yes\n"); fprintf(gfp,"smanhatten_edges: yes\n"); fprintf(gfp,"layoutalgorithm: tree\n\n"); fprintf(gfp,"node: {color: black textcolor: white title:\"f2j\"\n"); fprintf(gfp,"label: \"Nothing should hang here\"\n"); fprintf(gfp,"}\n\n"); } /***************************************************************************** * * * print_vcg_trailer * * * * this function prints the VCG trailer. * * * *****************************************************************************/ void print_vcg_trailer(FILE *gfp) { fprintf(gfp,"}\n"); } /***************************************************************************** * * * print_vcg_node * * * * Given a number and a label, this function prints a node specification. * * * *****************************************************************************/ void print_vcg_node(FILE *gfp, int num, char *label) { if(vcg_debug) printf("creating node \"%s\"\n",label); fprintf(gfp, "node: {color: black textcolor: white title:\"%d\"\n",num); fprintf(gfp, "label: \"%s\"\n",label); fprintf(gfp, "}\n\n"); node_num++; } /***************************************************************************** * * * print_vcg_typenode * * * * Similar to print_vcg_node except that this function prints a special * * "typenode", which acts as as annotation to the graph (showing type info). * * * *****************************************************************************/ void print_vcg_typenode(FILE *gfp, int num, char *label) { if(vcg_debug) printf("creating typenode \"%s\"\n",label); fprintf(gfp, "node: { title: \"%d\"\n",num); fprintf(gfp, " label: \"%s\"\n",label); fprintf(gfp, "}\n\n"); node_num++; } /***************************************************************************** * * * print_vcg_edge * * * * Given the source and destination node numbers, this function emits an * * edge to connect them. * * * *****************************************************************************/ void print_vcg_edge(FILE *gfp, int source, int dest) { fprintf(gfp, "edge: { thickness: 6 color: red sourcename: \"%d\" targetname: \"%d\"}\n\n", source, dest); } /***************************************************************************** * * * print_vcg_nearedge * * * * Similar to print_vcg_edge except that this function emits a "nearedge", * * which tells VCG to try to keep the nodes close together. * * * *****************************************************************************/ void print_vcg_nearedge(FILE *gfp, int source, int dest) { fprintf(gfp,"nearedge: { sourcename: \"%d\" targetname: \"%d\"\n", source, dest); fprintf(gfp,"color: blue thickness: 6\n}\n\n"); } /***************************************************************************** * * * emit_vcg * * * * This is the main VCG generation function. We traverse the * * AST and recursively call emit_vcg() on each node. This * * function figures out what kind of node it's looking at and * * calls the appropriate function to handle the graph generation. * * * *****************************************************************************/ void emit_vcg (AST * root, int parent) { int my_node = node_num; switch (root->nodetype) { case 0: fprintf(stderr,"Bad node in emit_vcg()\n"); emit_vcg (root->nextstmt,node_num); case Progunit: if(vcg_debug) printf("case Source\n"); print_vcg_node(vcgfp, node_num,"Progunit"); if(vcg_debug) printf("case Source: Going to emit PROGTYPE\n"); emit_vcg (root->astnode.source.progtype, my_node); if(vcg_debug) printf("case Source: Going to emit TYPEDECS\n"); emit_vcg (root->astnode.source.typedecs, my_node); if(vcg_debug) printf("case Source: Going to emit STATEMENTS\n"); emit_vcg (root->astnode.source.statements, my_node); break; case Subroutine: if(vcg_debug) printf("case Subroutine\n"); print_vcg_node(vcgfp, node_num,"Subroutine"); print_vcg_edge(vcgfp, parent, my_node); vcg_returns = NULL; /* Subroutines return void. */ break; case Function: if(vcg_debug) printf("case Function\n"); sprintf (temp_buf,"Function: %s\n", root->astnode.source.name->astnode.ident.name); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); vcg_returns = root->astnode.source.name->astnode.ident.name; break; case Typedec: if(vcg_debug) printf("case Typedec\n"); vcg_typedec_emit (root, parent); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Specification: if(vcg_debug) printf("case Specification\n"); vcg_spec_emit (root, parent); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Statement: if(vcg_debug) printf("case Statement\n"); print_vcg_node(vcgfp, node_num,"Statement"); print_vcg_edge(vcgfp, parent, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Assignment: print_vcg_node(vcgfp, node_num,"Assignment"); print_vcg_edge(vcgfp, parent, my_node); vcg_assign_emit (root, my_node); if (root->nextstmt != NULL) emit_vcg (root->nextstmt, my_node); break; case Call: vcg_call_emit (root, parent); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Forloop: print_vcg_node(vcgfp, node_num,"For loop"); print_vcg_edge(vcgfp, parent, my_node); vcg_forloop_emit (root, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Blockif: print_vcg_node(vcgfp, node_num,"Block if"); print_vcg_edge(vcgfp, parent, my_node); vcg_blockif_emit (root, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Elseif: print_vcg_node(vcgfp, node_num,"Else if"); print_vcg_edge(vcgfp, parent, my_node); vcg_elseif_emit (root, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Else: print_vcg_node(vcgfp, node_num,"Else"); print_vcg_edge(vcgfp, parent, my_node); vcg_else_emit (root, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Logicalif: print_vcg_node(vcgfp, node_num,"Logical If"); print_vcg_edge(vcgfp, parent, my_node); vcg_logicalif_emit (root, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Return: if (vcg_returns != NULL) sprintf (temp_buf, "Return (%s)", vcg_returns); else sprintf (temp_buf, "Return"); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case Goto: sprintf (temp_buf,"Goto (%d)", root->astnode.go_to.label); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); if (root->nextstmt != NULL) emit_vcg (root->nextstmt, my_node); break; case Label: vcg_label_emit (root, parent); if (root->nextstmt != NULL) /* End of typestmt list. */ emit_vcg (root->nextstmt, my_node); break; case End: print_vcg_node(vcgfp, node_num,"End"); print_vcg_edge(vcgfp, parent, my_node); /* end of the program */ break; case Unimplemented: print_vcg_node(vcgfp, node_num,"UNIMPLEMENTED"); print_vcg_edge(vcgfp, parent, my_node); if (root->nextstmt != NULL) emit_vcg (root->nextstmt, my_node); break; case Constant: sprintf(temp_buf,"Constant(%s)", root->astnode.constant.number); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); default: fprintf (stderr,"vcg_emitter: Default case reached!\n"); } /* switch on nodetype. */ } /***************************************************************************** * * * vcg_typedec_emit * * * * Emit all the type declaration nodes. * * * *****************************************************************************/ void vcg_typedec_emit (AST * root, int parent) { AST *temp; enum returntype returns; int my_node = node_num; int name_nodenum; int prev_node; if(vcg_debug) printf("in vcg_typedec_emit\n"); temp = root->astnode.typeunit.declist; /* This may have to be moved into the looop also. Could be * why I have had problems with this stuff. */ if(type_lookup (external_table, temp->astnode.ident.name)) { if(vcg_debug) { printf("returning from vcg_typedec_emit,"); printf(" found something in hash table\n"); } print_vcg_node(vcgfp, node_num,"External"); print_vcg_edge(vcgfp, parent, my_node); return; } returns = root->astnode.typeunit.returns; sprintf(temp_buf,"TypeDec (%s)", returnstring[returns]); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); prev_node = my_node; for (; temp != NULL; temp = temp->nextstmt) { if(vcg_debug) printf("in the loop\n"); name_nodenum = vcg_name_emit (temp); print_vcg_nearedge(vcgfp, prev_node,name_nodenum); prev_node = name_nodenum; } if(vcg_debug) printf("leaving vcg_typdec_emit\n"); } /***************************************************************************** * * * vcg_name_emit * * * * Generate an identifier node. * * * *****************************************************************************/ int vcg_name_emit (AST * root) { AST *temp; HASHNODE *hashtemp; char *javaname, * tempname; int my_node = node_num; METHODTAB *entry; if(vcg_debug) printf("in vcg_name_emit\n"); sprintf(temp_buf,"Name (%s)",root->astnode.ident.name); print_vcg_node(vcgfp, my_node,temp_buf); /* Check to see whether name is in external table. Names are * loaded into the external table from the parser. */ /* If the name is in the external table, then check to see if * is an intrinsic function instead. */ if(type_lookup (external_table, root->astnode.ident.name)) { /* This block of code is only called if the identifier * absolutely does not have an entry in any table, * and corresponds to a method invocation of * something in the blas or lapack packages. */ if (methodscan(intrinsic_toks,root->astnode.ident.name) == NULL) { if (root->astnode.ident.arraylist != NULL) { vcg_call_emit (root, my_node); return my_node; } return my_node; } } tempname = strdup(root->astnode.ident.name); uppercase(tempname); if(vcg_debug) printf ("Tempname %s\n", tempname); entry = methodscan (intrinsic_toks, tempname); javaname = entry->java_method; if (javaname != NULL) { if (!strcmp (root->astnode.ident.name, "MAX")) { temp = root->astnode.ident.arraylist; vcg_expr_emit (temp, my_node); vcg_expr_emit (temp->nextstmt, my_node); return my_node; } if (!strcmp (root->astnode.ident.name, "MIN")) { temp = root->astnode.ident.arraylist; vcg_expr_emit (temp, my_node); vcg_expr_emit (temp->nextstmt, my_node); return my_node; } if (!strcmp (root->astnode.ident.name, "ABS")) { temp = root->astnode.ident.arraylist; vcg_expr_emit (temp, my_node); return my_node; } if (!strcmp (tempname, "DABS")) { temp = root->astnode.ident.arraylist; vcg_expr_emit (temp, my_node); return my_node; } if (!strcmp (tempname, "DSQRT")) { temp = root->astnode.ident.arraylist; vcg_expr_emit (temp, my_node); return my_node; } } hashtemp = type_lookup (array_table, root->astnode.ident.name); switch (root->token) { case STRING: /*fprintf (javafp, "\"%s\"", root->astnode.ident.name); */ break; case CHAR: /*fprintf (javafp, "\"%s\"", root->astnode.ident.name); */ break; case NAME: default: /* At some point in here I will have to switch on the token type check whether it is a variable or string or character literal. Also have to look up whether name is intrinsic or external. */ if (root->astnode.ident.arraylist == NULL) { /* null */ ; /* fprintf (javafp, "%s", root->astnode.ident.name); */ } else if (hashtemp != NULL) { if(vcg_debug) printf ("Array... %s\n", root->astnode.ident.name); temp = root->astnode.ident.arraylist; /* Now, what needs to happen here is the context of the * array needs to be determined. If the array is being * passed as a parameter to a method, then the array index * needs to be passed separately and the array passed as * itself. If not, then an array value is being set, * so dereference with index arithmetic. */ /*fprintf (javafp, "["); */ vcg_expr_emit (temp, my_node); /* * if (hashtemp->variable->astnode.ident.leaddim[0] != '*' && * temp->nextstmt != NULL) { * temp = temp->nextstmt; * * vcg_expr_emit (temp, my_node); * } */ } else { /*fprintf (javafp, "%s", root->astnode.ident.name); */ temp = root->astnode.ident.arraylist; for (; temp != NULL; temp = temp->nextstmt) { /*fprintf (javafp, "["); */ if (*temp->astnode.ident.name != '*') vcg_expr_emit (temp, my_node); /*fprintf (javafp, "]"); */ } } break; } return my_node; } /***************************************************************************** * * * vcg_expr_emit * * * * Recursive function to generate an expression graph. * * * *****************************************************************************/ void vcg_expr_emit (AST * root, int parent) { int my_node = node_num; int temp_num; switch (root->nodetype) { case Identifier: print_vcg_node(vcgfp, my_node,"Ident"); print_vcg_edge(vcgfp, parent,my_node); temp_num = vcg_name_emit (root); print_vcg_edge(vcgfp, my_node,temp_num); break; case Expression: if (root->astnode.expression.lhs != NULL) vcg_expr_emit (root->astnode.expression.lhs, parent); vcg_expr_emit (root->astnode.expression.rhs, parent); break; case Power: print_vcg_node(vcgfp, my_node,"pow()"); print_vcg_edge(vcgfp, parent,my_node); vcg_expr_emit (root->astnode.expression.lhs, my_node); vcg_expr_emit (root->astnode.expression.rhs, my_node); break; case Binaryop: sprintf(temp_buf,"%c", root->astnode.expression.optype); print_vcg_node(vcgfp, my_node,temp_buf); print_vcg_edge(vcgfp, parent,my_node); vcg_expr_emit (root->astnode.expression.lhs, my_node); vcg_expr_emit (root->astnode.expression.rhs, my_node); break; case Unaryop: sprintf(temp_buf,"%c", root->astnode.expression.minus); print_vcg_node(vcgfp, my_node,temp_buf); print_vcg_edge(vcgfp, parent,my_node); vcg_expr_emit (root->astnode.expression.rhs, my_node); break; case Constant: sprintf(temp_buf,"Constant(%s)", root->astnode.constant.number); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); break; case Logicalop: if(root->token == AND) print_vcg_node(vcgfp, my_node,"AND"); else if(root->token == OR) print_vcg_node(vcgfp, my_node,"OR"); if (root->astnode.expression.lhs == NULL) print_vcg_node(vcgfp, my_node,"NOT"); print_vcg_edge(vcgfp, parent,my_node); if (root->astnode.expression.lhs != NULL) vcg_expr_emit (root->astnode.expression.lhs, my_node); vcg_expr_emit (root->astnode.expression.rhs, my_node); break; case Relationalop: switch (root->token) { case rel_eq: print_vcg_node(vcgfp, my_node,"=="); break; case rel_ne: print_vcg_node(vcgfp, my_node,"!="); break; case rel_lt: print_vcg_node(vcgfp, my_node,"<"); break; case rel_le: print_vcg_node(vcgfp, my_node,"<="); break; case rel_gt: print_vcg_node(vcgfp, my_node,">"); break; case rel_ge: print_vcg_node(vcgfp, my_node,">="); break; default: print_vcg_node(vcgfp, my_node,"Unknown RelationalOp"); } print_vcg_edge(vcgfp, parent,my_node); vcg_expr_emit (root->astnode.expression.lhs, my_node); vcg_expr_emit (root->astnode.expression.rhs, my_node); break; default: fprintf(stderr,"vcg_emitter: Bad node in vcg_expr_emit\n"); } } /***************************************************************************** * * * vcg_forloop_emit * * * * Generate the graph for a DO loop. * * * *****************************************************************************/ void vcg_forloop_emit (AST * root, int parent) { vcg_assign_emit (root->astnode.forloop.start, parent); vcg_expr_emit (root->astnode.forloop.stop, parent); if (root->astnode.forloop.incr != NULL) { vcg_expr_emit (root->astnode.forloop.incr, parent); } /* emit_vcg (root->astnode.forloop.stmts, parent); */ } /***************************************************************************** * * * vcg_logicalif_emit * * * * Generates the graph nodes for a logical IF statement. * * * *****************************************************************************/ void vcg_logicalif_emit (AST * root, int parent) { if (root->astnode.logicalif.conds != NULL) vcg_expr_emit (root->astnode.logicalif.conds, parent); emit_vcg (root->astnode.logicalif.stmts,parent); } /***************************************************************************** * * * vcg_label_emit * * * * Generate the node for a label. * * * *****************************************************************************/ void vcg_label_emit (AST * root, int parent) { int my_node = node_num; sprintf(temp_buf,"Label (%d)",root->astnode.label.number); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); if (root->astnode.label.stmt != NULL) emit_vcg (root->astnode.label.stmt,my_node); } /***************************************************************************** * * * vcg_blockif_emit * * * * Generates the nodes for a Block IF statement. * * * *****************************************************************************/ void vcg_blockif_emit (AST * root, int parent) { AST *temp; if (root->astnode.blockif.conds != NULL) vcg_expr_emit (root->astnode.blockif.conds, parent); if (root->astnode.blockif.stmts != NULL) emit_vcg (root->astnode.blockif.stmts,parent); for(temp = root->astnode.blockif.elseifstmts; temp != NULL; temp = temp->nextstmt) vcg_elseif_emit (root->astnode.blockif.elseifstmts,parent); if (root->astnode.blockif.elsestmts != NULL) vcg_else_emit (root->astnode.blockif.elsestmts,parent); } /***************************************************************************** * * * vcg_elseif_emit * * * * Generates the nodes for an else if block. * * * *****************************************************************************/ void vcg_elseif_emit (AST * root, int parent) { if (root->astnode.blockif.conds != NULL) vcg_expr_emit (root->astnode.blockif.conds, parent); emit_vcg (root->astnode.blockif.stmts,parent); } /***************************************************************************** * * * vcg_else_emit * * * * Generates the nodes for an else if block. * * * *****************************************************************************/ void vcg_else_emit (AST * root, int parent) { emit_vcg (root->astnode.blockif.stmts,parent); } /***************************************************************************** * * * vcg_call_emit * * * * Generate the nodes for a function/subroutine call. * * * *****************************************************************************/ void vcg_call_emit (AST * root, int parent) { AST *temp; char *tempname; int my_node = node_num; assert (root != NULL); lowercase (root->astnode.ident.name); tempname = strdup (root->astnode.ident.name); *tempname = toupper (*tempname); sprintf(temp_buf,"Call (%s)",root->astnode.ident.name); print_vcg_node(vcgfp, node_num,temp_buf); print_vcg_edge(vcgfp, parent, my_node); assert (root->astnode.ident.arraylist != NULL); temp = root->astnode.ident.arraylist; while (temp->nextstmt != NULL) { vcg_expr_emit (temp, parent); temp = temp->nextstmt; } vcg_expr_emit (temp, parent); } /***************************************************************************** * * * vcg_spec_emit * * * * Generate the nodes for a specification statement. * * * *****************************************************************************/ void vcg_spec_emit (AST * root, int parent) { AST *assigntemp; int my_node = node_num; int temp_num; if(vcg_debug) printf("in vcg_spec_emit, my_node = %d, parent = %d\n", my_node,parent); print_vcg_node(vcgfp, node_num,"Specification"); print_vcg_edge(vcgfp, parent, my_node); /* I am reaching every case in this switch. */ switch (root->astnode.typeunit.specification) { /* PARAMETER in fortran corresponds to a class * constant in java, that has to be declared * class wide outside of any method. This is * currently not implemented, but the assignment * is made. */ case Parameter: assigntemp = root->astnode.typeunit.declist; for (; assigntemp; assigntemp = assigntemp->nextstmt) vcg_assign_emit (assigntemp, parent); break; case Intrinsic: temp_num = vcg_name_emit (root); print_vcg_edge(vcgfp, my_node, temp_num); break; case External: case Implicit: /* do nothing */ break; } } /***************************************************************************** * * * vcg_assign_emit * * * * Generate the nodes for an assignment statement. * * * *****************************************************************************/ void vcg_assign_emit (AST * root, int parent) { int temp_num; temp_num = vcg_name_emit (root->astnode.assignment.lhs); print_vcg_edge(vcgfp, parent,temp_num); vcg_expr_emit (root->astnode.assignment.rhs, parent); } f2j-0.8.1/src/y.tab.c0000600000077700002310000100607511031241064014224 0ustar seymourgraduate/* A Bison parser, made by GNU Bison 2.0. */ /* Skeleton parser for Yacc-like parsing with Bison, Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. 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, or (at your option) any later version. 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. */ /* As a special exception, when this file is copied by Bison into a Bison output file, you may use that output file without restriction. This special exception was added by the Free Software Foundation in version 1.24 of Bison. */ /* Written by Richard Stallman by simplifying the original so called ``semantic'' parser. */ /* All symbols defined below should begin with yy or YY, to avoid infringing on user name space. This should be done even for local variables, as they might otherwise be expanded by user macros. There are some unavoidable exceptions within include files to define necessary library symbols; they are noted "INFRINGES ON USER NAME SPACE" below. */ /* Identify Bison output. */ #define YYBISON 1 /* Skeleton name. */ #define YYSKELETON_NAME "yacc.c" /* Pure parsers. */ #define YYPURE 0 /* Using locations. */ #define YYLSP_NEEDED 0 /* Tokens. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE /* Put the tokens into the symbol table, so that GDB and other debuggers know about them. */ enum yytokentype { PLUS = 258, MINUS = 259, OP = 260, CP = 261, STAR = 262, POW = 263, DIV = 264, CAT = 265, CM = 266, EQ = 267, COLON = 268, NL = 269, NOT = 270, AND = 271, OR = 272, RELOP = 273, EQV = 274, NEQV = 275, NAME = 276, DOUBLE = 277, INTEGER = 278, E_EXPONENTIAL = 279, D_EXPONENTIAL = 280, CONST_EXP = 281, TrUE = 282, FaLSE = 283, ICON = 284, RCON = 285, LCON = 286, CCON = 287, FLOAT = 288, CHARACTER = 289, LOGICAL = 290, COMPLEX = 291, NONE = 292, IF = 293, THEN = 294, ELSE = 295, ELSEIF = 296, ENDIF = 297, DO = 298, GOTO = 299, ASSIGN = 300, TO = 301, CONTINUE = 302, STOP = 303, RDWR = 304, END = 305, ENDDO = 306, STRING = 307, CHAR = 308, PAUSE = 309, OPEN = 310, CLOSE = 311, BACKSPACE = 312, REWIND = 313, ENDFILE = 314, FORMAT = 315, PROGRAM = 316, FUNCTION = 317, SUBROUTINE = 318, ENTRY = 319, CALL = 320, RETURN = 321, ARITH_TYPE = 322, CHAR_TYPE = 323, DIMENSION = 324, INCLUDE = 325, COMMON = 326, EQUIVALENCE = 327, EXTERNAL = 328, PARAMETER = 329, INTRINSIC = 330, IMPLICIT = 331, SAVE = 332, DATA = 333, COMMENT = 334, READ = 335, WRITE = 336, PRINT = 337, FMT = 338, EDIT_DESC = 339, REPEAT = 340, OPEN_IOSTAT = 341, OPEN_ERR = 342, OPEN_FILE = 343, OPEN_STATUS = 344, OPEN_ACCESS = 345, OPEN_FORM = 346, OPEN_UNIT = 347, OPEN_RECL = 348, OPEN_BLANK = 349, LOWER_THAN_COMMENT = 350 }; #endif #define PLUS 258 #define MINUS 259 #define OP 260 #define CP 261 #define STAR 262 #define POW 263 #define DIV 264 #define CAT 265 #define CM 266 #define EQ 267 #define COLON 268 #define NL 269 #define NOT 270 #define AND 271 #define OR 272 #define RELOP 273 #define EQV 274 #define NEQV 275 #define NAME 276 #define DOUBLE 277 #define INTEGER 278 #define E_EXPONENTIAL 279 #define D_EXPONENTIAL 280 #define CONST_EXP 281 #define TrUE 282 #define FaLSE 283 #define ICON 284 #define RCON 285 #define LCON 286 #define CCON 287 #define FLOAT 288 #define CHARACTER 289 #define LOGICAL 290 #define COMPLEX 291 #define NONE 292 #define IF 293 #define THEN 294 #define ELSE 295 #define ELSEIF 296 #define ENDIF 297 #define DO 298 #define GOTO 299 #define ASSIGN 300 #define TO 301 #define CONTINUE 302 #define STOP 303 #define RDWR 304 #define END 305 #define ENDDO 306 #define STRING 307 #define CHAR 308 #define PAUSE 309 #define OPEN 310 #define CLOSE 311 #define BACKSPACE 312 #define REWIND 313 #define ENDFILE 314 #define FORMAT 315 #define PROGRAM 316 #define FUNCTION 317 #define SUBROUTINE 318 #define ENTRY 319 #define CALL 320 #define RETURN 321 #define ARITH_TYPE 322 #define CHAR_TYPE 323 #define DIMENSION 324 #define INCLUDE 325 #define COMMON 326 #define EQUIVALENCE 327 #define EXTERNAL 328 #define PARAMETER 329 #define INTRINSIC 330 #define IMPLICIT 331 #define SAVE 332 #define DATA 333 #define COMMENT 334 #define READ 335 #define WRITE 336 #define PRINT 337 #define FMT 338 #define EDIT_DESC 339 #define REPEAT 340 #define OPEN_IOSTAT 341 #define OPEN_ERR 342 #define OPEN_FILE 343 #define OPEN_STATUS 344 #define OPEN_ACCESS 345 #define OPEN_FORM 346 #define OPEN_UNIT 347 #define OPEN_RECL 348 #define OPEN_BLANK 349 #define LOWER_THAN_COMMENT 350 /* Copy the first part of user declarations. */ #line 8 "f2jparse.y" /***************************************************************************** * f2jparse * * * * This is a yacc parser for a subset of Fortran 77. It builds an AST * * which is used by codegen() to generate Java code. * * * *****************************************************************************/ #include #include #include #include #include"f2j.h" #include"f2j_externs.h" #include"f2jmem.h" /***************************************************************************** * Define YYDEBUG as 1 to get debugging output from yacc. * *****************************************************************************/ #define YYDEBUG 0 /***************************************************************************** * Global variables. * *****************************************************************************/ int debug = FALSE, /* set to TRUE for debugging output */ emittem = 1, /* set to 1 to emit Java, 0 to just parse */ len = 1, /* keeps track of the size of a data type */ temptok, /* temporary token for an inline expr */ save_all, /* is there a SAVE stmt without a var list */ cur_do_label; /* current 'do..end do' loop label */ AST * unit_args = NULL, /* pointer to args for this program unit */ * equivList = NULL; /* list to keep track of equivalences */ Dlist assign_labels, /* labels used in ASSIGN TO statements */ subroutine_names, /* holds the names of subroutines */ do_labels; /* generated labels for 'do..end do' loops */ enum returntype typedec_context = Object; /* what kind of type dec we are parsing */ /***************************************************************************** * Function prototypes: * *****************************************************************************/ METHODTAB * methodscan (METHODTAB *, char *); int yylex(void), intrinsic_or_implicit(char *), in_dlist_stmt_label(Dlist, AST *), in_dlist(Dlist, char *); double eval_const_expr(AST *); char * lowercase(char * ), * first_char_is_minus(char *), * unary_negate_string(char *), * tok2str(int ); void yyerror(char *), start_vcg(AST *), emit(AST *), jas_emit(AST *), init_tables(void), addEquiv(AST *), assign(AST *), typecheck(AST *), optScalar(AST *), type_insert (SYMTABLE * , AST * , enum returntype , char *), type_hash(AST *), merge_common_blocks(AST *), arg_table_load(AST *), exp_to_double (char *, char *), assign_function_return_type(AST *, AST *), insert_name(SYMTABLE *, AST *, enum returntype), store_array_var(AST *), initialize_implicit_table(ITAB_ENTRY *), printbits(char *, void *, int), print_sym_table_names(SYMTABLE *); AST * dl_astnode_examine(Dlist l), * addnode(void), * switchem(AST *), * gen_incr_expr(AST *, AST *), * gen_iter_expr(AST *, AST *, AST *), * initialize_name(char *), * process_typestmt(enum returntype, AST *), * process_array_declaration(AST *, AST *), * process_subroutine_call(AST *, AST *); SYMTABLE * new_symtable (int ); extern METHODTAB intrinsic_toks[]; ITAB_ENTRY implicit_table[26]; /* Enabling traces. */ #ifndef YYDEBUG # define YYDEBUG 1 #endif /* Enabling verbose error messages. */ #ifdef YYERROR_VERBOSE # undef YYERROR_VERBOSE # define YYERROR_VERBOSE 1 #else # define YYERROR_VERBOSE 0 #endif #if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED) #line 120 "f2jparse.y" typedef union YYSTYPE { struct ast_node *ptnode; int tok; enum returntype type; char lexeme[YYTEXTLEN]; } YYSTYPE; /* Line 190 of yacc.c. */ #line 385 "y.tab.c" # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 # define YYSTYPE_IS_TRIVIAL 1 #endif /* Copy the second part of user declarations. */ /* Line 213 of yacc.c. */ #line 397 "y.tab.c" #if ! defined (yyoverflow) || YYERROR_VERBOSE # ifndef YYFREE # define YYFREE free # endif # ifndef YYMALLOC # define YYMALLOC malloc # endif /* The parser invokes alloca or malloc; define the necessary symbols. */ # ifdef YYSTACK_USE_ALLOCA # if YYSTACK_USE_ALLOCA # ifdef __GNUC__ # define YYSTACK_ALLOC __builtin_alloca # else # define YYSTACK_ALLOC alloca # endif # endif # endif # ifdef YYSTACK_ALLOC /* Pacify GCC's `empty if-body' warning. */ # define YYSTACK_FREE(Ptr) do { /* empty */; } while (0) # else # if defined (__STDC__) || defined (__cplusplus) # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # endif # define YYSTACK_ALLOC YYMALLOC # define YYSTACK_FREE YYFREE # endif #endif /* ! defined (yyoverflow) || YYERROR_VERBOSE */ #if (! defined (yyoverflow) \ && (! defined (__cplusplus) \ || (defined (YYSTYPE_IS_TRIVIAL) && YYSTYPE_IS_TRIVIAL))) /* A type that is properly aligned for any stack member. */ union yyalloc { short int yyss; YYSTYPE yyvs; }; /* The size of the maximum gap between one aligned stack and the next. */ # define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) /* The size of an array large to enough to hold all stacks, each with N elements. */ # define YYSTACK_BYTES(N) \ ((N) * (sizeof (short int) + sizeof (YYSTYPE)) \ + YYSTACK_GAP_MAXIMUM) /* Copy COUNT objects from FROM to TO. The source and destination do not overlap. */ # ifndef YYCOPY # if defined (__GNUC__) && 1 < __GNUC__ # define YYCOPY(To, From, Count) \ __builtin_memcpy (To, From, (Count) * sizeof (*(From))) # else # define YYCOPY(To, From, Count) \ do \ { \ register YYSIZE_T yyi; \ for (yyi = 0; yyi < (Count); yyi++) \ (To)[yyi] = (From)[yyi]; \ } \ while (0) # endif # endif /* Relocate STACK from its old location to the new one. The local variables YYSIZE and YYSTACKSIZE give the old and new number of elements in the stack, and YYPTR gives the new location of the stack. Advance YYPTR to a properly aligned location for the next stack. */ # define YYSTACK_RELOCATE(Stack) \ do \ { \ YYSIZE_T yynewbytes; \ YYCOPY (&yyptr->Stack, Stack, yysize); \ Stack = &yyptr->Stack; \ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ yyptr += yynewbytes / sizeof (*yyptr); \ } \ while (0) #endif #if defined (__STDC__) || defined (__cplusplus) typedef signed char yysigned_char; #else typedef short int yysigned_char; #endif /* YYFINAL -- State number of the termination state. */ #define YYFINAL 25 /* YYLAST -- Last index in YYTABLE. */ #define YYLAST 1202 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 97 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 136 /* YYNRULES -- Number of rules. */ #define YYNRULES 305 /* YYNRULES -- Number of states. */ #define YYNSTATES 583 /* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ #define YYUNDEFTOK 2 #define YYMAXUTOK 350 #define YYTRANSLATE(YYX) \ ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ static const unsigned char yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 96, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95 }; #if YYDEBUG /* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in YYRHS. */ static const unsigned short int yyprhs[] = { 0, 0, 3, 5, 7, 10, 12, 14, 16, 18, 23, 28, 33, 37, 42, 46, 52, 57, 59, 61, 64, 66, 68, 70, 72, 74, 76, 78, 80, 82, 85, 87, 91, 95, 97, 101, 105, 111, 113, 117, 121, 123, 126, 131, 134, 137, 143, 147, 151, 155, 157, 161, 166, 168, 172, 174, 178, 181, 183, 187, 192, 194, 198, 200, 204, 206, 208, 211, 213, 217, 219, 227, 231, 237, 239, 242, 245, 247, 249, 251, 253, 255, 257, 259, 261, 263, 265, 267, 269, 271, 273, 275, 277, 279, 281, 283, 285, 287, 290, 296, 300, 302, 306, 308, 312, 316, 320, 324, 328, 332, 336, 340, 342, 344, 346, 348, 350, 355, 361, 365, 368, 372, 373, 378, 381, 383, 387, 391, 395, 397, 401, 403, 405, 409, 415, 417, 419, 421, 423, 425, 427, 431, 433, 437, 439, 441, 445, 447, 451, 457, 459, 461, 463, 465, 469, 471, 473, 478, 480, 484, 486, 488, 492, 494, 500, 504, 506, 511, 513, 515, 519, 522, 525, 529, 531, 536, 543, 546, 550, 555, 557, 560, 562, 564, 566, 568, 570, 574, 578, 580, 582, 584, 586, 588, 590, 592, 595, 599, 602, 611, 616, 621, 626, 629, 630, 632, 634, 638, 640, 644, 646, 650, 652, 656, 665, 676, 678, 682, 683, 685, 695, 707, 711, 723, 724, 726, 727, 729, 732, 740, 741, 745, 748, 750, 756, 767, 772, 779, 785, 791, 796, 798, 802, 803, 807, 811, 813, 817, 821, 823, 827, 829, 833, 835, 838, 840, 841, 846, 848, 851, 854, 858, 862, 864, 868, 872, 874, 878, 880, 884, 886, 888, 890, 892, 896, 898, 900, 902, 904, 906, 908, 910, 912, 914, 916, 918, 920, 922, 925, 928, 932, 935, 939, 943, 950, 958, 965, 973, 977, 979, 983, 989, 991, 995, 997, 1001 }; /* YYRHS -- A `-1'-separated list of the rules' RHS. */ static const short int yyrhs[] = { 98, 0, -1, 99, -1, 100, -1, 99, 100, -1, 101, -1, 102, -1, 103, -1, 135, -1, 104, 107, 133, 144, -1, 105, 107, 133, 144, -1, 106, 107, 133, 144, -1, 61, 160, 14, -1, 63, 160, 145, 14, -1, 63, 160, 14, -1, 153, 62, 160, 145, 14, -1, 62, 160, 145, 14, -1, 108, -1, 109, -1, 108, 109, -1, 110, -1, 112, -1, 115, -1, 118, -1, 232, -1, 148, -1, 231, -1, 228, -1, 119, -1, 124, 14, -1, 135, -1, 69, 111, 14, -1, 111, 11, 163, -1, 163, -1, 72, 113, 14, -1, 5, 114, 6, -1, 113, 11, 5, 114, 6, -1, 169, -1, 114, 11, 169, -1, 71, 116, 14, -1, 117, -1, 116, 117, -1, 9, 160, 9, 155, -1, 10, 155, -1, 77, 14, -1, 77, 9, 147, 9, 14, -1, 77, 147, 14, -1, 76, 120, 14, -1, 76, 37, 14, -1, 121, -1, 120, 11, 121, -1, 154, 5, 122, 6, -1, 123, -1, 122, 11, 123, -1, 160, -1, 160, 4, 160, -1, 78, 125, -1, 126, -1, 125, 11, 126, -1, 130, 9, 127, 9, -1, 128, -1, 127, 11, 128, -1, 129, -1, 129, 7, 129, -1, 216, -1, 160, -1, 4, 216, -1, 131, -1, 130, 11, 131, -1, 169, -1, 5, 169, 11, 160, 12, 132, 6, -1, 217, 11, 217, -1, 217, 11, 217, 11, 217, -1, 134, -1, 133, 134, -1, 168, 14, -1, 203, -1, 167, -1, 198, -1, 199, -1, 192, -1, 171, -1, 221, -1, 226, -1, 225, -1, 224, -1, 174, -1, 183, -1, 182, -1, 184, -1, 188, -1, 223, -1, 222, -1, 136, -1, 142, -1, 135, -1, 143, -1, 79, 14, -1, 55, 5, 137, 6, 14, -1, 137, 11, 138, -1, 138, -1, 92, 12, 139, -1, 139, -1, 86, 12, 141, -1, 87, 12, 217, -1, 88, 12, 140, -1, 89, 12, 140, -1, 90, 12, 140, -1, 91, 12, 140, -1, 93, 12, 204, -1, 94, 12, 140, -1, 204, -1, 7, -1, 160, -1, 162, -1, 160, -1, 160, 5, 170, 6, -1, 56, 5, 160, 6, 14, -1, 58, 160, 14, -1, 50, 14, -1, 217, 50, 14, -1, -1, 5, 146, 147, 6, -1, 5, 6, -1, 159, -1, 147, 11, 159, -1, 149, 155, 14, -1, 151, 157, 14, -1, 150, -1, 150, 166, 217, -1, 67, -1, 152, -1, 152, 166, 217, -1, 152, 166, 5, 166, 6, -1, 68, -1, 150, -1, 152, -1, 149, -1, 151, -1, 156, -1, 155, 11, 156, -1, 159, -1, 159, 166, 217, -1, 163, -1, 158, -1, 157, 11, 158, -1, 159, -1, 159, 166, 217, -1, 159, 166, 5, 166, 6, -1, 163, -1, 21, -1, 21, -1, 160, -1, 161, 11, 160, -1, 52, -1, 53, -1, 159, 5, 164, 6, -1, 165, -1, 164, 11, 165, -1, 204, -1, 166, -1, 204, 13, 204, -1, 7, -1, 45, 217, 46, 159, 14, -1, 169, 12, 204, -1, 159, -1, 159, 5, 170, 6, -1, 201, -1, 204, -1, 170, 11, 204, -1, 172, 173, -1, 43, 217, -1, 43, 217, 11, -1, 43, -1, 168, 11, 204, 14, -1, 168, 11, 204, 11, 204, 14, -1, 217, 134, -1, 217, 175, 14, -1, 60, 5, 176, 6, -1, 177, -1, 176, 177, -1, 178, -1, 179, -1, 180, -1, 84, -1, 160, -1, 160, 96, 216, -1, 5, 176, 6, -1, 162, -1, 181, -1, 11, -1, 9, -1, 10, -1, 13, -1, 217, -1, 3, 217, -1, 217, 47, 14, -1, 51, 14, -1, 81, 5, 186, 11, 187, 6, 189, 14, -1, 82, 217, 185, 14, -1, 82, 7, 185, 14, -1, 82, 162, 185, 14, -1, 11, 189, -1, -1, 204, -1, 7, -1, 83, 12, 217, -1, 217, -1, 83, 12, 7, -1, 7, -1, 83, 12, 162, -1, 162, -1, 83, 12, 160, -1, 80, 5, 186, 11, 187, 6, 189, 14, -1, 80, 5, 186, 11, 187, 11, 191, 6, 189, 14, -1, 190, -1, 189, 11, 190, -1, -1, 204, -1, 5, 202, 11, 159, 12, 204, 11, 204, 6, -1, 5, 202, 11, 159, 12, 204, 11, 204, 11, 204, 6, -1, 50, 12, 217, -1, 38, 5, 204, 6, 39, 14, 193, 194, 196, 197, 14, -1, -1, 133, -1, -1, 195, -1, 194, 195, -1, 41, 5, 204, 6, 39, 14, 133, -1, -1, 40, 14, 133, -1, 40, 14, -1, 42, -1, 38, 5, 204, 6, 134, -1, 38, 5, 204, 6, 217, 11, 217, 11, 217, 14, -1, 159, 5, 202, 6, -1, 159, 5, 204, 13, 204, 6, -1, 159, 5, 13, 204, 6, -1, 159, 5, 204, 13, 6, -1, 159, 5, 13, 6, -1, 204, -1, 202, 11, 204, -1, -1, 65, 200, 14, -1, 65, 160, 14, -1, 205, -1, 204, 19, 205, -1, 204, 20, 205, -1, 206, -1, 205, 17, 206, -1, 207, -1, 206, 16, 207, -1, 208, -1, 15, 208, -1, 210, -1, -1, 208, 18, 209, 208, -1, 211, -1, 4, 211, -1, 3, 211, -1, 210, 3, 211, -1, 210, 4, 211, -1, 212, -1, 211, 9, 212, -1, 211, 7, 212, -1, 213, -1, 213, 8, 212, -1, 214, -1, 213, 10, 214, -1, 159, -1, 216, -1, 200, -1, 201, -1, 5, 204, 6, -1, 27, -1, 28, -1, 217, -1, 219, -1, 218, -1, 220, -1, 215, -1, 162, -1, 23, -1, 22, -1, 33, -1, 24, -1, 25, -1, 66, 14, -1, 54, 14, -1, 54, 162, 14, -1, 48, 14, -1, 48, 162, 14, -1, 44, 217, 14, -1, 44, 5, 227, 6, 204, 14, -1, 44, 5, 227, 6, 11, 204, 14, -1, 44, 159, 5, 227, 6, 14, -1, 44, 159, 11, 5, 227, 6, 14, -1, 44, 159, 14, -1, 217, -1, 227, 11, 217, -1, 74, 5, 229, 6, 14, -1, 230, -1, 229, 11, 230, -1, 168, -1, 73, 161, 14, -1, 75, 161, 14, -1 }; /* YYRLINE[YYN] -- source line where rule number YYN was defined. */ static const unsigned short int yyrline[] = { 0, 200, 200, 244, 263, 285, 291, 297, 303, 311, 370, 445, 522, 543, 562, 582, 612, 639, 667, 671, 678, 682, 686, 690, 694, 698, 702, 706, 710, 714, 718, 724, 735, 741, 752, 762, 777, 794, 798, 805, 816, 820, 827, 863, 898, 910, 929, 950, 956, 965, 969, 975, 1014, 1018, 1025, 1032, 1041, 1050, 1054, 1061, 1089, 1093, 1100, 1104, 1120, 1124, 1141, 1159, 1163, 1170, 1174, 1184, 1194, 1213, 1217, 1224, 1229, 1234, 1239, 1244, 1249, 1254, 1259, 1264, 1269, 1274, 1279, 1284, 1289, 1294, 1299, 1304, 1309, 1314, 1319, 1324, 1329, 1336, 1346, 1355, 1357, 1361, 1366, 1371, 1376, 1381, 1386, 1391, 1396, 1401, 1406, 1413, 1418, 1425, 1427, 1431, 1433, 1437, 1444, 1451, 1458, 1488, 1488, 1497, 1508, 1515, 1532, 1536, 1542, 1547, 1556, 1563, 1568, 1575, 1584, 1591, 1595, 1601, 1605, 1617, 1624, 1632, 1637, 1642, 1649, 1656, 1664, 1669, 1674, 1679, 1699, 1759, 1779, 1783, 1790, 1801, 1814, 1820, 1834, 1846, 1850, 1854, 1868, 1876, 1901, 1914, 1920, 1956, 1962, 1969, 1981, 1990, 1995, 1999, 2024, 2038, 2060, 2070, 2100, 2108, 2118, 2140, 2144, 2148, 2154, 2160, 2164, 2171, 2182, 2186, 2193, 2198, 2203, 2208, 2215, 2219, 2234, 2245, 2259, 2301, 2316, 2330, 2346, 2351, 2359, 2364, 2376, 2380, 2384, 2392, 2400, 2404, 2408, 2420, 2462, 2508, 2515, 2522, 2527, 2531, 2552, 2576, 2590, 2617, 2618, 2624, 2625, 2629, 2637, 2649, 2650, 2657, 2663, 2676, 2686, 2719, 2725, 2740, 2754, 2768, 2793, 2803, 2810, 2818, 2840, 2856, 2860, 2872, 2886, 2890, 2904, 2908, 2922, 2926, 2937, 2941, 2941, 2955, 2959, 2986, 3001, 3015, 3031, 3035, 3049, 3066, 3070, 3082, 3086, 3102, 3103, 3108, 3109, 3110, 3130, 3138, 3150, 3154, 3158, 3162, 3166, 3170, 3176, 3187, 3197, 3216, 3230, 3245, 3251, 3257, 3264, 3270, 3277, 3289, 3300, 3313, 3324, 3335, 3347, 3351, 3358, 3368, 3372, 3379, 3471, 3482 }; #endif #if YYDEBUG || YYERROR_VERBOSE /* YYTNME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. First, the terminals, then, starting at YYNTOKENS, nonterminals. */ static const char *const yytname[] = { "$end", "error", "$undefined", "PLUS", "MINUS", "OP", "CP", "STAR", "POW", "DIV", "CAT", "CM", "EQ", "COLON", "NL", "NOT", "AND", "OR", "RELOP", "EQV", "NEQV", "NAME", "DOUBLE", "INTEGER", "E_EXPONENTIAL", "D_EXPONENTIAL", "CONST_EXP", "TrUE", "FaLSE", "ICON", "RCON", "LCON", "CCON", "FLOAT", "CHARACTER", "LOGICAL", "COMPLEX", "NONE", "IF", "THEN", "ELSE", "ELSEIF", "ENDIF", "DO", "GOTO", "ASSIGN", "TO", "CONTINUE", "STOP", "RDWR", "END", "ENDDO", "STRING", "CHAR", "PAUSE", "OPEN", "CLOSE", "BACKSPACE", "REWIND", "ENDFILE", "FORMAT", "PROGRAM", "FUNCTION", "SUBROUTINE", "ENTRY", "CALL", "RETURN", "ARITH_TYPE", "CHAR_TYPE", "DIMENSION", "INCLUDE", "COMMON", "EQUIVALENCE", "EXTERNAL", "PARAMETER", "INTRINSIC", "IMPLICIT", "SAVE", "DATA", "COMMENT", "READ", "WRITE", "PRINT", "FMT", "EDIT_DESC", "REPEAT", "OPEN_IOSTAT", "OPEN_ERR", "OPEN_FILE", "OPEN_STATUS", "OPEN_ACCESS", "OPEN_FORM", "OPEN_UNIT", "OPEN_RECL", "OPEN_BLANK", "LOWER_THAN_COMMENT", "'.'", "$accept", "F2java", "Sourcecodes", "Sourcecode", "Fprogram", "Fsubroutine", "Ffunction", "Program", "Subroutine", "Function", "Specstmts", "SpecStmtList", "Specstmt", "Dimension", "ArraydecList", "EquivalenceStmt", "EquivalenceList", "EquivalenceItem", "Common", "CommonList", "CommonSpec", "Save", "Implicit", "ImplicitSpecList", "ImplicitSpecItem", "ImplicitLetterList", "ImplicitLetter", "Data", "DataList", "DataItem", "DataConstantList", "DataConstantExpr", "DataConstant", "LhsList", "DataLhs", "LoopBounds", "Statements", "Statement", "Comment", "Open", "Olist", "OlistItem", "UnitSpec", "CharExp", "Ios", "Close", "Rewind", "End", "Functionargs", "@1", "Namelist", "Typestmt", "ArithTypes", "ArithSimpleType", "CharTypes", "CharSimpleType", "AnySimpleType", "AnyTypes", "ArithTypevarlist", "ArithTypevar", "CharTypevarlist", "CharTypevar", "Name", "UndeclaredName", "UndeclaredNamelist", "String", "Arraydeclaration", "Arraynamelist", "Arrayname", "Star", "StmtLabelAssign", "Assignment", "Lhs", "Arrayindexlist", "Doloop", "Do_incr", "Do_vals", "Label", "Format", "FormatExplist", "FormatExp", "RepeatableItem", "UnRepeatableItem", "FormatSeparator", "RepeatSpec", "Continue", "EndDo", "Write", "PrintIoList", "WriteFileDesc", "FormatSpec", "Read", "IoExplist", "IoExp", "EndSpec", "Blockif", "IfBlock", "Elseifs", "Elseif", "Else", "EndIf", "Logicalif", "Arithmeticif", "Subroutinecall", "SubstringOp", "Explist", "Call", "Exp", "log_disjunct", "log_term", "log_factor", "log_primary", "@2", "arith_expr", "term", "factor", "char_expr", "primary", "Boolean", "Constant", "Integer", "Double", "Float", "Exponential", "Return", "Pause", "Stop", "Goto", "ComputedGoto", "AssignedGoto", "Intlist", "Parameter", "Pdecs", "Pdec", "External", "Intrinsic", 0 }; #endif # ifdef YYPRINT /* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to token YYLEX-NUM. */ static const unsigned short int yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 46 }; # endif /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const unsigned char yyr1[] = { 0, 97, 98, 99, 99, 100, 100, 100, 100, 101, 102, 103, 104, 105, 105, 106, 106, 107, 108, 108, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 109, 110, 111, 111, 112, 113, 113, 114, 114, 115, 116, 116, 117, 117, 118, 118, 118, 119, 119, 120, 120, 121, 122, 122, 123, 123, 124, 125, 125, 126, 127, 127, 128, 128, 129, 129, 129, 130, 130, 131, 131, 132, 132, 133, 133, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 134, 135, 136, 137, 137, 138, 138, 138, 138, 138, 138, 138, 138, 138, 138, 139, 139, 140, 140, 141, 141, 142, 143, 144, 144, 146, 145, 145, 147, 147, 148, 148, 149, 149, 150, 151, 151, 151, 152, 153, 153, 154, 154, 155, 155, 156, 156, 156, 157, 157, 158, 158, 158, 158, 159, 160, 161, 161, 162, 162, 163, 164, 164, 165, 165, 165, 166, 167, 168, 169, 169, 169, 170, 170, 171, 172, 172, 172, 173, 173, 174, 174, 175, 176, 176, 177, 177, 177, 178, 178, 178, 178, 179, 179, 180, 180, 180, 180, 181, 181, 182, 183, 184, 184, 184, 184, 185, 185, 186, 186, 187, 187, 187, 187, 187, 187, 187, 188, 188, 189, 189, 189, 190, 190, 190, 191, 192, 193, 193, 194, 194, 194, 195, 196, 196, 196, 197, 198, 199, 200, 201, 201, 201, 201, 202, 202, 202, 203, 203, 204, 204, 204, 205, 205, 206, 206, 207, 207, 208, 209, 208, 210, 210, 210, 210, 210, 211, 211, 211, 212, 212, 213, 213, 214, 214, 214, 214, 214, 215, 215, 216, 216, 216, 216, 216, 216, 217, 218, 219, 220, 220, 221, 222, 222, 223, 223, 224, 225, 225, 226, 226, 226, 227, 227, 228, 229, 229, 230, 231, 232 }; /* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ static const unsigned char yyr2[] = { 0, 2, 1, 1, 2, 1, 1, 1, 1, 4, 4, 4, 3, 4, 3, 5, 4, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 3, 3, 1, 3, 3, 5, 1, 3, 3, 1, 2, 4, 2, 2, 5, 3, 3, 3, 1, 3, 4, 1, 3, 1, 3, 2, 1, 3, 4, 1, 3, 1, 3, 1, 1, 2, 1, 3, 1, 7, 3, 5, 1, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 5, 3, 1, 3, 1, 3, 3, 3, 3, 3, 3, 3, 3, 1, 1, 1, 1, 1, 4, 5, 3, 2, 3, 0, 4, 2, 1, 3, 3, 3, 1, 3, 1, 1, 3, 5, 1, 1, 1, 1, 1, 1, 3, 1, 3, 1, 1, 3, 1, 3, 5, 1, 1, 1, 1, 3, 1, 1, 4, 1, 3, 1, 1, 3, 1, 5, 3, 1, 4, 1, 1, 3, 2, 2, 3, 1, 4, 6, 2, 3, 4, 1, 2, 1, 1, 1, 1, 1, 3, 3, 1, 1, 1, 1, 1, 1, 1, 2, 3, 2, 8, 4, 4, 4, 2, 0, 1, 1, 3, 1, 3, 1, 3, 1, 3, 8, 10, 1, 3, 0, 1, 9, 11, 3, 11, 0, 1, 0, 1, 2, 7, 0, 3, 2, 1, 5, 10, 4, 6, 5, 5, 4, 1, 3, 0, 3, 3, 1, 3, 3, 1, 3, 1, 3, 1, 2, 1, 0, 4, 1, 2, 2, 3, 3, 1, 3, 3, 1, 3, 1, 3, 1, 1, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 3, 2, 3, 3, 6, 7, 6, 7, 3, 1, 3, 5, 1, 3, 1, 3, 3 }; /* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state STATE-NUM when YYTABLE doesn't specify something else to do. Zero means the default is an error. */ static const unsigned short int yydefact[] = { 0, 0, 0, 0, 130, 134, 0, 0, 2, 3, 5, 6, 7, 0, 0, 0, 8, 135, 136, 0, 151, 0, 0, 0, 97, 1, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 18, 20, 21, 22, 23, 28, 0, 30, 25, 0, 128, 0, 131, 27, 26, 24, 0, 0, 0, 12, 121, 0, 14, 0, 150, 0, 0, 33, 0, 0, 0, 40, 0, 0, 152, 0, 0, 0, 0, 0, 49, 137, 138, 0, 0, 44, 0, 124, 0, 56, 57, 0, 67, 165, 69, 167, 282, 0, 173, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 73, 95, 93, 94, 96, 77, 0, 0, 81, 0, 86, 88, 87, 89, 90, 80, 78, 79, 76, 0, 82, 92, 91, 85, 84, 83, 19, 29, 0, 139, 141, 143, 162, 0, 0, 144, 146, 149, 0, 0, 0, 0, 123, 0, 16, 13, 0, 31, 0, 0, 43, 39, 41, 0, 37, 0, 34, 0, 304, 303, 0, 301, 305, 48, 0, 47, 0, 0, 0, 46, 0, 0, 0, 0, 0, 0, 171, 0, 0, 0, 0, 290, 154, 155, 0, 197, 288, 0, 0, 0, 0, 150, 0, 0, 0, 287, 0, 0, 203, 203, 203, 0, 74, 9, 0, 75, 0, 0, 170, 0, 0, 176, 0, 0, 126, 0, 129, 0, 127, 0, 0, 132, 10, 11, 0, 0, 32, 0, 0, 0, 0, 283, 285, 286, 274, 275, 284, 269, 281, 0, 157, 160, 271, 272, 159, 245, 248, 250, 252, 254, 257, 262, 265, 267, 280, 270, 276, 278, 277, 279, 0, 35, 0, 0, 153, 0, 0, 50, 0, 52, 54, 0, 125, 0, 58, 0, 0, 60, 62, 65, 64, 68, 0, 0, 168, 0, 172, 298, 0, 0, 0, 297, 292, 0, 291, 289, 112, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 100, 102, 111, 0, 118, 242, 244, 243, 205, 0, 204, 0, 217, 0, 0, 0, 119, 0, 164, 0, 196, 0, 177, 140, 142, 145, 0, 147, 0, 15, 122, 259, 258, 0, 253, 242, 156, 0, 0, 0, 0, 0, 0, 255, 0, 0, 0, 0, 0, 0, 42, 38, 0, 300, 302, 51, 0, 0, 45, 0, 66, 59, 0, 0, 239, 0, 166, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 240, 0, 0, 242, 202, 215, 218, 200, 201, 199, 120, 0, 0, 0, 191, 192, 190, 193, 184, 185, 188, 0, 179, 181, 182, 183, 189, 194, 0, 133, 273, 240, 158, 161, 246, 247, 249, 251, 0, 260, 261, 264, 263, 266, 268, 36, 53, 55, 0, 61, 63, 237, 169, 238, 0, 0, 233, 0, 0, 0, 299, 0, 0, 163, 103, 115, 104, 105, 113, 114, 106, 107, 108, 101, 109, 110, 98, 99, 117, 235, 0, 209, 0, 211, 0, 207, 0, 0, 240, 0, 0, 174, 195, 0, 0, 178, 180, 148, 256, 0, 0, 236, 223, 0, 0, 293, 295, 0, 0, 241, 0, 217, 0, 217, 0, 216, 0, 187, 186, 70, 0, 224, 225, 0, 294, 296, 0, 168, 208, 212, 210, 206, 0, 0, 0, 0, 269, 175, 71, 0, 229, 226, 0, 116, 213, 0, 217, 198, 0, 0, 0, 0, 227, 0, 0, 221, 0, 0, 72, 0, 231, 232, 0, 234, 214, 0, 0, 230, 222, 0, 0, 219, 0, 0, 0, 228, 220 }; /* YYDEFGOTO[NTERM-NUM]. */ static const short int yydefgoto[] = { -1, 7, 8, 9, 10, 11, 12, 13, 14, 15, 36, 37, 38, 39, 63, 40, 71, 164, 41, 68, 69, 42, 43, 77, 78, 279, 280, 44, 87, 88, 287, 288, 289, 89, 90, 505, 110, 111, 112, 113, 317, 318, 319, 473, 470, 114, 115, 214, 59, 154, 84, 46, 47, 48, 49, 50, 19, 81, 139, 140, 145, 146, 248, 474, 73, 249, 142, 250, 251, 252, 116, 117, 118, 294, 119, 120, 219, 121, 223, 427, 428, 429, 430, 431, 432, 122, 123, 124, 331, 327, 490, 125, 410, 411, 540, 126, 528, 546, 547, 559, 568, 127, 128, 253, 254, 405, 129, 412, 256, 257, 258, 259, 444, 260, 261, 262, 263, 264, 265, 266, 267, 268, 269, 270, 131, 132, 133, 134, 135, 136, 299, 51, 171, 172, 52, 53 }; /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ #define YYPACT_NINF -452 static const short int yypact[] = { 150, 17, 17, 17, -452, -452, 80, 114, 150, -452, -452, -452, -452, 1116, 1116, 1116, -452, -452, -452, 44, -452, 112, 131, 106, -452, -452, -452, 125, 323, 165, 17, 171, 17, 96, 135, 20, 783, 1116, -452, -452, -452, -452, -452, -452, 184, -452, -452, 125, 198, 125, 198, -452, -452, -452, 783, 783, 17, -452, 177, 205, -452, 222, -452, 51, 220, -452, 17, 125, 320, -452, 125, 70, -452, 231, 125, 294, 254, 298, -452, -452, -452, 274, 125, -452, 328, -452, 125, 330, -452, 313, -452, 301, -452, -452, -452, 354, 332, 84, 332, 21, 359, 47, 378, 403, 17, 345, 443, 456, 465, 27, 737, -452, -452, -452, -452, -452, -452, 460, 468, -452, 125, -452, -452, -452, -452, -452, -452, -452, -452, -452, 718, -452, -452, -452, -452, -452, -452, -452, -452, 410, -452, 384, -452, -452, 332, 416, -452, 384, -452, 40, 737, 737, 131, -452, 125, -452, -452, 125, -452, 851, 481, 483, -452, -452, 81, -452, 487, -452, 17, -452, -452, 232, -452, -452, -452, 355, -452, 17, 389, 125, -452, 486, 20, 157, 20, 884, 1082, 488, 332, 111, 484, 461, -452, -452, -452, 494, -452, -452, 495, 661, 17, 500, 501, 496, 504, 505, -452, 917, 917, 509, 509, 509, 507, -452, -452, 216, -452, 1082, 511, -452, 510, 518, -452, 513, 125, -452, 332, -452, 125, -452, 92, 198, -452, -452, -452, 514, 247, -452, 1149, 1149, 1082, 1128, -452, -452, -452, -452, -452, -452, 520, -452, 269, -452, -452, -452, -452, 176, 515, 517, -452, 512, 435, 453, -452, 455, -452, -452, -452, -452, -452, -452, -452, 125, -452, 125, 125, -452, 521, 125, -452, 329, -452, 530, 522, -452, 17, -452, 357, 458, -452, 531, -452, -452, -452, 950, 342, 211, 134, -452, -452, 350, 332, 532, -452, -452, 125, -452, -452, -452, 529, 533, 536, 538, 541, 544, 546, 548, 549, 352, -452, -452, 428, 537, -452, 1082, -452, -452, -452, 551, 428, 555, 1115, 528, 554, 558, -452, 559, 428, 1082, -452, 392, -452, -452, -452, -452, 198, -452, 569, -452, -452, 453, 453, 152, 512, 884, -452, 851, 1082, 1082, 1082, 1082, 1082, -452, 1149, 1149, 1149, 1149, 1149, 1149, 483, -452, 361, -452, -452, -452, 17, 17, -452, 566, -452, -452, 157, 157, -452, 214, -452, 1082, 983, 526, 1016, 332, 381, 332, 565, 17, 332, 33, 33, 33, 33, 1049, 1082, 33, 573, 661, 574, 393, 428, 19, 19, 1082, 572, -452, 428, -452, -452, -452, -452, 180, 332, 392, -452, -452, -452, -452, -452, 498, -452, 341, -452, -452, -452, -452, -452, -452, 584, -452, -452, 211, -452, 428, 515, 515, 517, -452, 1128, 453, 453, -452, -452, -452, -452, -452, -452, -452, 332, -452, -452, -452, 428, -452, 229, 581, -452, 652, 1082, 264, -452, 582, 400, -452, -452, 592, -452, -452, -452, -452, -452, -452, -452, -452, 428, -452, -452, -452, -452, -452, 1082, -452, 586, -452, 401, -452, 594, 590, 152, 1115, 1082, -452, -452, 365, 357, -452, -452, -452, 591, 596, 599, -452, 783, 332, 271, -452, -452, 597, 1082, 428, 23, 1115, 562, 1115, 1082, -452, 280, -452, -452, -452, 332, 783, 575, 602, -452, -452, 408, 428, -452, -452, -452, -452, 417, 603, 608, 421, 55, -452, 607, 614, 402, -452, 332, -452, -452, 332, 1115, -452, 1082, 332, 1082, 606, -452, 579, 610, -452, 423, 203, -452, 267, 783, -452, 612, -452, -452, 1082, 583, 783, -452, 71, 613, -452, 1082, 783, 295, 783, -452 }; /* YYPGOTO[NTERM-NUM]. */ static const short int yypgoto[] = { -452, -452, -452, 621, -452, -452, -452, -452, -452, -452, 439, -452, 593, -452, -452, -452, -452, 360, -452, -452, 563, -452, -452, -452, 462, -452, 259, -452, -452, 454, -452, 258, 260, -452, 463, -452, -53, -94, 104, -452, -452, 236, 241, -80, -452, -452, -452, 322, -2, -452, -59, -452, -28, 143, -16, 169, -452, -452, -63, 418, -452, 420, -27, 136, 617, -70, -12, -452, 289, 1, -452, -62, -17, 132, -452, -452, -452, -452, -452, 226, -403, -452, -452, -452, -452, -452, -452, -452, 272, 445, 243, -452, -451, 159, -452, -452, -452, -452, 109, -452, -452, -452, -452, 556, -22, 251, -452, 103, 120, 303, 307, -238, -452, -452, -228, 86, -452, 302, -452, -177, 77, -452, -452, -452, -452, -452, -452, -452, -452, -452, -281, -452, -452, 394, -452, -452 }; /* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If positive, shift that token. If negative, reduce the rule which number is the opposite. If zero, do what YYDEFACT says. If YYTABLE_NINF, syntax error. */ #define YYTABLE_NINF -152 static const short int yytable[] = { 64, 150, 151, 352, 161, 79, 291, 85, 91, 91, 349, 350, 170, 93, 93, 65, 213, 80, 92, 390, 141, 61, 147, 178, 502, 86, 487, 91, 91, 195, 534, 198, 93, 93, 209, 192, 222, 148, 20, 210, 141, 62, 94, 91, 20, 231, 94, 91, 93, 144, 94, 149, 93, 165, 20, 85, 213, 213, 218, 91, 353, 197, 157, 94, 93, 158, 538, 554, 541, 181, 189, 193, 194, 193, 194, 193, 194, 577, 203, 193, 194, 166, 578, 91, 167, 193, 194, 272, 93, 188, 357, 358, 273, 91, 24, 236, 502, 344, 93, 193, 194, 562, 488, 91, 16, 62, 56, 94, 93, 378, 468, 58, 16, 130, 25, 94, 300, 45, 45, 45, 60, 222, 301, 91, 91, 302, 57, 85, 93, 93, 64, 130, 130, 76, 445, 446, 58, 21, 22, 23, 387, 45, 226, 17, 82, 237, 62, 79, 230, 83, 235, 17, 283, 357, 358, 91, 62, 91, 436, 80, 93, 286, 93, 4, 5, 92, 72, 92, 72, 18, 70, 357, 358, 187, 190, 191, 74, 18, 20, 242, 94, 243, 244, 153, 245, 246, 211, 215, 91, 356, 247, 496, 152, 93, 497, 357, 358, 141, 138, 357, 358, 147, 160, 291, 291, 143, 504, 130, 368, 193, 194, 1, 2, 3, 571, 170, 148, 4, 5, 155, 457, 227, 357, 358, 386, 159, 232, 215, 215, 6, 357, 358, 346, 357, 358, 507, 156, 62, 276, 94, 201, 204, 168, 277, 141, 169, 91, 91, 357, 358, 91, 93, 93, 348, 95, 93, 369, 165, 179, 96, 97, 98, 255, 220, 99, 298, 335, 100, 174, 426, 101, 102, 103, 572, 104, 354, 221, 392, 511, 177, 355, 105, 106, 357, 358, 530, 357, 358, 295, 296, 357, 358, 130, 462, 543, 6, 107, 108, 109, 357, 358, 582, 320, 342, 275, 168, 185, 345, 173, 175, 328, 328, 176, 281, 357, 358, 476, 477, 478, 290, 336, 481, 183, 524, 184, 475, 475, 475, 475, 66, 67, 475, 66, 67, 162, 373, 321, 489, 489, 179, 374, 182, 180, 351, 418, 434, 419, 501, 384, 426, 420, 421, 422, 385, 423, 94, 388, 426, 402, 186, 91, 389, 20, 403, 94, 93, 202, 451, 418, 222, 419, 523, 273, 196, 420, 421, 422, 298, 423, 242, 94, 243, 244, 199, 245, 246, 20, 467, 94, 159, 247, 143, 389, 193, 194, 418, 383, 419, 282, 485, 179, 420, 421, 422, 486, 423, 513, 517, 200, 193, 194, 389, 518, 20, 549, 94, 433, 193, 194, 385, 377, 224, 4, 5, 225, 424, 406, 228, 495, 426, 229, 550, 495, 213, 495, 553, 91, 570, 362, 363, 417, 93, 557, 545, 193, 194, 536, 357, 358, 424, 447, 448, 449, 54, 55, 527, 437, 206, 255, 439, 364, 207, 365, 366, 463, 367, 466, 379, 298, 380, 208, 472, 233, 234, 216, 425, 424, 440, 441, 213, 217, 91, 332, 333, 491, 491, 93, 213, 458, 460, 271, 465, 274, 542, 224, 498, 433, 284, 303, 297, 91, 323, 320, 480, 433, 93, 320, 304, 305, 306, 281, 453, 494, 573, 322, -151, 290, 290, 324, 325, 330, 334, 337, 339, 338, 353, 581, 340, 347, 471, 361, 506, 359, 360, 375, 371, 376, 391, 381, 91, 130, 393, 413, 404, 93, 394, 91, 62, 395, 94, 396, 93, 91, 397, 91, 425, 398, 93, 399, 93, 400, 401, 407, 425, 95, 461, 408, 510, 414, 96, 97, 98, 415, 416, 99, 435, 433, 100, 454, 469, 101, 102, 103, 495, 104, 130, 529, 482, 484, 515, 503, 105, 106, 537, 500, 508, 512, 514, 516, 522, 519, 520, 525, 544, 130, 6, 107, 108, 109, -152, 526, 531, 539, 548, 552, 551, 545, 533, 555, 556, 566, 567, 576, 515, 569, 560, 574, 579, 561, 26, 137, 163, 564, 452, 370, 425, 285, 278, 455, 483, 479, 456, 341, 130, 438, 499, 532, 292, 343, 75, 130, 492, 535, 329, 521, 558, 130, 563, 130, 565, 493, 205, 442, 509, 238, 239, 240, 443, 307, 450, 0, 372, 0, 62, 575, 94, 241, 0, 0, 0, 0, 580, 62, 242, 94, 243, 244, 0, 245, 246, 95, 0, 0, 0, 247, 96, 97, 98, 0, 220, 99, 0, 0, 100, 0, 0, 101, 102, 103, 0, 104, 0, 221, 193, 194, 0, 0, 105, 106, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 107, 108, 109, 0, 0, 0, 0, 62, 0, 94, 0, 0, 0, 0, 0, 308, 309, 310, 311, 312, 313, 314, 315, 316, 95, 0, 62, 0, 94, 96, 97, 98, 0, 220, 99, 0, 0, 100, 0, 0, 101, 102, 103, 95, 104, 0, 221, 0, 96, 97, 98, 105, 106, 99, 0, 212, 100, 0, 0, 101, 102, 103, 0, 104, 0, 6, 107, 108, 109, 0, 105, 106, 62, 0, 94, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 107, 108, 109, 0, 95, 0, 0, 0, 0, 96, 97, 98, 0, 0, 99, 0, 0, 100, 0, 0, 101, 102, 103, 0, 104, 0, 0, 0, 0, 0, 0, 105, 106, 0, 0, 0, 0, 238, 239, 240, 0, 143, 0, 0, 0, 6, 107, 108, 109, 241, 0, 0, 0, 0, 0, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 0, 0, 0, 0, 0, 0, 0, 293, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 0, 326, 0, 0, 0, 0, 0, 0, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 382, 0, 0, 0, 0, 0, 0, 0, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 459, 0, 0, 0, 0, 0, 0, 0, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 0, 0, 0, 0, 0, 464, 0, 0, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 0, 307, 0, 0, 0, 0, 0, 0, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 240, 0, 0, 0, 0, 0, 0, 0, 0, 0, 241, 0, 0, 0, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 0, 0, 238, 239, 409, 0, 0, 0, 0, 0, 0, 0, 0, 0, 241, 238, 239, 240, 193, 194, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 0, 0, 247, 62, 242, 94, 243, 244, 240, 245, 246, 0, 0, 0, 0, 247, 0, 0, 0, 0, 0, 193, 194, 0, 62, 242, 94, 243, 244, 0, 245, 246, 0, 0, 193, 194, 247, 4, 5, 27, 0, 28, 29, 30, 31, 32, 33, 34, 35, 6, 0, 0, 0, 0, 0, 193, 194 }; static const short int yycheck[] = { 27, 54, 55, 241, 67, 33, 183, 34, 35, 36, 238, 239, 74, 35, 36, 27, 110, 33, 35, 300, 47, 23, 49, 82, 427, 5, 7, 54, 55, 99, 7, 101, 54, 55, 7, 14, 130, 49, 21, 109, 67, 21, 23, 70, 21, 5, 23, 74, 70, 48, 23, 50, 74, 70, 21, 82, 150, 151, 120, 86, 5, 14, 11, 23, 86, 14, 517, 12, 519, 86, 97, 52, 53, 52, 53, 52, 53, 6, 105, 52, 53, 11, 11, 110, 14, 52, 53, 6, 110, 5, 19, 20, 11, 120, 14, 154, 499, 5, 120, 52, 53, 552, 83, 130, 0, 21, 62, 23, 130, 286, 391, 5, 8, 36, 0, 23, 5, 13, 14, 15, 14, 215, 11, 150, 151, 14, 14, 154, 150, 151, 157, 54, 55, 37, 362, 363, 5, 1, 2, 3, 6, 37, 141, 0, 9, 157, 21, 175, 147, 14, 152, 8, 179, 19, 20, 182, 21, 184, 6, 175, 182, 4, 184, 67, 68, 182, 30, 184, 32, 0, 5, 19, 20, 96, 97, 98, 5, 8, 21, 22, 23, 24, 25, 6, 27, 28, 109, 110, 215, 13, 33, 11, 56, 215, 14, 19, 20, 224, 14, 19, 20, 228, 66, 380, 381, 7, 444, 130, 271, 52, 53, 61, 62, 63, 11, 277, 228, 67, 68, 14, 6, 144, 19, 20, 13, 5, 149, 150, 151, 79, 19, 20, 231, 19, 20, 6, 14, 21, 6, 23, 104, 105, 11, 11, 271, 14, 273, 274, 19, 20, 277, 273, 274, 6, 38, 277, 273, 274, 11, 43, 44, 45, 159, 47, 48, 188, 50, 51, 14, 339, 54, 55, 56, 6, 58, 6, 60, 304, 14, 5, 11, 65, 66, 19, 20, 14, 19, 20, 185, 186, 19, 20, 215, 387, 14, 79, 80, 81, 82, 19, 20, 6, 199, 226, 168, 11, 5, 230, 14, 11, 207, 208, 14, 177, 19, 20, 396, 397, 398, 183, 217, 401, 9, 500, 11, 395, 396, 397, 398, 9, 10, 401, 9, 10, 14, 6, 200, 407, 408, 11, 11, 11, 14, 240, 3, 344, 5, 6, 6, 419, 9, 10, 11, 11, 13, 23, 6, 427, 6, 5, 387, 11, 21, 11, 23, 387, 21, 6, 3, 463, 5, 6, 11, 14, 9, 10, 11, 300, 13, 22, 23, 24, 25, 5, 27, 28, 21, 6, 23, 5, 33, 7, 11, 52, 53, 3, 293, 5, 9, 6, 11, 9, 10, 11, 11, 13, 6, 6, 5, 52, 53, 11, 11, 21, 6, 23, 339, 52, 53, 11, 284, 11, 67, 68, 14, 84, 323, 11, 11, 499, 14, 14, 11, 527, 11, 14, 463, 14, 3, 4, 337, 463, 40, 41, 52, 53, 516, 19, 20, 84, 364, 365, 366, 14, 15, 508, 353, 14, 355, 356, 7, 5, 9, 8, 387, 10, 389, 9, 391, 11, 5, 394, 150, 151, 14, 339, 84, 357, 358, 573, 12, 508, 210, 211, 407, 408, 508, 581, 385, 386, 9, 388, 5, 520, 11, 418, 419, 11, 14, 11, 527, 5, 399, 400, 427, 527, 403, 46, 14, 14, 374, 375, 409, 566, 14, 14, 380, 381, 14, 14, 11, 14, 11, 5, 14, 5, 579, 14, 14, 393, 18, 454, 17, 16, 4, 14, 14, 5, 7, 566, 463, 12, 14, 6, 566, 12, 573, 21, 12, 23, 12, 573, 579, 12, 581, 419, 12, 579, 12, 581, 12, 12, 11, 427, 38, 39, 11, 464, 14, 43, 44, 45, 14, 14, 48, 6, 499, 51, 12, 14, 54, 55, 56, 11, 58, 508, 509, 14, 14, 486, 6, 65, 66, 516, 96, 14, 14, 5, 12, 496, 6, 11, 6, 526, 527, 79, 80, 81, 82, 18, 11, 14, 50, 11, 6, 12, 41, 514, 11, 5, 14, 42, 39, 520, 14, 548, 14, 14, 551, 8, 37, 68, 555, 374, 274, 499, 182, 175, 380, 403, 399, 381, 224, 566, 355, 419, 514, 184, 228, 32, 573, 408, 516, 208, 495, 546, 579, 554, 581, 556, 409, 105, 359, 11, 3, 4, 5, 360, 7, 367, -1, 277, -1, 21, 571, 23, 15, -1, -1, -1, -1, 578, 21, 22, 23, 24, 25, -1, 27, 28, 38, -1, -1, -1, 33, 43, 44, 45, -1, 47, 48, -1, -1, 51, -1, -1, 54, 55, 56, -1, 58, -1, 60, 52, 53, -1, -1, 65, 66, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, 80, 81, 82, -1, -1, -1, -1, 21, -1, 23, -1, -1, -1, -1, -1, 86, 87, 88, 89, 90, 91, 92, 93, 94, 38, -1, 21, -1, 23, 43, 44, 45, -1, 47, 48, -1, -1, 51, -1, -1, 54, 55, 56, 38, 58, -1, 60, -1, 43, 44, 45, 65, 66, 48, -1, 50, 51, -1, -1, 54, 55, 56, -1, 58, -1, 79, 80, 81, 82, -1, 65, 66, 21, -1, 23, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, 80, 81, 82, -1, 38, -1, -1, -1, -1, 43, 44, 45, -1, -1, 48, -1, -1, 51, -1, -1, 54, 55, 56, -1, 58, -1, -1, -1, -1, -1, -1, 65, 66, -1, -1, -1, -1, 3, 4, 5, -1, 7, -1, -1, -1, 79, 80, 81, 82, 15, -1, -1, -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, 13, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, -1, 7, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, 6, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, 11, -1, -1, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, -1, 7, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, -1, -1, -1, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, -1, -1, 3, 4, 5, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, 3, 4, 5, 52, 53, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, -1, -1, 33, 21, 22, 23, 24, 25, 5, 27, 28, -1, -1, -1, -1, 33, -1, -1, -1, -1, -1, 52, 53, -1, 21, 22, 23, 24, 25, -1, 27, 28, -1, -1, 52, 53, 33, 67, 68, 69, -1, 71, 72, 73, 74, 75, 76, 77, 78, 79, -1, -1, -1, -1, -1, 52, 53 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const unsigned char yystos[] = { 0, 61, 62, 63, 67, 68, 79, 98, 99, 100, 101, 102, 103, 104, 105, 106, 135, 150, 152, 153, 21, 160, 160, 160, 14, 0, 100, 69, 71, 72, 73, 74, 75, 76, 77, 78, 107, 108, 109, 110, 112, 115, 118, 119, 124, 135, 148, 149, 150, 151, 152, 228, 231, 232, 107, 107, 62, 14, 5, 145, 14, 145, 21, 111, 159, 163, 9, 10, 116, 117, 5, 113, 160, 161, 5, 161, 37, 120, 121, 149, 151, 154, 9, 14, 147, 159, 5, 125, 126, 130, 131, 159, 169, 201, 23, 38, 43, 44, 45, 48, 51, 54, 55, 56, 58, 65, 66, 80, 81, 82, 133, 134, 135, 136, 142, 143, 167, 168, 169, 171, 172, 174, 182, 183, 184, 188, 192, 198, 199, 203, 217, 221, 222, 223, 224, 225, 226, 109, 14, 155, 156, 159, 163, 7, 166, 157, 158, 159, 163, 166, 133, 133, 160, 6, 146, 14, 14, 11, 14, 5, 160, 155, 14, 117, 114, 169, 11, 14, 11, 14, 168, 229, 230, 14, 14, 11, 14, 5, 147, 11, 14, 169, 11, 9, 11, 5, 5, 217, 5, 159, 217, 217, 14, 52, 53, 162, 14, 14, 162, 5, 5, 160, 21, 159, 160, 200, 14, 5, 5, 7, 162, 217, 50, 134, 144, 217, 14, 12, 168, 173, 47, 60, 134, 175, 11, 14, 166, 217, 11, 14, 166, 5, 217, 144, 144, 145, 147, 163, 3, 4, 5, 15, 22, 24, 25, 27, 28, 33, 159, 162, 164, 165, 166, 200, 201, 204, 205, 206, 207, 208, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 9, 6, 11, 5, 160, 6, 11, 121, 122, 123, 160, 9, 159, 11, 126, 4, 127, 128, 129, 160, 216, 131, 13, 170, 204, 204, 11, 217, 227, 5, 11, 14, 14, 46, 14, 14, 7, 86, 87, 88, 89, 90, 91, 92, 93, 94, 137, 138, 139, 204, 160, 14, 5, 14, 14, 7, 186, 204, 186, 11, 185, 185, 185, 14, 50, 204, 11, 14, 5, 14, 156, 217, 158, 5, 217, 166, 14, 6, 211, 211, 204, 208, 5, 6, 11, 13, 19, 20, 17, 16, 18, 3, 4, 7, 9, 8, 10, 155, 169, 114, 14, 230, 6, 11, 4, 14, 160, 216, 9, 11, 7, 6, 204, 6, 11, 13, 6, 6, 11, 227, 5, 159, 12, 12, 12, 12, 12, 12, 12, 12, 12, 6, 11, 6, 202, 204, 11, 11, 5, 189, 190, 204, 14, 14, 14, 14, 204, 3, 5, 9, 10, 11, 13, 84, 160, 162, 176, 177, 178, 179, 180, 181, 217, 166, 6, 6, 204, 165, 204, 205, 205, 206, 207, 209, 211, 211, 212, 212, 212, 214, 6, 123, 160, 12, 128, 129, 6, 204, 6, 204, 39, 134, 217, 11, 204, 217, 6, 227, 14, 141, 160, 217, 140, 160, 162, 140, 140, 140, 139, 204, 140, 14, 138, 14, 6, 11, 7, 83, 162, 187, 217, 187, 202, 204, 11, 11, 14, 217, 176, 96, 6, 177, 6, 208, 132, 217, 6, 14, 11, 204, 14, 14, 6, 5, 204, 12, 6, 11, 6, 11, 190, 204, 6, 216, 6, 11, 133, 193, 217, 14, 14, 170, 204, 7, 160, 162, 217, 189, 50, 191, 189, 159, 14, 217, 41, 194, 195, 11, 6, 14, 12, 6, 14, 12, 11, 5, 40, 195, 196, 217, 217, 189, 204, 217, 204, 14, 42, 197, 14, 14, 11, 6, 133, 14, 204, 39, 6, 11, 14, 204, 133, 6 }; #if ! defined (YYSIZE_T) && defined (__SIZE_TYPE__) # define YYSIZE_T __SIZE_TYPE__ #endif #if ! defined (YYSIZE_T) && defined (size_t) # define YYSIZE_T size_t #endif #if ! defined (YYSIZE_T) # if defined (__STDC__) || defined (__cplusplus) # include /* INFRINGES ON USER NAME SPACE */ # define YYSIZE_T size_t # endif #endif #if ! defined (YYSIZE_T) # define YYSIZE_T unsigned int #endif #define yyerrok (yyerrstatus = 0) #define yyclearin (yychar = YYEMPTY) #define YYEMPTY (-2) #define YYEOF 0 #define YYACCEPT goto yyacceptlab #define YYABORT goto yyabortlab #define YYERROR goto yyerrorlab /* Like YYERROR except do call yyerror. This remains here temporarily to ease the transition to the new meaning of YYERROR, for GCC. Once GCC version 2 has supplanted version 1, this can go. */ #define YYFAIL goto yyerrlab #define YYRECOVERING() (!!yyerrstatus) #define YYBACKUP(Token, Value) \ do \ if (yychar == YYEMPTY && yylen == 1) \ { \ yychar = (Token); \ yylval = (Value); \ yytoken = YYTRANSLATE (yychar); \ YYPOPSTACK; \ goto yybackup; \ } \ else \ { \ yyerror ("syntax error: cannot back up");\ YYERROR; \ } \ while (0) #define YYTERROR 1 #define YYERRCODE 256 /* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N]. If N is 0, then set CURRENT to the empty location which ends the previous symbol: RHS[0] (always defined). */ #define YYRHSLOC(Rhs, K) ((Rhs)[K]) #ifndef YYLLOC_DEFAULT # define YYLLOC_DEFAULT(Current, Rhs, N) \ do \ if (N) \ { \ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \ } \ else \ { \ (Current).first_line = (Current).last_line = \ YYRHSLOC (Rhs, 0).last_line; \ (Current).first_column = (Current).last_column = \ YYRHSLOC (Rhs, 0).last_column; \ } \ while (0) #endif /* YY_LOCATION_PRINT -- Print the location on the stream. This macro was not mandated originally: define only if we know we won't break user code: when these are the locations we know. */ #ifndef YY_LOCATION_PRINT # if YYLTYPE_IS_TRIVIAL # define YY_LOCATION_PRINT(File, Loc) \ fprintf (File, "%d.%d-%d.%d", \ (Loc).first_line, (Loc).first_column, \ (Loc).last_line, (Loc).last_column) # else # define YY_LOCATION_PRINT(File, Loc) ((void) 0) # endif #endif /* YYLEX -- calling `yylex' with the right arguments. */ #ifdef YYLEX_PARAM # define YYLEX yylex (YYLEX_PARAM) #else # define YYLEX yylex () #endif /* Enable debugging if requested. */ #if YYDEBUG # ifndef YYFPRINTF # include /* INFRINGES ON USER NAME SPACE */ # define YYFPRINTF fprintf # endif # define YYDPRINTF(Args) \ do { \ if (yydebug) \ YYFPRINTF Args; \ } while (0) # define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ do { \ if (yydebug) \ { \ YYFPRINTF (stderr, "%s ", Title); \ yysymprint (stderr, \ Type, Value); \ YYFPRINTF (stderr, "\n"); \ } \ } while (0) /*------------------------------------------------------------------. | yy_stack_print -- Print the state stack from its BOTTOM up to its | | TOP (included). | `------------------------------------------------------------------*/ #if defined (__STDC__) || defined (__cplusplus) static void yy_stack_print (short int *bottom, short int *top) #else static void yy_stack_print (bottom, top) short int *bottom; short int *top; #endif { YYFPRINTF (stderr, "Stack now"); for (/* Nothing. */; bottom <= top; ++bottom) YYFPRINTF (stderr, " %d", *bottom); YYFPRINTF (stderr, "\n"); } # define YY_STACK_PRINT(Bottom, Top) \ do { \ if (yydebug) \ yy_stack_print ((Bottom), (Top)); \ } while (0) /*------------------------------------------------. | Report that the YYRULE is going to be reduced. | `------------------------------------------------*/ #if defined (__STDC__) || defined (__cplusplus) static void yy_reduce_print (int yyrule) #else static void yy_reduce_print (yyrule) int yyrule; #endif { int yyi; unsigned int yylno = yyrline[yyrule]; YYFPRINTF (stderr, "Reducing stack by rule %d (line %u), ", yyrule - 1, yylno); /* Print the symbols being reduced, and their result. */ for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++) YYFPRINTF (stderr, "%s ", yytname [yyrhs[yyi]]); YYFPRINTF (stderr, "-> %s\n", yytname [yyr1[yyrule]]); } # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ yy_reduce_print (Rule); \ } while (0) /* Nonzero means print parse trace. It is left uninitialized so that multiple parsers can coexist. */ int yydebug; #else /* !YYDEBUG */ # define YYDPRINTF(Args) # define YY_SYMBOL_PRINT(Title, Type, Value, Location) # define YY_STACK_PRINT(Bottom, Top) # define YY_REDUCE_PRINT(Rule) #endif /* !YYDEBUG */ /* YYINITDEPTH -- initial size of the parser's stacks. */ #ifndef YYINITDEPTH # define YYINITDEPTH 200 #endif /* YYMAXDEPTH -- maximum size the stacks can grow to (effective only if the built-in stack extension method is used). Do not make this value too large; the results are undefined if SIZE_MAX < YYSTACK_BYTES (YYMAXDEPTH) evaluated with infinite-precision integer arithmetic. */ #ifndef YYMAXDEPTH # define YYMAXDEPTH 10000 #endif #if YYERROR_VERBOSE # ifndef yystrlen # if defined (__GLIBC__) && defined (_STRING_H) # define yystrlen strlen # else /* Return the length of YYSTR. */ static YYSIZE_T # if defined (__STDC__) || defined (__cplusplus) yystrlen (const char *yystr) # else yystrlen (yystr) const char *yystr; # endif { register const char *yys = yystr; while (*yys++ != '\0') continue; return yys - yystr - 1; } # endif # endif # ifndef yystpcpy # if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE) # define yystpcpy stpcpy # else /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in YYDEST. */ static char * # if defined (__STDC__) || defined (__cplusplus) yystpcpy (char *yydest, const char *yysrc) # else yystpcpy (yydest, yysrc) char *yydest; const char *yysrc; # endif { register char *yyd = yydest; register const char *yys = yysrc; while ((*yyd++ = *yys++) != '\0') continue; return yyd - 1; } # endif # endif #endif /* !YYERROR_VERBOSE */ #if YYDEBUG /*--------------------------------. | Print this symbol on YYOUTPUT. | `--------------------------------*/ #if defined (__STDC__) || defined (__cplusplus) static void yysymprint (FILE *yyoutput, int yytype, YYSTYPE *yyvaluep) #else static void yysymprint (yyoutput, yytype, yyvaluep) FILE *yyoutput; int yytype; YYSTYPE *yyvaluep; #endif { /* Pacify ``unused variable'' warnings. */ (void) yyvaluep; if (yytype < YYNTOKENS) YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); else YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); # ifdef YYPRINT if (yytype < YYNTOKENS) YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); # endif switch (yytype) { default: break; } YYFPRINTF (yyoutput, ")"); } #endif /* ! YYDEBUG */ /*-----------------------------------------------. | Release the memory associated to this symbol. | `-----------------------------------------------*/ #if defined (__STDC__) || defined (__cplusplus) static void yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) #else static void yydestruct (yymsg, yytype, yyvaluep) const char *yymsg; int yytype; YYSTYPE *yyvaluep; #endif { /* Pacify ``unused variable'' warnings. */ (void) yyvaluep; if (!yymsg) yymsg = "Deleting"; YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); switch (yytype) { default: break; } } /* Prevent warnings from -Wmissing-prototypes. */ #ifdef YYPARSE_PARAM # if defined (__STDC__) || defined (__cplusplus) int yyparse (void *YYPARSE_PARAM); # else int yyparse (); # endif #else /* ! YYPARSE_PARAM */ #if defined (__STDC__) || defined (__cplusplus) int yyparse (void); #else int yyparse (); #endif #endif /* ! YYPARSE_PARAM */ /* The look-ahead symbol. */ int yychar; /* The semantic value of the look-ahead symbol. */ YYSTYPE yylval; /* Number of syntax errors so far. */ int yynerrs; /*----------. | yyparse. | `----------*/ #ifdef YYPARSE_PARAM # if defined (__STDC__) || defined (__cplusplus) int yyparse (void *YYPARSE_PARAM) # else int yyparse (YYPARSE_PARAM) void *YYPARSE_PARAM; # endif #else /* ! YYPARSE_PARAM */ #if defined (__STDC__) || defined (__cplusplus) int yyparse (void) #else int yyparse () #endif #endif { register int yystate; register int yyn; int yyresult; /* Number of tokens to shift before error messages enabled. */ int yyerrstatus; /* Look-ahead token as an internal (translated) token number. */ int yytoken = 0; /* Three stacks and their tools: `yyss': related to states, `yyvs': related to semantic values, `yyls': related to locations. Refer to the stacks thru separate pointers, to allow yyoverflow to reallocate them elsewhere. */ /* The state stack. */ short int yyssa[YYINITDEPTH]; short int *yyss = yyssa; register short int *yyssp; /* The semantic value stack. */ YYSTYPE yyvsa[YYINITDEPTH]; YYSTYPE *yyvs = yyvsa; register YYSTYPE *yyvsp; #define YYPOPSTACK (yyvsp--, yyssp--) YYSIZE_T yystacksize = YYINITDEPTH; /* The variables used to return semantic value and location from the action routines. */ YYSTYPE yyval; /* When reducing, the number of symbols on the RHS of the reduced rule. */ int yylen; YYDPRINTF ((stderr, "Starting parse\n")); yystate = 0; yyerrstatus = 0; yynerrs = 0; yychar = YYEMPTY; /* Cause a token to be read. */ /* Initialize stack pointers. Waste one element of value and location stack so that they stay on the same level as the state stack. The wasted elements are never initialized. */ yyssp = yyss; yyvsp = yyvs; yyvsp[0] = yylval; goto yysetstate; /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | `------------------------------------------------------------*/ yynewstate: /* In all cases, when you get here, the value and location stacks have just been pushed. so pushing a state here evens the stacks. */ yyssp++; yysetstate: *yyssp = yystate; if (yyss + yystacksize - 1 <= yyssp) { /* Get the current used size of the three stacks, in elements. */ YYSIZE_T yysize = yyssp - yyss + 1; #ifdef yyoverflow { /* Give user a chance to reallocate the stack. Use copies of these so that the &'s don't force the real ones into memory. */ YYSTYPE *yyvs1 = yyvs; short int *yyss1 = yyss; /* Each stack pointer address is followed by the size of the data in use in that stack, in bytes. This used to be a conditional around just the two extra args, but that might be undefined if yyoverflow is a macro. */ yyoverflow ("parser stack overflow", &yyss1, yysize * sizeof (*yyssp), &yyvs1, yysize * sizeof (*yyvsp), &yystacksize); yyss = yyss1; yyvs = yyvs1; } #else /* no yyoverflow */ # ifndef YYSTACK_RELOCATE goto yyoverflowlab; # else /* Extend the stack our own way. */ if (YYMAXDEPTH <= yystacksize) goto yyoverflowlab; yystacksize *= 2; if (YYMAXDEPTH < yystacksize) yystacksize = YYMAXDEPTH; { short int *yyss1 = yyss; union yyalloc *yyptr = (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); if (! yyptr) goto yyoverflowlab; YYSTACK_RELOCATE (yyss); YYSTACK_RELOCATE (yyvs); # undef YYSTACK_RELOCATE if (yyss1 != yyssa) YYSTACK_FREE (yyss1); } # endif #endif /* no yyoverflow */ yyssp = yyss + yysize - 1; yyvsp = yyvs + yysize - 1; YYDPRINTF ((stderr, "Stack size increased to %lu\n", (unsigned long int) yystacksize)); if (yyss + yystacksize - 1 <= yyssp) YYABORT; } YYDPRINTF ((stderr, "Entering state %d\n", yystate)); goto yybackup; /*-----------. | yybackup. | `-----------*/ yybackup: /* Do appropriate processing given the current state. */ /* Read a look-ahead token if we need one and don't already have one. */ /* yyresume: */ /* First try to decide what to do without reference to look-ahead token. */ yyn = yypact[yystate]; if (yyn == YYPACT_NINF) goto yydefault; /* Not known => get a look-ahead token if don't already have one. */ /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */ if (yychar == YYEMPTY) { YYDPRINTF ((stderr, "Reading a token: ")); yychar = YYLEX; } if (yychar <= YYEOF) { yychar = yytoken = YYEOF; YYDPRINTF ((stderr, "Now at end of input.\n")); } else { yytoken = YYTRANSLATE (yychar); YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); } /* If the proper action on seeing token YYTOKEN is to reduce or to detect an error, take that action. */ yyn += yytoken; if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) goto yydefault; yyn = yytable[yyn]; if (yyn <= 0) { if (yyn == 0 || yyn == YYTABLE_NINF) goto yyerrlab; yyn = -yyn; goto yyreduce; } if (yyn == YYFINAL) YYACCEPT; /* Shift the look-ahead token. */ YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); /* Discard the token being shifted unless it is eof. */ if (yychar != YYEOF) yychar = YYEMPTY; *++yyvsp = yylval; /* Count tokens shifted since error; after three, turn off error status. */ if (yyerrstatus) yyerrstatus--; yystate = yyn; goto yynewstate; /*-----------------------------------------------------------. | yydefault -- do the default action for the current state. | `-----------------------------------------------------------*/ yydefault: yyn = yydefact[yystate]; if (yyn == 0) goto yyerrlab; goto yyreduce; /*-----------------------------. | yyreduce -- Do a reduction. | `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: `$$ = $1'. Otherwise, the following line sets YYVAL to garbage. This behavior is undocumented and Bison users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ yyval = yyvsp[1-yylen]; YY_REDUCE_PRINT (yyn); switch (yyn) { case 2: #line 201 "f2jparse.y" { AST *temp, *prev, *commentList = NULL; if(debug) printf("F2java -> Sourcecodes\n"); (yyval.ptnode) = switchem((yyvsp[0].ptnode)); #if VCG if(emittem) start_vcg((yyval.ptnode)); #endif prev = NULL; for(temp=(yyval.ptnode);temp!=NULL;temp=temp->nextstmt) { if(emittem) { if(temp->nodetype == Comment) { if((prev == NULL) || ((prev != NULL) && (prev->nodetype != Comment))) commentList = temp; } else { /* commentList may be NULL here so we must check * for that in codegen. */ temp->astnode.source.prologComments = commentList; typecheck(temp); if(omitWrappers) optScalar(temp); emit(temp); commentList = NULL; } } prev = temp; } } break; case 3: #line 245 "f2jparse.y" { AST *temp; if(debug) printf("Sourcecodes -> Sourcecode\n"); (yyval.ptnode)=(yyvsp[0].ptnode); /* insert the name of the program unit into the * global function table. this will allow optScalar() * to easily get a pointer to a function. */ if(omitWrappers && ((yyvsp[0].ptnode)->nodetype != Comment)) { temp = (yyvsp[0].ptnode)->astnode.source.progtype->astnode.source.name; type_insert(global_func_table, (yyvsp[0].ptnode), 0, temp->astnode.ident.name); } } break; case 4: #line 264 "f2jparse.y" { AST *temp; if(debug) printf("Sourcecodes -> Sourcecodes Sourcecode\n"); (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode)=(yyvsp[0].ptnode); /* insert the name of the program unit into the * global function table. this will allow optScalar() * to easily get a pointer to a function. */ if(omitWrappers && ((yyvsp[0].ptnode)->nodetype != Comment)) { temp = (yyvsp[0].ptnode)->astnode.source.progtype->astnode.source.name; type_insert(global_func_table, (yyvsp[0].ptnode), 0, temp->astnode.ident.name); } } break; case 5: #line 286 "f2jparse.y" { if(debug) printf("Sourcecode -> Fprogram\n"); (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 6: #line 292 "f2jparse.y" { if(debug) printf("Sourcecode -> Fsubroutine\n"); (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 7: #line 298 "f2jparse.y" { if(debug) printf("Sourcecode -> Ffunction\n"); (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 8: #line 304 "f2jparse.y" { if(debug) printf("Sourcecode -> Comment\n"); (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 9: #line 312 "f2jparse.y" { if(debug) printf("Fprogram -> Program Specstmts Statements End\n"); add_implicit_to_tree((yyvsp[-2].ptnode)); (yyval.ptnode) = addnode(); /* store the tables built during parsing into the * AST node for access during code generation. */ (yyval.ptnode)->astnode.source.type_table = type_table; (yyval.ptnode)->astnode.source.external_table = external_table; (yyval.ptnode)->astnode.source.intrinsic_table = intrinsic_table; (yyval.ptnode)->astnode.source.args_table = args_table; (yyval.ptnode)->astnode.source.array_table = array_table; (yyval.ptnode)->astnode.source.format_table = format_table; (yyval.ptnode)->astnode.source.data_table = data_table; (yyval.ptnode)->astnode.source.save_table = save_table; (yyval.ptnode)->astnode.source.common_table = common_table; (yyval.ptnode)->astnode.source.parameter_table = parameter_table; (yyval.ptnode)->astnode.source.constants_table = constants_table; (yyval.ptnode)->astnode.source.equivalences = equivList; (yyval.ptnode)->astnode.source.stmt_assign_list = assign_labels; (yyval.ptnode)->astnode.source.javadocComments = NULL; (yyval.ptnode)->astnode.source.save_all = save_all; /* initialize some values in this node */ (yyval.ptnode)->astnode.source.needs_input = FALSE; (yyval.ptnode)->astnode.source.needs_output = FALSE; (yyval.ptnode)->astnode.source.needs_reflection = FALSE; (yyval.ptnode)->astnode.source.needs_blas = FALSE; if(omitWrappers) (yyval.ptnode)->astnode.source.scalarOptStatus = NOT_VISITED; (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Progunit; (yyval.ptnode)->astnode.source.progtype = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.source.typedecs = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.source.statements = switchem((yyvsp[0].ptnode)); /* a PROGRAM has no args, so set the symbol table to NULL */ args_table = NULL; (yyvsp[-3].ptnode)->astnode.source.descriptor = MAIN_DESCRIPTOR; } break; case 10: #line 371 "f2jparse.y" { HASHNODE *ht; AST *temp; if(debug) printf("Fsubroutine -> Subroutine Specstmts Statements End\n"); add_implicit_to_tree((yyvsp[-2].ptnode)); (yyval.ptnode) = addnode(); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Progunit; (yyval.ptnode)->astnode.source.progtype = (yyvsp[-3].ptnode); /* store the tables built during parsing into the * AST node for access during code generation. */ (yyval.ptnode)->astnode.source.type_table = type_table; (yyval.ptnode)->astnode.source.external_table = external_table; (yyval.ptnode)->astnode.source.intrinsic_table = intrinsic_table; (yyval.ptnode)->astnode.source.args_table = args_table; (yyval.ptnode)->astnode.source.array_table = array_table; (yyval.ptnode)->astnode.source.format_table = format_table; (yyval.ptnode)->astnode.source.data_table = data_table; (yyval.ptnode)->astnode.source.save_table = save_table; (yyval.ptnode)->astnode.source.common_table = common_table; (yyval.ptnode)->astnode.source.parameter_table = parameter_table; (yyval.ptnode)->astnode.source.constants_table = constants_table; (yyval.ptnode)->astnode.source.equivalences = equivList; (yyval.ptnode)->astnode.source.stmt_assign_list = assign_labels; (yyval.ptnode)->astnode.source.javadocComments = NULL; (yyval.ptnode)->astnode.source.save_all = save_all; /* initialize some values in this node */ (yyval.ptnode)->astnode.source.needs_input = FALSE; (yyval.ptnode)->astnode.source.needs_output = FALSE; (yyval.ptnode)->astnode.source.needs_reflection = FALSE; (yyval.ptnode)->astnode.source.needs_blas = FALSE; if(omitWrappers) (yyval.ptnode)->astnode.source.scalarOptStatus = NOT_VISITED; (yyval.ptnode)->astnode.source.typedecs = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.source.statements = switchem((yyvsp[0].ptnode)); /* foreach arg to this program unit, store the array * size, if applicable, from the hash table into the * node itself. */ for(temp=(yyvsp[-3].ptnode)->astnode.source.args;temp!=NULL;temp=temp->nextstmt) { if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL) { temp->vartype=ht->variable->vartype; temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist; } if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){ ht->variable->vartype=temp->vartype; } } type_insert(function_table, (yyvsp[-3].ptnode), 0, (yyvsp[-3].ptnode)->astnode.source.name->astnode.ident.name); } break; case 11: #line 446 "f2jparse.y" { HASHNODE *ht; AST *temp; if(debug) printf("Ffunction -> Function Specstmts Statements End\n"); assign_function_return_type((yyvsp[-3].ptnode), (yyvsp[-2].ptnode)); add_implicit_to_tree((yyvsp[-2].ptnode)); (yyval.ptnode) = addnode(); /* store the tables built during parsing into the * AST node for access during code generation. */ (yyval.ptnode)->astnode.source.type_table = type_table; (yyval.ptnode)->astnode.source.external_table = external_table; (yyval.ptnode)->astnode.source.intrinsic_table = intrinsic_table; (yyval.ptnode)->astnode.source.args_table = args_table; (yyval.ptnode)->astnode.source.array_table = array_table; (yyval.ptnode)->astnode.source.format_table = format_table; (yyval.ptnode)->astnode.source.data_table = data_table; (yyval.ptnode)->astnode.source.save_table = save_table; (yyval.ptnode)->astnode.source.common_table = common_table; (yyval.ptnode)->astnode.source.parameter_table = parameter_table; (yyval.ptnode)->astnode.source.constants_table = constants_table; (yyval.ptnode)->astnode.source.equivalences = equivList; (yyval.ptnode)->astnode.source.stmt_assign_list = assign_labels; (yyval.ptnode)->astnode.source.javadocComments = NULL; (yyval.ptnode)->astnode.source.save_all = save_all; /* initialize some values in this node */ (yyval.ptnode)->astnode.source.needs_input = FALSE; (yyval.ptnode)->astnode.source.needs_output = FALSE; (yyval.ptnode)->astnode.source.needs_reflection = FALSE; (yyval.ptnode)->astnode.source.needs_blas = FALSE; if(omitWrappers) (yyval.ptnode)->astnode.source.scalarOptStatus = NOT_VISITED; (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Progunit; (yyval.ptnode)->astnode.source.progtype = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.source.typedecs = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.source.statements = switchem((yyvsp[0].ptnode)); /* foreach arg to this program unit, store the array * size, if applicable, from the hash table into the * node itself. */ for(temp=(yyvsp[-3].ptnode)->astnode.source.args;temp!=NULL;temp=temp->nextstmt) { if((ht=type_lookup(type_table,temp->astnode.ident.name)) != NULL) { temp->vartype=ht->variable->vartype; temp->astnode.ident.arraylist=ht->variable->astnode.ident.arraylist; } if((ht=type_lookup(args_table, temp->astnode.ident.name)) != NULL){ ht->variable->vartype=temp->vartype; } } type_insert(function_table, (yyvsp[-3].ptnode), 0, (yyvsp[-3].ptnode)->astnode.source.name->astnode.ident.name); } break; case 12: #line 523 "f2jparse.y" { if(debug) printf("Program -> PROGRAM UndeclaredName\n"); unit_args = NULL; (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ lowercase((yyvsp[-1].ptnode)->astnode.ident.name); (yyval.ptnode)->astnode.source.name = (yyvsp[-1].ptnode); (yyval.ptnode)->nodetype = Program; (yyval.ptnode)->token = PROGRAM; (yyval.ptnode)->astnode.source.args = NULL; init_tables(); fprintf(stderr," MAIN %s:\n",(yyvsp[-1].ptnode)->astnode.ident.name); } break; case 13: #line 544 "f2jparse.y" { if(debug) printf("Subroutine -> SUBROUTINE UndeclaredName Functionargs NL\n"); unit_args = (yyvsp[-1].ptnode); (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ if((yyvsp[-1].ptnode) != NULL) (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->astnode.source.name = (yyvsp[-2].ptnode); (yyval.ptnode)->nodetype = Subroutine; (yyval.ptnode)->token = SUBROUTINE; (yyval.ptnode)->astnode.source.args = switchem((yyvsp[-1].ptnode)); fprintf(stderr,"\t%s:\n",(yyvsp[-2].ptnode)->astnode.ident.name); } break; case 14: #line 563 "f2jparse.y" { if(debug) printf("Subroutine -> SUBROUTINE UndeclaredName NL\n"); unit_args = NULL; init_tables(); (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->astnode.source.name = (yyvsp[-1].ptnode); (yyval.ptnode)->nodetype = Subroutine; (yyval.ptnode)->token = SUBROUTINE; (yyval.ptnode)->astnode.source.args = NULL; fprintf(stderr,"\t%s:\n",(yyvsp[-1].ptnode)->astnode.ident.name); } break; case 15: #line 583 "f2jparse.y" { if(debug) printf("Function -> AnySimpleType FUNCTION UndeclaredName Functionargs NL\n"); unit_args = (yyvsp[-1].ptnode); (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ if((yyvsp[-1].ptnode) != NULL) (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->astnode.source.name = (yyvsp[-2].ptnode); (yyval.ptnode)->nodetype = Function; (yyval.ptnode)->token = FUNCTION; (yyval.ptnode)->astnode.source.returns = (yyvsp[-4].type); (yyval.ptnode)->vartype = (yyvsp[-4].type); (yyvsp[-2].ptnode)->vartype = (yyvsp[-4].type); (yyval.ptnode)->astnode.source.args = switchem((yyvsp[-1].ptnode)); /* since the function name is the implicit return value * and it can be treated as a variable, we insert it into * the hash table for lookup later. */ (yyvsp[-2].ptnode)->astnode.ident.localvnum = -1; insert_name(type_table, (yyvsp[-2].ptnode), (yyvsp[-4].type)); fprintf(stderr,"\t%s:\n",(yyvsp[-2].ptnode)->astnode.ident.name); } break; case 16: #line 613 "f2jparse.y" { enum returntype ret; unit_args = (yyvsp[-1].ptnode); (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); if((yyvsp[-1].ptnode) != NULL) (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.source.name = (yyvsp[-2].ptnode); (yyval.ptnode)->nodetype = Function; (yyval.ptnode)->token = FUNCTION; ret = implicit_table[tolower((yyvsp[-2].ptnode)->astnode.ident.name[0]) - 'a'].type; (yyval.ptnode)->astnode.source.returns = ret; (yyval.ptnode)->vartype = ret; (yyvsp[-2].ptnode)->vartype = ret; (yyval.ptnode)->astnode.source.args = switchem((yyvsp[-1].ptnode)); (yyvsp[-2].ptnode)->astnode.ident.localvnum = -1; insert_name(type_table, (yyvsp[-2].ptnode), ret); fprintf(stderr,"\t%s:\n",(yyvsp[-2].ptnode)->astnode.ident.name); } break; case 17: #line 640 "f2jparse.y" { AST *tmparg; if(debug){ printf("Specstmts -> SpecStmtList\n"); } (yyvsp[0].ptnode) = switchem((yyvsp[0].ptnode)); type_hash((yyvsp[0].ptnode)); (yyval.ptnode)=(yyvsp[0].ptnode); for(tmparg = unit_args; tmparg; tmparg=tmparg->nextstmt) { HASHNODE *ht; ht = type_lookup(type_table, tmparg->astnode.ident.name); if(ht) { if(!ht->variable->astnode.ident.explicit) ht->variable->vartype = implicit_table[tolower(tmparg->astnode.ident.name[0]) - 'a'].type; } else fprintf(stderr, "warning: didn't find %s in symbol table\n", tmparg->astnode.ident.name); } } break; case 18: #line 668 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 19: #line 672 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 20: #line 679 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 21: #line 683 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 22: #line 687 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 23: #line 691 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 24: #line 695 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 25: #line 699 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 26: #line 703 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 27: #line 707 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 28: #line 711 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 29: #line 715 "f2jparse.y" { (yyval.ptnode)=(yyvsp[-1].ptnode); } break; case 30: #line 719 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 31: #line 725 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode) = switchem((yyvsp[-1].ptnode)); (yyval.ptnode)->nodetype = Dimension; (yyval.ptnode)->astnode.typeunit.declist = (yyvsp[-1].ptnode); } break; case 32: #line 736 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Dimension; } break; case 33: #line 742 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Dimension; } break; case 34: #line 753 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Equivalence; (yyval.ptnode)->prevstmt = NULL; (yyval.ptnode)->nextstmt = NULL; (yyval.ptnode)->astnode.equiv.nlist = switchem((yyvsp[-1].ptnode)); } break; case 35: #line 763 "f2jparse.y" { AST *tmp; (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Equivalence; (yyval.ptnode)->prevstmt = NULL; (yyval.ptnode)->nextstmt = NULL; (yyval.ptnode)->astnode.equiv.clist = switchem((yyvsp[-1].ptnode)); for(tmp=(yyvsp[-1].ptnode);tmp!=NULL;tmp=tmp->prevstmt) tmp->parent = (yyval.ptnode); addEquiv((yyval.ptnode)->astnode.equiv.clist); } break; case 36: #line 778 "f2jparse.y" { AST *tmp; (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Equivalence; (yyval.ptnode)->astnode.equiv.clist = switchem((yyvsp[-1].ptnode)); (yyval.ptnode)->prevstmt = (yyvsp[-4].ptnode); (yyval.ptnode)->nextstmt = NULL; for(tmp=(yyvsp[-1].ptnode);tmp!=NULL;tmp=tmp->prevstmt) tmp->parent = (yyval.ptnode); addEquiv((yyval.ptnode)->astnode.equiv.clist); } break; case 37: #line 795 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 38: #line 799 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 39: #line 806 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = CommonList; (yyval.ptnode)->astnode.common.name = NULL; (yyval.ptnode)->astnode.common.nlist = switchem((yyvsp[-1].ptnode)); merge_common_blocks((yyval.ptnode)->astnode.common.nlist); } break; case 40: #line 817 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 41: #line 821 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 42: #line 828 "f2jparse.y" { AST *temp; int pos; if(debug){ printf("CommonSpec -> DIV UndeclaredName DIV Namelist\n"); } (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Common; (yyval.ptnode)->astnode.common.name = strdup((yyvsp[-2].ptnode)->astnode.ident.name); (yyval.ptnode)->astnode.common.nlist = switchem((yyvsp[0].ptnode)); pos = 0; /* foreach variable in the COMMON block... */ for(temp=(yyval.ptnode)->astnode.common.nlist;temp!=NULL;temp=temp->nextstmt) { temp->astnode.ident.commonBlockName = strdup((yyvsp[-2].ptnode)->astnode.ident.name); if(omitWrappers) temp->astnode.ident.position = pos++; /* insert this name into the common table */ if(debug) printf("@insert %s (block = %s) into common table\n", temp->astnode.ident.name, (yyvsp[-2].ptnode)->astnode.ident.name); type_insert(common_table, temp, Float, temp->astnode.ident.name); } type_insert(global_common_table, (yyval.ptnode), Float, (yyval.ptnode)->astnode.common.name); free_ast_node((yyvsp[-2].ptnode)); } break; case 43: #line 864 "f2jparse.y" { AST *temp; /* This is an unnamed common block */ if(debug){ printf("CommonSpec -> CAT Namelist\n"); } (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Common; (yyval.ptnode)->astnode.common.name = strdup("Blank"); (yyval.ptnode)->astnode.common.nlist = switchem((yyvsp[0].ptnode)); /* foreach variable in the COMMON block... */ for(temp=(yyvsp[0].ptnode);temp!=NULL;temp=temp->prevstmt) { temp->astnode.ident.commonBlockName = "Blank"; /* insert this name into the common table */ if(debug) printf("@@insert %s (block = unnamed) into common table\n", temp->astnode.ident.name); type_insert(common_table, temp, Float, temp->astnode.ident.name); } type_insert(global_common_table, (yyval.ptnode), Float, (yyval.ptnode)->astnode.common.name); } break; case 44: #line 899 "f2jparse.y" { /* * I think in this case every variable is supposed to * be saved, but we already emit every variable as * static. do nothing here. --Keith */ (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Save; save_all = TRUE; } break; case 45: #line 911 "f2jparse.y" { AST *temp; if(debug){ printf("Save -> SAVE DIV Namelist DIV NL\n"); } (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Save; for(temp=(yyvsp[-2].ptnode);temp!=NULL;temp=temp->prevstmt) { if(debug) printf("@@insert %s into save table\n", temp->astnode.ident.name); type_insert(save_table, temp, Float, temp->astnode.ident.name); } } break; case 46: #line 930 "f2jparse.y" { AST *temp; if(debug){ printf("Save -> SAVE Namelist NL\n"); } (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Save; for(temp=(yyvsp[-1].ptnode);temp!=NULL;temp=temp->prevstmt) { if(debug) printf("@@insert %s into save table\n", temp->astnode.ident.name); type_insert(save_table, temp, Float, temp->astnode.ident.name); } } break; case 47: #line 951 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->nodetype = Specification; (yyval.ptnode)->token = IMPLICIT; } break; case 48: #line 957 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->nodetype = Specification; (yyval.ptnode)->token = IMPLICIT; fprintf(stderr,"Warning: IMPLICIT NONE ignored.\n"); } break; case 49: #line 966 "f2jparse.y" { /* I don't think anything needs to be done here */ } break; case 50: #line 970 "f2jparse.y" { /* or here either. */ } break; case 51: #line 976 "f2jparse.y" { AST *temp; for(temp=(yyvsp[-1].ptnode);temp!=NULL;temp=temp->prevstmt) { char *start_range, *end_range; char start_char, end_char; int i; start_range = temp->astnode.expression.lhs->astnode.ident.name; end_range = temp->astnode.expression.rhs->astnode.ident.name; start_char = tolower(start_range[0]); end_char = tolower(end_range[0]); if((strlen(start_range) > 1) || (strlen(end_range) > 1)) { yyerror("IMPLICIT spec must contain single character."); exit(EXIT_FAILURE); } if(end_char < start_char) { yyerror("IMPLICIT range in backwards order."); exit(EXIT_FAILURE); } for(i=start_char - 'a'; i <= end_char - 'a'; i++) { if(implicit_table[i].declared) { yyerror("Duplicate letter specified in IMPLICIT statement."); exit(EXIT_FAILURE); } implicit_table[i].type = (yyvsp[-3].type); implicit_table[i].declared = TRUE; implicit_table[i].len = len; /* global set in Types production */ } } } break; case 52: #line 1015 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 53: #line 1019 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 54: #line 1026 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Expression; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 55: #line 1033 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Expression; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 56: #line 1042 "f2jparse.y" { /* $$ = $2; */ (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = DataList; (yyval.ptnode)->astnode.label.stmt = (yyvsp[0].ptnode); } break; case 57: #line 1051 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 58: #line 1055 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 59: #line 1062 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.data.nlist = switchem((yyvsp[-3].ptnode)); (yyval.ptnode)->astnode.data.clist = switchem((yyvsp[-1].ptnode)); (yyval.ptnode)->nodetype = DataStmt; (yyval.ptnode)->prevstmt = NULL; (yyval.ptnode)->nextstmt = NULL; for(temp=(yyvsp[-3].ptnode);temp!=NULL;temp=temp->prevstmt) { if(debug) printf("@@insert %s into data table\n", temp->astnode.ident.name); temp->parent = (yyval.ptnode); if(temp->nodetype == DataImpliedLoop) type_insert(data_table, temp, Float, temp->astnode.forloop.Label->astnode.ident.name); else type_insert(data_table, temp, Float, temp->astnode.ident.name); } } break; case 60: #line 1090 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 61: #line 1094 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 62: #line 1101 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 63: #line 1105 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-2].ptnode); (yyval.ptnode)=addnode(); (yyval.ptnode)->nodetype = Binaryop; (yyval.ptnode)->token = STAR; (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.expression.optype = '*'; } break; case 64: #line 1121 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 65: #line 1125 "f2jparse.y" { HASHNODE *hash_temp; if((parameter_table != NULL) && ((hash_temp = type_lookup(parameter_table, yylval.lexeme)) != NULL)) { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->vartype = hash_temp->variable->vartype; (yyval.ptnode)->token = hash_temp->variable->token; (yyval.ptnode)->astnode.constant.number = strdup(hash_temp->variable->astnode.constant.number); } else{ printf("Error: '%s' is not a constant\n",yylval.lexeme); exit(EXIT_FAILURE); } } break; case 66: #line 1142 "f2jparse.y" { char *neg_string; neg_string = unary_negate_string((yyvsp[0].ptnode)->astnode.constant.number); if(!neg_string) { fprintf(stderr, "Error generating negated string (DataConstant)\n"); exit(EXIT_FAILURE); } free((yyvsp[0].ptnode)->astnode.constant.number); (yyvsp[0].ptnode)->astnode.constant.number = neg_string; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 67: #line 1160 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 68: #line 1164 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 69: #line 1171 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 70: #line 1175 "f2jparse.y" { (yyvsp[-1].ptnode)->astnode.forloop.counter = (yyvsp[-3].ptnode); (yyvsp[-1].ptnode)->astnode.forloop.Label = (yyvsp[-5].ptnode); (yyval.ptnode) = (yyvsp[-1].ptnode); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); } break; case 71: #line 1185 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = DataImpliedLoop; (yyval.ptnode)->astnode.forloop.start = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.forloop.stop = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.forloop.incr = NULL; } break; case 72: #line 1195 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-4].ptnode)->parent = (yyval.ptnode); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = DataImpliedLoop; (yyval.ptnode)->astnode.forloop.start = (yyvsp[-4].ptnode); (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.forloop.incr = (yyvsp[0].ptnode); } break; case 73: #line 1214 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 74: #line 1218 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 75: #line 1225 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-1].ptnode); (yyval.ptnode)->nodetype = Assignment; } break; case 76: #line 1230 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Call; } break; case 77: #line 1235 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = StmtLabelAssign; } break; case 78: #line 1240 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Logicalif; } break; case 79: #line 1245 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Arithmeticif; } break; case 80: #line 1250 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Blockif; } break; case 81: #line 1255 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Forloop; } break; case 82: #line 1260 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Return; } break; case 83: #line 1265 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = AssignedGoto; } break; case 84: #line 1270 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = ComputedGoto; } break; case 85: #line 1275 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Goto; } break; case 86: #line 1280 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Label; } break; case 87: #line 1285 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Label; } break; case 88: #line 1290 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Label; } break; case 89: #line 1295 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Write; } break; case 90: #line 1300 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Read; } break; case 91: #line 1305 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Stop; } break; case 92: #line 1310 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Pause; } break; case 93: #line 1315 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Unimplemented; } break; case 94: #line 1320 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Unimplemented; } break; case 95: #line 1325 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Comment; } break; case 96: #line 1330 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Unimplemented; } break; case 97: #line 1337 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = COMMENT; (yyval.ptnode)->nodetype = Comment; (yyval.ptnode)->astnode.ident.len = 0; strcpy((yyval.ptnode)->astnode.ident.name, yylval.lexeme); } break; case 98: #line 1347 "f2jparse.y" { fprintf(stderr,"Warning: OPEN not implemented.. skipping.\n"); (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Unimplemented; } break; case 101: #line 1362 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 102: #line 1367 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 103: #line 1372 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 104: #line 1377 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 105: #line 1382 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 106: #line 1387 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 107: #line 1392 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 108: #line 1397 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 109: #line 1402 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 110: #line 1407 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 111: #line 1414 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 112: #line 1419 "f2jparse.y" { /* UNIMPLEMENTED */ (yyval.ptnode) = addnode(); } break; case 117: #line 1438 "f2jparse.y" { fprintf(stderr,"WArning: CLOSE not implemented.\n"); (yyval.ptnode) = (yyvsp[-2].ptnode); } break; case 118: #line 1445 "f2jparse.y" { fprintf(stderr,"Warning: REWIND not implemented.\n"); (yyval.ptnode) = (yyvsp[-1].ptnode); } break; case 119: #line 1452 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = END; (yyval.ptnode)->nodetype = End; } break; case 120: #line 1459 "f2jparse.y" { AST *end_temp; end_temp = addnode(); end_temp->token = END; end_temp->nodetype = End; (yyval.ptnode) = addnode(); end_temp->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Label; (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-2].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.label.stmt = end_temp; free_ast_node((yyvsp[-2].ptnode)); } break; case 121: #line 1488 "f2jparse.y" {init_tables();} break; case 122: #line 1489 "f2jparse.y" { if(debug){ printf("Functionargs -> OP Namelist CP\n"); } (yyvsp[-1].ptnode) = switchem((yyvsp[-1].ptnode)); arg_table_load((yyvsp[-1].ptnode)); (yyval.ptnode) = (yyvsp[-1].ptnode); } break; case 123: #line 1498 "f2jparse.y" { if(debug){ printf("Functionargs -> OP Namelist CP\n"); } init_tables(); (yyval.ptnode) = NULL; } break; case 124: #line 1509 "f2jparse.y" { if(debug){ printf("Namelist -> Name\n"); } (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 125: #line 1516 "f2jparse.y" { if(debug){ printf("Namelist -> Namelist CM Name\n"); } (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 126: #line 1533 "f2jparse.y" { (yyval.ptnode) = process_typestmt((yyvsp[-2].type), (yyvsp[-1].ptnode)); } break; case 127: #line 1537 "f2jparse.y" { (yyval.ptnode) = process_typestmt((yyvsp[-2].type), (yyvsp[-1].ptnode)); } break; case 128: #line 1543 "f2jparse.y" { (yyval.type) = (yyvsp[0].type); len = 1; } break; case 129: #line 1548 "f2jparse.y" { (yyval.type) = (yyvsp[-2].type); len = atoi((yyvsp[0].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-1].ptnode)); free_ast_node((yyvsp[0].ptnode)); } break; case 130: #line 1557 "f2jparse.y" { (yyval.type) = yylval.type; typedec_context = (yyval.type); } break; case 131: #line 1564 "f2jparse.y" { (yyval.type) = (yyvsp[0].type); len = 1; } break; case 132: #line 1569 "f2jparse.y" { (yyval.type) = (yyvsp[-2].type); len = atoi((yyvsp[0].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-1].ptnode)); free_ast_node((yyvsp[0].ptnode)); } break; case 133: #line 1576 "f2jparse.y" { (yyval.type) = (yyvsp[-4].type); len = -1; free_ast_node((yyvsp[-3].ptnode)); free_ast_node((yyvsp[-1].ptnode)); } break; case 134: #line 1585 "f2jparse.y" { (yyval.type) = yylval.type; typedec_context = (yyval.type); } break; case 135: #line 1592 "f2jparse.y" { (yyval.type) = (yyvsp[0].type); } break; case 136: #line 1596 "f2jparse.y" { (yyval.type) = (yyvsp[0].type); } break; case 137: #line 1602 "f2jparse.y" { (yyval.type) = (yyvsp[0].type); } break; case 138: #line 1606 "f2jparse.y" { (yyval.type) = (yyvsp[0].type); } break; case 139: #line 1618 "f2jparse.y" { (yyvsp[0].ptnode)->parent = addnode(); (yyvsp[0].ptnode)->parent->nodetype = Typedec; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 140: #line 1625 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 141: #line 1633 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.ident.len = -1; } break; case 142: #line 1638 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.ident.len = atoi((yyvsp[0].ptnode)->astnode.constant.number); } break; case 143: #line 1643 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.ident.len = -1; } break; case 144: #line 1650 "f2jparse.y" { (yyvsp[0].ptnode)->parent = addnode(); (yyvsp[0].ptnode)->parent->nodetype = Typedec; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 145: #line 1657 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 146: #line 1665 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.ident.len = -1; } break; case 147: #line 1670 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.ident.len = atoi((yyvsp[0].ptnode)->astnode.constant.number); } break; case 148: #line 1675 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-4].ptnode); (yyval.ptnode)->astnode.ident.len = -1; } break; case 149: #line 1680 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.ident.len = -1; } break; case 150: #line 1700 "f2jparse.y" { HASHNODE *hashtemp; lowercase(yylval.lexeme); if(type_lookup(java_keyword_table,yylval.lexeme)) yylval.lexeme[0] = toupper(yylval.lexeme[0]); /* check if the name we're looking at is defined as a parameter. * if so, instead of inserting an Identifier node here, we're just * going to insert the Constant node that corresponds to * the parameter. normally the only time we'd worry about * such a substitution would be when the ident was the lhs * of some expression, but that should not happen with parameters. * * otherwise, if not a parameter, get a new AST node initialized * with this name. * * added check for null parameter table because this Name could * be reduced before we initialize the tables. that would mean * that this name is the function name, so we dont want this to * be a parameter anyway. kgs 11/7/00 * */ if((parameter_table != NULL) && ((hashtemp = type_lookup(parameter_table,yylval.lexeme)) != NULL)) { /* had a problem here just setting $$ = hashtemp->variable * when there's an arraydec with two of the same PARAMETERS * in the arraynamelist, e.g. A(NMAX,NMAX). so, instead we * just copy the relevant fields from the constant node. */ if(debug) printf("not calling init name, param %s\n", yylval.lexeme); (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = hashtemp->variable->nodetype; (yyval.ptnode)->vartype = hashtemp->variable->vartype; (yyval.ptnode)->token = hashtemp->variable->token; (yyval.ptnode)->astnode.constant.number = strdup(hashtemp->variable->astnode.constant.number); } else{ if(debug) printf("Name -> NAME\n"); (yyval.ptnode) = initialize_name(yylval.lexeme); } } break; case 151: #line 1760 "f2jparse.y" { lowercase(yylval.lexeme); (yyval.ptnode)=addnode(); (yyval.ptnode)->token = NAME; (yyval.ptnode)->nodetype = Identifier; (yyval.ptnode)->astnode.ident.needs_declaration = FALSE; if(omitWrappers) (yyval.ptnode)->astnode.ident.passByRef = FALSE; if(type_lookup(java_keyword_table,yylval.lexeme)) yylval.lexeme[0] = toupper(yylval.lexeme[0]); strcpy((yyval.ptnode)->astnode.ident.name, yylval.lexeme); } break; case 152: #line 1780 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 153: #line 1784 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 154: #line 1791 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->token = STRING; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme); (yyval.ptnode)->vartype = String; if(debug) printf("**The string value is %s\n",(yyval.ptnode)->astnode.constant.number); } break; case 155: #line 1802 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->token = STRING; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme); (yyval.ptnode)->vartype = String; if(debug) printf("**The char value is %s\n",(yyval.ptnode)->astnode.constant.number); } break; case 156: #line 1815 "f2jparse.y" { (yyval.ptnode) = process_array_declaration((yyvsp[-3].ptnode), (yyvsp[-1].ptnode)); } break; case 157: #line 1821 "f2jparse.y" { AST *temp; temp = addnode(); temp->nodetype = ArrayDec; (yyvsp[0].ptnode)->parent = temp; if((yyvsp[0].ptnode)->nodetype == ArrayIdxRange) { (yyvsp[0].ptnode)->astnode.expression.lhs->parent = temp; (yyvsp[0].ptnode)->astnode.expression.rhs->parent = temp; } (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 158: #line 1835 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent; if((yyvsp[0].ptnode)->nodetype == ArrayIdxRange) { (yyvsp[0].ptnode)->astnode.expression.lhs->parent = (yyvsp[-2].ptnode)->parent; (yyvsp[0].ptnode)->astnode.expression.rhs->parent = (yyvsp[-2].ptnode)->parent; } (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 159: #line 1847 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 160: #line 1851 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 161: #line 1855 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = ArrayIdxRange; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 162: #line 1869 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->nodetype = Identifier; *(yyval.ptnode)->astnode.ident.name = '*'; } break; case 163: #line 1877 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = StmtLabelAssign; (yyval.ptnode)->astnode.assignment.lhs = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.assignment.rhs = (yyvsp[-3].ptnode); /* add this label to the list of assigned labels */ if(in_dlist_stmt_label(assign_labels, (yyvsp[-3].ptnode)) == 0) { if(debug) printf("inserting label num %s in assign_labels list\n", (yyvsp[-3].ptnode)->astnode.constant.number); dl_insert_b(assign_labels, (yyvsp[-3].ptnode)); } } break; case 164: #line 1904 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Assignment; (yyval.ptnode)->astnode.assignment.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.assignment.rhs = (yyvsp[0].ptnode); } break; case 165: #line 1915 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); (yyval.ptnode)->nextstmt = NULL; (yyval.ptnode)->prevstmt = NULL; } break; case 166: #line 1921 "f2jparse.y" { AST *temp; /* Use the following declaration in case we * need to switch index order. * * HASHNODE * hashtemp; */ (yyval.ptnode) = addnode(); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Identifier; (yyval.ptnode)->prevstmt = NULL; (yyval.ptnode)->nextstmt = NULL; free_ast_node((yyvsp[-1].ptnode)->parent); for(temp = (yyvsp[-1].ptnode); temp != NULL; temp = temp->prevstmt) temp->parent = (yyval.ptnode); strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-3].ptnode)->astnode.ident.name); /* This is in case we want to switch index order later. * * hashtemp = type_lookup(array_table, $1->astnode.ident.name); * if(hashtemp) * $$->astnode.ident.arraylist = $3; * else * $$->astnode.ident.arraylist = switchem($3); */ /* We don't switch index order. */ (yyval.ptnode)->astnode.ident.arraylist = switchem((yyvsp[-1].ptnode)); free_ast_node((yyvsp[-3].ptnode)); } break; case 167: #line 1957 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 168: #line 1963 "f2jparse.y" { (yyvsp[0].ptnode)->parent = addnode(); (yyvsp[0].ptnode)->parent->nodetype = Identifier; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 169: #line 1970 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 170: #line 1982 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Forloop; (yyval.ptnode)->astnode.forloop.Label = (yyvsp[-1].ptnode); } break; case 171: #line 1991 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 172: #line 1996 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-1].ptnode); } break; case 173: #line 2000 "f2jparse.y" { char *loop_label; loop_label = (char *)malloc(32); if(!loop_label) { fprintf(stderr,"Malloc error\n"); exit(EXIT_FAILURE); } sprintf(loop_label,"%d", cur_do_label); cur_do_label++; (yyval.ptnode) = addnode(); (yyval.ptnode)->token = INTEGER; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup(loop_label); (yyval.ptnode)->vartype = Integer; dl_insert_b(do_labels, strdup((yyval.ptnode)->astnode.constant.number)); free(loop_label); } break; case 174: #line 2025 "f2jparse.y" { AST *counter; (yyval.ptnode) = addnode(); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ counter = (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-3].ptnode)->astnode.assignment.lhs; (yyval.ptnode)->astnode.forloop.start = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.forloop.incr = NULL; (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-3].ptnode)->astnode.assignment.rhs,(yyvsp[-1].ptnode),NULL); (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr(counter,NULL); } break; case 175: #line 2039 "f2jparse.y" { AST *counter; (yyval.ptnode) = addnode(); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ counter = (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-5].ptnode)->astnode.assignment.lhs; (yyval.ptnode)->nodetype = Forloop; (yyval.ptnode)->astnode.forloop.start = (yyvsp[-5].ptnode); (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.forloop.incr = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-5].ptnode)->astnode.assignment.rhs,(yyvsp[-3].ptnode),(yyvsp[-1].ptnode)); (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr(counter,(yyvsp[-1].ptnode)); } break; case 176: #line 2061 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Label; (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-1].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.label.stmt = (yyvsp[0].ptnode); free_ast_node((yyvsp[-1].ptnode)); } break; case 177: #line 2071 "f2jparse.y" { /* HASHNODE *newnode; */ char *tmpLabel; tmpLabel = (char *) f2jalloc(10); /* plenty of space for a f77 label num */ /* newnode = (HASHNODE *) f2jalloc(sizeof(HASHNODE)); */ (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Format; (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-2].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.label.stmt = (yyvsp[-1].ptnode); (yyvsp[-1].ptnode)->astnode.label.number = (yyval.ptnode)->astnode.label.number; if(debug) printf("@@ inserting format line num %d\n",(yyval.ptnode)->astnode.label.number); sprintf(tmpLabel,"%d",(yyvsp[-1].ptnode)->astnode.label.number); type_insert(format_table,(yyvsp[-1].ptnode),0,tmpLabel); free_ast_node((yyvsp[-2].ptnode)); } break; case 178: #line 2101 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Format; (yyval.ptnode)->astnode.label.stmt = switchem((yyvsp[-1].ptnode)); } break; case 179: #line 2109 "f2jparse.y" { AST *temp; temp = addnode(); temp->nodetype = Format; (yyvsp[0].ptnode)->parent = temp; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 180: #line 2119 "f2jparse.y" { (yyvsp[-1].ptnode)->nextstmt = (yyvsp[0].ptnode); (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-1].ptnode)->parent; if(((yyvsp[0].ptnode)->token == REPEAT) && ((yyvsp[-1].ptnode)->token == INTEGER)) { (yyvsp[0].ptnode)->astnode.label.number = atoi((yyvsp[-1].ptnode)->astnode.constant.number); if(debug) printf("## setting number = %s\n", (yyvsp[-1].ptnode)->astnode.constant.number); } if(debug) { if((yyvsp[0].ptnode)->token == REPEAT) printf("## $2 is repeat token, $1 = %s ##\n",tok2str((yyvsp[-1].ptnode)->token)); if((yyvsp[-1].ptnode)->token == REPEAT) printf("## $1 is repeat token, $2 = %s ##\n",tok2str((yyvsp[0].ptnode)->token)); } (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 181: #line 2141 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 182: #line 2145 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 183: #line 2149 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 184: #line 2155 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = EDIT_DESC; strcpy((yyval.ptnode)->astnode.ident.name, yylval.lexeme); } break; case 185: #line 2161 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 186: #line 2165 "f2jparse.y" { /* ignore the constant part for now */ free_ast_node((yyvsp[0].ptnode)); (yyval.ptnode) = (yyvsp[-2].ptnode); } break; case 187: #line 2172 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = REPEAT; (yyval.ptnode)->astnode.label.stmt = switchem((yyvsp[-1].ptnode)); if(debug) printf("## setting number = 1\n"); (yyval.ptnode)->astnode.label.number = 1; } break; case 188: #line 2183 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 189: #line 2187 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 190: #line 2194 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = CM; } break; case 191: #line 2199 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = DIV; } break; case 192: #line 2204 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = CAT; } break; case 193: #line 2209 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = COLON; } break; case 194: #line 2216 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 195: #line 2220 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 196: #line 2235 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Label; (yyval.ptnode)->astnode.label.number = atoi((yyvsp[-2].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.label.stmt = NULL; free_ast_node((yyvsp[-2].ptnode)); } break; case 197: #line 2246 "f2jparse.y" { char *loop_label; (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Label; loop_label = (char *)dl_pop(do_labels); (yyval.ptnode)->astnode.label.number = atoi(loop_label); (yyval.ptnode)->astnode.label.stmt = NULL; } break; case 198: #line 2260 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.io_stmt.io_type = Write; (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL; /* unimplemented $$->astnode.io_stmt.file_desc = ; */ if((yyvsp[-3].ptnode)->nodetype == Constant) { if((yyvsp[-3].ptnode)->astnode.constant.number[0] == '*') { (yyval.ptnode)->astnode.io_stmt.format_num = -1; free_ast_node((yyvsp[-3].ptnode)); } else if((yyvsp[-3].ptnode)->token == STRING) { (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode); } else { (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-3].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-3].ptnode)); } } else { /* is this case ever reached?? i don't think so. --kgs */ (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode); } (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode)); for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; /* currently ignoring the file descriptor.. */ free_ast_node((yyvsp[-5].ptnode)); } break; case 199: #line 2302 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.io_stmt.io_type = Write; (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL; (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-2].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode)); for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; free_ast_node((yyvsp[-2].ptnode)); } break; case 200: #line 2317 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.io_stmt.io_type = Write; (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL; (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode)); for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; } break; case 201: #line 2331 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.io_stmt.io_type = Write; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode)); for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent->nodetype = Write; } break; case 202: #line 2347 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 203: #line 2351 "f2jparse.y" { (yyval.ptnode) = NULL; } break; case 204: #line 2360 "f2jparse.y" { /* do nothing for now */ (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 205: #line 2365 "f2jparse.y" { /* do nothing for now */ (yyval.ptnode) = addnode(); (yyval.ptnode)->token = INTEGER; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup("*"); (yyval.ptnode)->vartype = Integer; } break; case 206: #line 2377 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 207: #line 2381 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 208: #line 2385 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = INTEGER; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup("*"); (yyval.ptnode)->vartype = Integer; } break; case 209: #line 2393 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = INTEGER; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup("*"); (yyval.ptnode)->vartype = Integer; } break; case 210: #line 2401 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 211: #line 2405 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 212: #line 2409 "f2jparse.y" { fprintf(stderr,"Warning - ignoring FMT = %s\n", (yyvsp[0].ptnode)->astnode.ident.name); (yyval.ptnode) = addnode(); (yyval.ptnode)->token = INTEGER; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup("*"); (yyval.ptnode)->vartype = Integer; } break; case 213: #line 2421 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.io_stmt.io_type = Read; (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL; (yyval.ptnode)->astnode.io_stmt.end_num = -1; if((yyvsp[-3].ptnode)->nodetype == Constant) { if((yyvsp[-3].ptnode)->astnode.constant.number[0] == '*') { (yyval.ptnode)->astnode.io_stmt.format_num = -1; free_ast_node((yyvsp[-3].ptnode)); } else if((yyvsp[-3].ptnode)->token == STRING) { (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode); } else { (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-3].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-3].ptnode)); } } else { /* is this case ever reached?? i don't think so. --kgs */ (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-3].ptnode); } (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode)); if((yyval.ptnode)->astnode.io_stmt.arg_list && (yyval.ptnode)->astnode.io_stmt.arg_list->parent) free_ast_node((yyval.ptnode)->astnode.io_stmt.arg_list->parent); for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent = (yyval.ptnode); /* currently ignoring the file descriptor and format spec. */ free_ast_node((yyvsp[-5].ptnode)); } break; case 214: #line 2463 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->astnode.io_stmt.io_type = Read; (yyval.ptnode)->astnode.io_stmt.fmt_list = NULL; if((yyvsp[-5].ptnode)->nodetype == Constant) { if((yyvsp[-5].ptnode)->astnode.constant.number[0] == '*') { (yyval.ptnode)->astnode.io_stmt.format_num = -1; free_ast_node((yyvsp[-5].ptnode)); } else if((yyvsp[-5].ptnode)->token == STRING) { (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-5].ptnode); } else { (yyval.ptnode)->astnode.io_stmt.format_num = atoi((yyvsp[-5].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-5].ptnode)); } } else { /* is this case ever reached?? i don't think so. --kgs */ (yyval.ptnode)->astnode.io_stmt.format_num = -1; (yyval.ptnode)->astnode.io_stmt.fmt_list = (yyvsp[-5].ptnode); } (yyval.ptnode)->astnode.io_stmt.end_num = atoi((yyvsp[-3].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-3].ptnode)); (yyval.ptnode)->astnode.io_stmt.arg_list = switchem((yyvsp[-1].ptnode)); if((yyval.ptnode)->astnode.io_stmt.arg_list && (yyval.ptnode)->astnode.io_stmt.arg_list->parent) free_ast_node((yyval.ptnode)->astnode.io_stmt.arg_list->parent); for(temp=(yyval.ptnode)->astnode.io_stmt.arg_list;temp!=NULL;temp=temp->nextstmt) temp->parent = (yyval.ptnode); /* currently ignoring the file descriptor.. */ free_ast_node((yyvsp[-7].ptnode)); } break; case 215: #line 2509 "f2jparse.y" { (yyvsp[0].ptnode)->parent = addnode(); (yyvsp[0].ptnode)->parent->nodetype = IoExplist; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 216: #line 2516 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 217: #line 2522 "f2jparse.y" { (yyval.ptnode) = NULL; } break; case 218: #line 2528 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 219: #line 2532 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = IoImpliedLoop; (yyval.ptnode)->astnode.forloop.start = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.forloop.incr = NULL; (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-5].ptnode); (yyval.ptnode)->astnode.forloop.Label = switchem((yyvsp[-7].ptnode)); (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-3].ptnode),(yyvsp[-1].ptnode),NULL); (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr((yyvsp[-5].ptnode),NULL); (yyvsp[-7].ptnode)->parent = (yyval.ptnode); for(temp = (yyvsp[-7].ptnode); temp != NULL; temp = temp->nextstmt) temp->parent = (yyval.ptnode); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); } break; case 220: #line 2553 "f2jparse.y" { AST *temp; (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = IoImpliedLoop; (yyval.ptnode)->astnode.forloop.start = (yyvsp[-5].ptnode); (yyval.ptnode)->astnode.forloop.stop = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.forloop.incr = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.forloop.counter = (yyvsp[-7].ptnode); (yyval.ptnode)->astnode.forloop.Label = switchem((yyvsp[-9].ptnode)); (yyval.ptnode)->astnode.forloop.iter_expr = gen_iter_expr((yyvsp[-5].ptnode),(yyvsp[-3].ptnode),(yyvsp[-1].ptnode)); (yyval.ptnode)->astnode.forloop.incr_expr = gen_incr_expr((yyvsp[-7].ptnode),(yyvsp[-1].ptnode)); (yyvsp[-9].ptnode)->parent = (yyval.ptnode); for(temp = (yyvsp[-9].ptnode); temp != NULL; temp = temp->nextstmt) temp->parent = (yyval.ptnode); (yyvsp[-7].ptnode)->parent = (yyval.ptnode); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); } break; case 221: #line 2577 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 222: #line 2591 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-8].ptnode)->parent = (yyval.ptnode); if((yyvsp[-4].ptnode) != NULL) (yyvsp[-4].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ if((yyvsp[-3].ptnode) != NULL) (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ if((yyvsp[-2].ptnode) != NULL) (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Blockif; (yyval.ptnode)->astnode.blockif.conds = (yyvsp[-8].ptnode); (yyvsp[-4].ptnode) = switchem((yyvsp[-4].ptnode)); (yyval.ptnode)->astnode.blockif.stmts = (yyvsp[-4].ptnode); /* If there are any `else if' statements, * switchem. Otherwise, NULL pointer checked * in code generating functions. */ (yyvsp[-3].ptnode) = switchem((yyvsp[-3].ptnode)); (yyval.ptnode)->astnode.blockif.elseifstmts = (yyvsp[-3].ptnode); /* Might be NULL. */ (yyval.ptnode)->astnode.blockif.elsestmts = (yyvsp[-2].ptnode); /* Might be NULL. */ (yyval.ptnode)->astnode.blockif.endif_label = (yyvsp[-1].ptnode)->astnode.blockif.endif_label; } break; case 223: #line 2617 "f2jparse.y" {(yyval.ptnode)=0;} break; case 224: #line 2619 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 225: #line 2624 "f2jparse.y" {(yyval.ptnode)=0;} break; case 226: #line 2626 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 227: #line 2630 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-1].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 228: #line 2638 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-4].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Elseif; (yyval.ptnode)->astnode.blockif.conds = (yyvsp[-4].ptnode); (yyval.ptnode)->astnode.blockif.stmts = switchem((yyvsp[0].ptnode)); } break; case 229: #line 2649 "f2jparse.y" {(yyval.ptnode)=0;} break; case 230: #line 2651 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Else; (yyval.ptnode)->astnode.blockif.stmts = switchem((yyvsp[0].ptnode)); } break; case 231: #line 2658 "f2jparse.y" { (yyval.ptnode) = 0; } break; case 232: #line 2664 "f2jparse.y" { if(debug) printf("EndIf\n"); (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Blockif; if(strlen(yylval.lexeme) > 0) (yyval.ptnode)->astnode.blockif.endif_label = atoi(yylval.lexeme); else (yyval.ptnode)->astnode.blockif.endif_label = -1; } break; case 233: #line 2677 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->astnode.logicalif.conds = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.logicalif.stmts = (yyvsp[0].ptnode); } break; case 234: #line 2687 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Arithmeticif; (yyvsp[-7].ptnode)->parent = (yyval.ptnode); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.arithmeticif.cond = (yyvsp[-7].ptnode); (yyval.ptnode)->astnode.arithmeticif.neg_label = atoi((yyvsp[-5].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.arithmeticif.zero_label = atoi((yyvsp[-3].ptnode)->astnode.constant.number); (yyval.ptnode)->astnode.arithmeticif.pos_label = atoi((yyvsp[-1].ptnode)->astnode.constant.number); free_ast_node((yyvsp[-5].ptnode)); free_ast_node((yyvsp[-3].ptnode)); free_ast_node((yyvsp[-1].ptnode)); } break; case 235: #line 2720 "f2jparse.y" { (yyval.ptnode) = process_subroutine_call((yyvsp[-3].ptnode), (yyvsp[-1].ptnode)); } break; case 236: #line 2726 "f2jparse.y" { if(debug) printf("SubString! format = c(e1:e2)\n"); (yyval.ptnode) = addnode(); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-5].ptnode)->astnode.ident.name); (yyval.ptnode)->nodetype = Substring; (yyval.ptnode)->token = NAME; (yyval.ptnode)->astnode.ident.startDim[0] = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.ident.endDim[0] = (yyvsp[-1].ptnode); free_ast_node((yyvsp[-5].ptnode)); } break; case 237: #line 2741 "f2jparse.y" { if(debug) printf("SubString! format = c(:e2)\n"); (yyval.ptnode) = addnode(); (yyvsp[-4].ptnode)->parent = (yyval.ptnode); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-4].ptnode)->astnode.ident.name); (yyval.ptnode)->nodetype = Substring; (yyval.ptnode)->token = NAME; (yyval.ptnode)->astnode.ident.startDim[0] = NULL; (yyval.ptnode)->astnode.ident.endDim[0] = (yyvsp[-1].ptnode); free_ast_node((yyvsp[-4].ptnode)); } break; case 238: #line 2755 "f2jparse.y" { if(debug) printf("SubString! format = c(e1:)\n"); (yyval.ptnode) = addnode(); (yyvsp[-4].ptnode)->parent = (yyval.ptnode); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-4].ptnode)->astnode.ident.name); (yyval.ptnode)->nodetype = Substring; (yyval.ptnode)->token = NAME; (yyval.ptnode)->astnode.ident.startDim[0] = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.ident.endDim[0] = NULL; free_ast_node((yyvsp[-4].ptnode)); } break; case 239: #line 2769 "f2jparse.y" { if(debug) printf("SubString! format = c(:)\n"); (yyval.ptnode) = addnode(); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-3].ptnode)->astnode.ident.name); (yyval.ptnode)->nodetype = Substring; (yyval.ptnode)->token = NAME; (yyval.ptnode)->astnode.ident.startDim[0] = NULL; (yyval.ptnode)->astnode.ident.endDim[0] = NULL; free_ast_node((yyvsp[-3].ptnode)); } break; case 240: #line 2794 "f2jparse.y" { AST *temp; temp = addnode(); temp->nodetype = Call; (yyvsp[0].ptnode)->parent = temp; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 241: #line 2804 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyvsp[0].ptnode)->parent = (yyvsp[-2].ptnode)->parent; (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 242: #line 2810 "f2jparse.y" { (yyval.ptnode) = NULL; } break; case 243: #line 2819 "f2jparse.y" { /* we don't want subroutines in the type_table * make a dlist to stuff the names in and check * them in initialize_name. */ if(in_dlist(subroutine_names, (yyvsp[-1].ptnode)->astnode.ident.name)==0){ if(debug){ printf("inserting %s in dlist and del from type\n", (yyvsp[-1].ptnode)->astnode.ident.name); } dl_insert_b(subroutine_names, strdup((yyvsp[-1].ptnode)->astnode.ident.name)); hash_delete(type_table, (yyvsp[-1].ptnode)->astnode.ident.name); } if(debug){ printf("call: %s\n", (yyvsp[-1].ptnode)->astnode.ident.name); } (yyval.ptnode) = (yyvsp[-1].ptnode); (yyval.ptnode)->nodetype = Call; } break; case 244: #line 2841 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Identifier; strcpy((yyval.ptnode)->astnode.ident.name, (yyvsp[-1].ptnode)->astnode.ident.name); (yyval.ptnode)->astnode.ident.arraylist = addnode(); (yyval.ptnode)->astnode.ident.arraylist->nodetype = EmptyArgList; free_ast_node((yyvsp[-1].ptnode)); } break; case 245: #line 2857 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 246: #line 2861 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->token = EQV; (yyval.ptnode)->nodetype = Logicalop; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 247: #line 2873 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->token = NEQV; (yyval.ptnode)->nodetype = Logicalop; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 248: #line 2887 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 249: #line 2891 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->token = OR; (yyval.ptnode)->nodetype = Logicalop; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 250: #line 2905 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 251: #line 2909 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->token = AND; (yyval.ptnode)->nodetype = Logicalop; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 252: #line 2923 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 253: #line 2927 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[0].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->token = NOT; (yyval.ptnode)->nodetype = Logicalop; (yyval.ptnode)->astnode.expression.lhs = 0; (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 254: #line 2938 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 255: #line 2941 "f2jparse.y" {temptok = yylval.tok;} break; case 256: #line 2942 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-3].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-3].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Relationalop; (yyval.ptnode)->token = temptok; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-3].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); } break; case 257: #line 2956 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 258: #line 2960 "f2jparse.y" { if((yyvsp[0].ptnode)->nodetype == Constant) { char *neg_string; neg_string = unary_negate_string((yyvsp[0].ptnode)->astnode.constant.number); if(!neg_string) { fprintf(stderr, "Error generating negated string (arith_expr)\n"); exit(EXIT_FAILURE); } free((yyvsp[0].ptnode)->astnode.constant.number); (yyvsp[0].ptnode)->astnode.constant.number = neg_string; (yyval.ptnode) = (yyvsp[0].ptnode); } else { (yyval.ptnode) = addnode(); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.expression.lhs = 0; (yyval.ptnode)->astnode.expression.minus = '-'; (yyval.ptnode)->nodetype = Unaryop; (yyval.ptnode)->vartype = (yyvsp[0].ptnode)->vartype; } } break; case 259: #line 2987 "f2jparse.y" { if((yyvsp[0].ptnode)->nodetype == Constant) { (yyval.ptnode) = (yyvsp[0].ptnode); } else { (yyval.ptnode) = addnode(); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->astnode.expression.lhs = 0; (yyval.ptnode)->astnode.expression.minus = '+'; (yyval.ptnode)->nodetype = Unaryop; (yyval.ptnode)->vartype = (yyvsp[0].ptnode)->vartype; } } break; case 260: #line 3002 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyval.ptnode)->token = PLUS; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype); (yyval.ptnode)->nodetype = Binaryop; (yyval.ptnode)->astnode.expression.optype = '+'; } break; case 261: #line 3016 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->token = MINUS; (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype); (yyval.ptnode)->nodetype = Binaryop; (yyval.ptnode)->astnode.expression.optype = '-'; } break; case 262: #line 3032 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 263: #line 3036 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyval.ptnode)->token = DIV; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype); (yyval.ptnode)->nodetype = Binaryop; (yyval.ptnode)->astnode.expression.optype = '/'; } break; case 264: #line 3050 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->token = STAR; (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype); (yyval.ptnode)->nodetype = Binaryop; (yyval.ptnode)->astnode.expression.optype = '*'; } break; case 265: #line 3067 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 266: #line 3071 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = Power; (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype); } break; case 267: #line 3083 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 268: #line 3087 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyval.ptnode)->token = CAT; (yyvsp[-2].ptnode)->expr_side = left; (yyvsp[0].ptnode)->expr_side = right; (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyvsp[0].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->astnode.expression.lhs = (yyvsp[-2].ptnode); (yyval.ptnode)->astnode.expression.rhs = (yyvsp[0].ptnode); (yyval.ptnode)->vartype = MIN((yyvsp[-2].ptnode)->vartype, (yyvsp[0].ptnode)->vartype); (yyval.ptnode)->nodetype = Binaryop; (yyval.ptnode)->astnode.expression.optype = '+'; } break; case 269: #line 3102 "f2jparse.y" {(yyval.ptnode)=(yyvsp[0].ptnode);} break; case 270: #line 3104 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 271: #line 3108 "f2jparse.y" {(yyval.ptnode)=(yyvsp[0].ptnode);} break; case 272: #line 3109 "f2jparse.y" {(yyval.ptnode)=(yyvsp[0].ptnode);} break; case 273: #line 3111 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Expression; (yyval.ptnode)->astnode.expression.parens = TRUE; (yyval.ptnode)->astnode.expression.rhs = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.expression.lhs = NULL; (yyval.ptnode)->vartype = (yyvsp[-1].ptnode)->vartype; } break; case 274: #line 3131 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = TrUE; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup("true"); (yyval.ptnode)->vartype = Logical; } break; case 275: #line 3139 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = FaLSE; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup("false"); (yyval.ptnode)->vartype = Logical; } break; case 276: #line 3151 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 277: #line 3155 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 278: #line 3159 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 279: #line 3163 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 280: #line 3167 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 281: #line 3171 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 282: #line 3177 "f2jparse.y" { if(debug)printf("Integer\n"); (yyval.ptnode) = addnode(); (yyval.ptnode)->token = INTEGER; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme); (yyval.ptnode)->vartype = Integer; } break; case 283: #line 3188 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = DOUBLE; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = strdup(yylval.lexeme); (yyval.ptnode)->vartype = Double; } break; case 284: #line 3198 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->token = FLOAT; (yyval.ptnode)->nodetype = Constant; (yyval.ptnode)->astnode.constant.number = (char *)malloc(strlen(yylval.lexeme) + 2); strcpy((yyval.ptnode)->astnode.constant.number, yylval.lexeme); strcat((yyval.ptnode)->astnode.constant.number, "f"); (yyval.ptnode)->vartype = Float; } break; case 285: #line 3217 "f2jparse.y" { char tempname[60]; (yyval.ptnode) = addnode(); (yyval.ptnode)->token = E_EXPONENTIAL; (yyval.ptnode)->nodetype = Constant; exp_to_double(yylval.lexeme, tempname); (yyval.ptnode)->astnode.constant.number = (char *)malloc(strlen(tempname) + 2); strcpy((yyval.ptnode)->astnode.constant.number, tempname); strcat((yyval.ptnode)->astnode.constant.number, "f"); (yyval.ptnode)->vartype = Float; } break; case 286: #line 3231 "f2jparse.y" { char tempname[60]; (yyval.ptnode) = addnode(); (yyval.ptnode)->token = D_EXPONENTIAL; (yyval.ptnode)->nodetype = Constant; exp_to_double(yylval.lexeme, tempname); (yyval.ptnode)->astnode.constant.number = strdup(tempname); (yyval.ptnode)->vartype = Double; } break; case 287: #line 3246 "f2jparse.y" { (yyval.ptnode)= addnode(); } break; case 288: #line 3252 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Pause; (yyval.ptnode)->astnode.constant.number = strdup(""); } break; case 289: #line 3258 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-1].ptnode); (yyval.ptnode)->nodetype = Pause; } break; case 290: #line 3265 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyval.ptnode)->nodetype = Stop; (yyval.ptnode)->astnode.constant.number = strdup(""); } break; case 291: #line 3271 "f2jparse.y" { (yyval.ptnode) = (yyvsp[-1].ptnode); (yyval.ptnode)->nodetype = Stop; } break; case 292: #line 3278 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Goto; if(debug) printf("goto label: %d\n", atoi(yylval.lexeme)); (yyval.ptnode)->astnode.go_to.label = atoi(yylval.lexeme); free_ast_node((yyvsp[-1].ptnode)); } break; case 293: #line 3290 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-3].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = ComputedGoto; (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-3].ptnode)); if(debug) printf("Computed go to,\n"); } break; case 294: #line 3301 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-4].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = ComputedGoto; (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-4].ptnode)); if(debug) printf("Computed go to,\n"); } break; case 295: #line 3314 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-4].ptnode)->parent = (yyval.ptnode); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = AssignedGoto; (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-4].ptnode); (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-2].ptnode)); if(debug) printf("Assigned go to,\n"); } break; case 296: #line 3325 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-5].ptnode)->parent = (yyval.ptnode); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = AssignedGoto; (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-5].ptnode); (yyval.ptnode)->astnode.computed_goto.intlist = switchem((yyvsp[-2].ptnode)); if(debug) printf("Assigned go to,\n"); } break; case 297: #line 3336 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); (yyval.ptnode)->nodetype = AssignedGoto; (yyval.ptnode)->astnode.computed_goto.name = (yyvsp[-1].ptnode); (yyval.ptnode)->astnode.computed_goto.intlist = NULL; if(debug) printf("Assigned go to (no intlist)\n"); } break; case 298: #line 3348 "f2jparse.y" { (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 299: #line 3352 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode) = (yyvsp[0].ptnode); } break; case 300: #line 3359 "f2jparse.y" { (yyval.ptnode) = addnode(); (yyvsp[-2].ptnode)->parent = (yyval.ptnode); /* 9-4-97 - Keith */ (yyval.ptnode)->nodetype = Specification; (yyval.ptnode)->astnode.typeunit.specification = Parameter; (yyval.ptnode)->astnode.typeunit.declist = switchem((yyvsp[-2].ptnode)); } break; case 301: #line 3369 "f2jparse.y" { (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 302: #line 3373 "f2jparse.y" { (yyvsp[0].ptnode)->prevstmt = (yyvsp[-2].ptnode); (yyval.ptnode)=(yyvsp[0].ptnode); } break; case 303: #line 3380 "f2jparse.y" { void add_decimal_point(char *); double constant_eval; HASHNODE *ht; char *cur_id; AST *temp; if(debug) printf("Parameter...\n"); (yyval.ptnode) = (yyvsp[0].ptnode); (yyval.ptnode)->nodetype = Assignment; constant_eval = eval_const_expr((yyval.ptnode)->astnode.assignment.rhs); if(debug) { printf("### constant_eval is %.40g\n", constant_eval); printf("### constant_eval is %.40e\n", constant_eval); } temp = addnode(); temp->nodetype = Constant; ht = type_lookup(type_table, (yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name); if(ht) temp->vartype = ht->variable->vartype; else temp->vartype = (yyval.ptnode)->astnode.assignment.rhs->vartype; switch(temp->vartype) { case String: case Character: temp->token = STRING; temp->astnode.constant.number = strdup((yyval.ptnode)->astnode.assignment.rhs->astnode.constant.number); break; case Complex: fprintf(stderr,"Pdec: Complex not yet supported.\n"); break; case Logical: temp->token = (yyval.ptnode)->astnode.assignment.rhs->token; temp->astnode.constant.number = strdup(temp->token == TrUE ? "true" : "false"); break; case Float: temp->token = FLOAT; temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); sprintf(temp->astnode.constant.number,"%.40g",constant_eval); add_decimal_point(temp->astnode.constant.number); strcat(temp->astnode.constant.number, "f"); break; case Double: temp->token = DOUBLE; temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); sprintf(temp->astnode.constant.number,"%.40g",constant_eval); add_decimal_point(temp->astnode.constant.number); break; case Integer: temp->token = INTEGER; temp->astnode.constant.number = (char *)malloc(MAX_CONST_LEN); sprintf(temp->astnode.constant.number,"%d",(int)constant_eval); break; default: fprintf(stderr,"Pdec: bad vartype!\n"); } free_ast_node((yyval.ptnode)->astnode.assignment.rhs); (yyval.ptnode)->astnode.assignment.rhs = temp; if(debug) printf("### the constant is '%s'\n", temp->astnode.constant.number); cur_id = strdup((yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name); if(type_lookup(java_keyword_table,cur_id)) cur_id[0] = toupper(cur_id[0]); if(debug) printf("insert param_table %s\n", (yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name); hash_delete(type_table, (yyval.ptnode)->astnode.assignment.lhs->astnode.ident.name); type_insert(parameter_table, temp, 0, cur_id); free_ast_node((yyval.ptnode)->astnode.assignment.lhs); } break; case 304: #line 3472 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-3-97 - Keith */ (yyval.ptnode)->nodetype = Specification; (yyval.ptnode)->token = EXTERNAL; (yyval.ptnode)->astnode.typeunit.declist = switchem((yyvsp[-1].ptnode)); (yyval.ptnode)->astnode.typeunit.specification = External; } break; case 305: #line 3483 "f2jparse.y" { (yyval.ptnode)=addnode(); (yyvsp[-1].ptnode)->parent = (yyval.ptnode); /* 9-3-97 - Keith */ (yyval.ptnode)->nodetype = Specification; (yyval.ptnode)->token = INTRINSIC; (yyval.ptnode)->astnode.typeunit.declist = switchem((yyvsp[-1].ptnode)); (yyval.ptnode)->astnode.typeunit.specification = Intrinsic; } break; } /* Line 1037 of yacc.c. */ #line 5762 "y.tab.c" yyvsp -= yylen; yyssp -= yylen; YY_STACK_PRINT (yyss, yyssp); *++yyvsp = yyval; /* Now `shift' the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule number reduced by. */ yyn = yyr1[yyn]; yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) yystate = yytable[yystate]; else yystate = yydefgoto[yyn - YYNTOKENS]; goto yynewstate; /*------------------------------------. | yyerrlab -- here on detecting error | `------------------------------------*/ yyerrlab: /* If not already recovering from an error, report this error. */ if (!yyerrstatus) { ++yynerrs; #if YYERROR_VERBOSE yyn = yypact[yystate]; if (YYPACT_NINF < yyn && yyn < YYLAST) { YYSIZE_T yysize = 0; int yytype = YYTRANSLATE (yychar); const char* yyprefix; char *yymsg; int yyx; /* Start YYX at -YYN if negative to avoid negative indexes in YYCHECK. */ int yyxbegin = yyn < 0 ? -yyn : 0; /* Stay within bounds of both yycheck and yytname. */ int yychecklim = YYLAST - yyn; int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; int yycount = 0; yyprefix = ", expecting "; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) { yysize += yystrlen (yyprefix) + yystrlen (yytname [yyx]); yycount += 1; if (yycount == 5) { yysize = 0; break; } } yysize += (sizeof ("syntax error, unexpected ") + yystrlen (yytname[yytype])); yymsg = (char *) YYSTACK_ALLOC (yysize); if (yymsg != 0) { char *yyp = yystpcpy (yymsg, "syntax error, unexpected "); yyp = yystpcpy (yyp, yytname[yytype]); if (yycount < 5) { yyprefix = ", expecting "; for (yyx = yyxbegin; yyx < yyxend; ++yyx) if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) { yyp = yystpcpy (yyp, yyprefix); yyp = yystpcpy (yyp, yytname[yyx]); yyprefix = " or "; } } yyerror (yymsg); YYSTACK_FREE (yymsg); } else yyerror ("syntax error; also virtual memory exhausted"); } else #endif /* YYERROR_VERBOSE */ yyerror ("syntax error"); } if (yyerrstatus == 3) { /* If just tried and failed to reuse look-ahead token after an error, discard it. */ if (yychar <= YYEOF) { /* If at end of input, pop the error token, then the rest of the stack, then return failure. */ if (yychar == YYEOF) for (;;) { YYPOPSTACK; if (yyssp == yyss) YYABORT; yydestruct ("Error: popping", yystos[*yyssp], yyvsp); } } else { yydestruct ("Error: discarding", yytoken, &yylval); yychar = YYEMPTY; } } /* Else will try to reuse look-ahead token after shifting the error token. */ goto yyerrlab1; /*---------------------------------------------------. | yyerrorlab -- error raised explicitly by YYERROR. | `---------------------------------------------------*/ yyerrorlab: #ifdef __GNUC__ /* Pacify GCC when the user code never invokes YYERROR and the label yyerrorlab therefore never appears in user code. */ if (0) goto yyerrorlab; #endif yyvsp -= yylen; yyssp -= yylen; yystate = *yyssp; goto yyerrlab1; /*-------------------------------------------------------------. | yyerrlab1 -- common code for both syntax error and YYERROR. | `-------------------------------------------------------------*/ yyerrlab1: yyerrstatus = 3; /* Each real token shifted decrements this. */ for (;;) { yyn = yypact[yystate]; if (yyn != YYPACT_NINF) { yyn += YYTERROR; if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) { yyn = yytable[yyn]; if (0 < yyn) break; } } /* Pop the current state because it cannot handle the error token. */ if (yyssp == yyss) YYABORT; yydestruct ("Error: popping", yystos[yystate], yyvsp); YYPOPSTACK; yystate = *yyssp; YY_STACK_PRINT (yyss, yyssp); } if (yyn == YYFINAL) YYACCEPT; *++yyvsp = yylval; /* Shift the error token. */ YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); yystate = yyn; goto yynewstate; /*-------------------------------------. | yyacceptlab -- YYACCEPT comes here. | `-------------------------------------*/ yyacceptlab: yyresult = 0; goto yyreturn; /*-----------------------------------. | yyabortlab -- YYABORT comes here. | `-----------------------------------*/ yyabortlab: yydestruct ("Error: discarding lookahead", yytoken, &yylval); yychar = YYEMPTY; yyresult = 1; goto yyreturn; #ifndef yyoverflow /*----------------------------------------------. | yyoverflowlab -- parser overflow comes here. | `----------------------------------------------*/ yyoverflowlab: yyerror ("parser stack overflow"); yyresult = 2; /* Fall through. */ #endif yyreturn: #ifndef yyoverflow if (yyss != yyssa) YYSTACK_FREE (yyss); #endif return yyresult; } #line 3494 "f2jparse.y" /***************************************************************************** * * * yyerror * * * * The standard yacc error routine. * * * *****************************************************************************/ void yyerror(char *s) { extern Dlist file_stack; INCLUDED_FILE *pfile; Dlist tmp; if(current_file_info) printf("%s:%d: %s\n", current_file_info->name, lineno, s); else printf("line %d: %s\n", lineno, s); dl_traverse_b(tmp, file_stack) { pfile = (INCLUDED_FILE *)dl_val(tmp); printf("\tincluded from: %s:%d\n", pfile->name, pfile->line_num); } } /***************************************************************************** * * * add_decimal_point * * * * this is just a hack to compensate for the fact that there's no printf * * specifier that does exactly what we want. assume the given string * * represents a floating point number. if there's no decimal point in the * * string, then append ".0" to it. However, if there's an 'e' in the string * * then javac will interpret it as floating point. The only real problem * * that occurs is when the constant is too big to fit as an integer, but has * * no decimal point, so javac flags it as an error (int constant too big). * * * *****************************************************************************/ void add_decimal_point(char *str) { BOOL found_dec = FALSE; char *p = str; while( *p != '\0' ) { if( *p == '.' ) { found_dec = TRUE; break; } if( *p == 'e' ) return; p++; } if(!found_dec) strcat(str, ".0"); } /***************************************************************************** * * * addnode * * * * To keep things simple, there is only one type of parse tree node. * * * *****************************************************************************/ AST * addnode() { return (AST*)f2jcalloc(1,sizeof(AST)); } /***************************************************************************** * * * switchem * * * * Need to turn the linked list around, * * so that it can traverse forward instead of in reverse. * * What I do here is create a doubly linked list. * * Note that there is no `sentinel' or `head' node * * in this list. It is acyclic and terminates in * * NULL pointers. * * * *****************************************************************************/ AST * switchem(AST * root) { if(root == NULL) return NULL; if (root->prevstmt == NULL) return root; while (root->prevstmt != NULL) { root->prevstmt->nextstmt = root; root = root->prevstmt; } return root; } /***************************************************************************** * * * assign_array_dims * * * * This is used by DIMENSION and COMMON to set the specified array * * dimensions, possibly in the absence of a type declaration. If we * * haven't seen a delcaration for this variable yet, create a new node. * * Otherwise, assign the array dimensions to the existing node. * * * *****************************************************************************/ void assign_array_dims(AST *var) { HASHNODE *hash_entry; AST *node; int i; hash_entry = type_lookup(type_table, var->astnode.ident.name); if(hash_entry) node = hash_entry->variable; else { if(debug){ printf("Calling initalize name from assign_array_dims\n"); } node = initialize_name(var->astnode.ident.name); /* if it's an intrinsic_named array */ if(node->astnode.ident.which_implicit == INTRIN_NAMED_ARRAY_OR_FUNC_CALL){ node->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY; type_insert(type_table, node, node->vartype, var->astnode.ident.name); } if(debug) printf("assign_array_dims: %s\n", var->astnode.ident.name); } node->astnode.ident.localvnum = -1; node->astnode.ident.arraylist = var->astnode.ident.arraylist; node->astnode.ident.dim = var->astnode.ident.dim; node->astnode.ident.leaddim = var->astnode.ident.leaddim; for(i=0;iastnode.ident.startDim[i] = var->astnode.ident.startDim[i]; node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i]; } /* do the same for the array table */ hash_entry = type_lookup(array_table, var->astnode.ident.name); if(hash_entry) node = hash_entry->variable; else { node = initialize_name(var->astnode.ident.name); type_insert(array_table, node, node->vartype, var->astnode.ident.name); hash_entry = type_lookup(array_table, var->astnode.ident.name); if(hash_entry) node = hash_entry->variable; else { fprintf(stderr, "internal error: lookup failed after insert\n"); return; } } node->astnode.ident.localvnum = -1; node->astnode.ident.arraylist = var->astnode.ident.arraylist; node->astnode.ident.dim = var->astnode.ident.dim; node->astnode.ident.leaddim = var->astnode.ident.leaddim; for(i=0;iastnode.ident.startDim[i] = var->astnode.ident.startDim[i]; node->astnode.ident.endDim[i] = var->astnode.ident.endDim[i]; } } /***************************************************************************** * * * assign_common_array_dims * * * * For arrays declared in COMMON blocks, we go ahead and assign the * * dimensions in case they aren't dimensioned anywhere else. * * * *****************************************************************************/ void assign_common_array_dims(AST *root) { AST *Clist, *temp; for(Clist = root->astnode.common.nlist; Clist != NULL; Clist = Clist->nextstmt) { for(temp=Clist->astnode.common.nlist; temp!=NULL; temp=temp->nextstmt) { if(temp->astnode.ident.arraylist) assign_array_dims(temp); } } } /***************************************************************************** * * * type_hash * * * * For now, type_hash takes a tree (linked list) of type * * declarations from the Decblock rule. It will need to * * get those from Intrinsic, External, Parameter, etc. * * * *****************************************************************************/ void type_hash(AST * types) { HASHNODE *hash_entry; AST * temptypes, * tempnames; int return_type; /* Outer for loop traverses typestmts, inner for() * loop traverses declists. Code for stuffing symbol table is * is in inner for() loop. */ for (temptypes = types; temptypes; temptypes = temptypes->nextstmt) { /* Long assignment, set up the for() loop here instead of the expression list. */ tempnames = temptypes->astnode.typeunit.declist; /* Need to set the return value here before entering the next for() loop. */ return_type = temptypes->astnode.typeunit.returns; if(debug) printf("type_hash(): type dec is %s\n", print_nodetype(temptypes)); if(temptypes->nodetype == CommonList) { assign_common_array_dims(temptypes); continue; } /* skip parameter statements and data statements */ if(( (temptypes->nodetype == Specification) && (temptypes->astnode.typeunit.specification == Parameter)) || (temptypes->nodetype == DataList)) continue; for (; tempnames; tempnames = tempnames->nextstmt) { int i; /* ignore parameter assignment stmts */ if((tempnames->nodetype == Assignment) || (tempnames->nodetype == DataStmt)) continue; /* Stuff names and return types into the symbol table. */ if(debug) printf("Type hash: '%s' (%s)\n", tempnames->astnode.ident.name, print_nodetype(tempnames)); if(temptypes->nodetype == Dimension) assign_array_dims(tempnames); else { /* check whether there is already an array declaration for this ident. * this would be true in case of a normal type declaration with array * declarator, in which case we'll do a little extra work here. but * for idents that were previously dimensioned, we need to get this * info out of the table. */ hash_entry = type_lookup(array_table,tempnames->astnode.ident.name); if(hash_entry) { AST *var = hash_entry->variable; tempnames->astnode.ident.localvnum = -1; tempnames->astnode.ident.arraylist = var->astnode.ident.arraylist; tempnames->astnode.ident.dim = var->astnode.ident.dim; tempnames->astnode.ident.leaddim = var->astnode.ident.leaddim; for(i=0;iastnode.ident.startDim[i] = var->astnode.ident.startDim[i]; tempnames->astnode.ident.endDim[i] = var->astnode.ident.endDim[i]; } } if((temptypes->token != INTRINSIC) && (temptypes->token != EXTERNAL)) { hash_entry = type_lookup(type_table,tempnames->astnode.ident.name); if(hash_entry == NULL) { tempnames->vartype = return_type; tempnames->astnode.ident.localvnum = -1; if(debug){ printf("hh type_insert: %s\n", tempnames->astnode.ident.name); } type_insert(type_table, tempnames, return_type, tempnames->astnode.ident.name); if(debug) printf("Type hash (non-external): %s\n", tempnames->astnode.ident.name); } else { if(debug) { printf("type_hash: Entry already exists..."); printf("going to override the type.\n"); } hash_entry->variable->vartype = tempnames->vartype; } } } /* Now separate out the EXTERNAL from the INTRINSIC on the * fortran side. */ if(temptypes != NULL) { AST *newnode; /* create a new node to stick into the intrinsic/external table * so that the type_table isn't pointing to the same node. */ newnode = addnode(); strcpy(newnode->astnode.ident.name,tempnames->astnode.ident.name); newnode->vartype = return_type; newnode->nodetype = Identifier; switch (temptypes->token) { case INTRINSIC: type_insert(intrinsic_table, newnode, return_type, newnode->astnode.ident.name); if(debug) printf("Type hash (INTRINSIC): %s\n", newnode->astnode.ident.name); break; case EXTERNAL: type_insert(external_table, newnode, return_type, newnode->astnode.ident.name); if(debug) printf("Type hash (EXTERNAL): %s\n", newnode->astnode.ident.name); break; default: /* otherwise free the node that we didn't use. */ free_ast_node(newnode); break; /* ansi thing */ } /* Close switch(). */ } } /* Close inner for() loop. */ } /* Close outer for() loop. */ } /* Close type_hash(). */ /***************************************************************************** * * * exp_to_double * * * * Java recognizes numbers of the form 1.0e+1, so the `D' and `d' need * * to be replaced with 'e'. * * * *****************************************************************************/ void exp_to_double (char *lexeme, char *temp) { char *cp = lexeme; while (*cp) /* While *cp != '\0'... */ { if (*cp == 'd' || /* sscanf can recognize 'E'. */ *cp == 'D') { *cp = 'e'; /* Replace the 'd' or 'D' with 'e'. */ break; /* Should be only one 'd', 'D', etc. */ } cp++; /* Examine the next character. */ } /* Java should be able to handle exponential notation as part * of the float or double constant. */ strcpy(temp,lexeme); } /* Close exp_to_double(). */ /***************************************************************************** * * * arg_table_load * * * * Initialize and fill a table with the names of the * * variables passed in as arguments to the function or * * subroutine. This table is later checked when variable * * types are declared so that variables are not declared * * twice. * * * *****************************************************************************/ void arg_table_load(AST * arglist) { AST * temp; /* We traverse down `prevstmt' because the arglist is * built with right recursion, i.e. in reverse. This * procedure, 'arg_table_load()' is called when the non- * terminal `functionargs' is reduced, before the * argument list is reversed. Note that a NULL pointer * at either end of the list terminates the for() loop. */ for(temp = arglist; temp; temp = temp->nextstmt) { type_insert(args_table, temp, 0, temp->astnode.ident.name); if(debug) printf("#@Arglist var. name: %s\n", temp->astnode.ident.name); } } /***************************************************************************** * * * lowercase * * * * This function takes a string and converts all characters to * * lowercase. * * * *****************************************************************************/ char * lowercase(char * name) { char *ptr = name; while (*name) { *name = tolower(*name); name++; } return ptr; } /***************************************************************************** * * * store_array_var * * * * We need to make a table of array variables, because * * fortran accesses arrays by columns instead of rows * * as C and java does. During code generation, the array * * variables are emitted in reverse to get row order. * * * *****************************************************************************/ void store_array_var(AST * var) { if(type_lookup(array_table, var->astnode.ident.name) != NULL) fprintf(stderr,"Error: more than one array declarator for array '%s'\n", var->astnode.ident.name); else type_insert(array_table, var, 0, var->astnode.ident.name); if(debug) printf("Array name: %s\n", var->astnode.ident.name); } /***************************************************************************** * * * mypow * * * * Double power function. writing this here so that we * * dont have to link in the math library. * * * *****************************************************************************/ double mypow(double x, double y) { double result; int i; if(y < 0) { fprintf(stderr,"Warning: got negative exponent in mypow!\n"); return 0.0; } if(y == 0) return 1.0; if(y == 1) return x; result = x; for(i=0;inextstmt) { /* * First check whether this common block is already in * the table. */ ht=type_lookup(common_block_table,Clist->astnode.common.name); for(temp=Clist->astnode.common.nlist, count = 0; temp!=NULL; temp=temp->nextstmt) count++; name_array = (char **) f2jalloc( count * sizeof(name_array) ); /* foreach COMMON variable */ for(temp=Clist->astnode.common.nlist, count = 0; temp!=NULL; temp=temp->nextstmt, count++) { var = temp->astnode.ident.name; /* to merge two names we concatenate the second name * to the first name, separated by an underscore. */ if(ht != NULL) { comvar = ((char **)ht->variable)[count]; und_var[0] = '_'; und_var[1] = 0; strcat(und_var,var); strcpy(var_und,var); strcat(var_und,"_"); strcpy(und_var_und,und_var); strcat(und_var_und,"_"); } if(ht == NULL) { name_array[count] = (char *) f2jalloc( strlen(var) + 1 ); strcpy(name_array[count], var); } else { if(!strcmp(var,comvar) || strstr(comvar,und_var_und) || (((t=strstr(comvar,var_und)) != NULL) && t == comvar) || (((t=strstr(comvar,und_var)) != NULL) && (t+strlen(t) == comvar+strlen(comvar)))) { name_array[count] = (char *) f2jalloc( strlen(comvar) + 1 ); strcpy(name_array[count], comvar); } else { name_array[count] = (char *) f2jalloc(strlen(temp->astnode.ident.name) + strlen(((char **)ht->variable)[count]) + 2); strcpy(name_array[count],temp->astnode.ident.name); strcat(name_array[count],"_"); strcat(name_array[count],((char **)ht->variable)[count]); } } } type_insert(common_block_table, (AST *)name_array, Float, Clist->astnode.common.name); } } /***************************************************************************** * * * addEquiv * * * * Insert the given node (which is itself a list of variables) into a list * * of equivalences. We end up with a list of lists. * * * *****************************************************************************/ void addEquiv(AST *node) { static int id = 1; /* if the list is NULL, create one */ if(equivList == NULL) { equivList = addnode(); equivList->nodetype = Equivalence; equivList->token = id++; equivList->nextstmt = NULL; equivList->prevstmt = NULL; equivList->astnode.equiv.clist = node; } else { AST *temp = addnode(); temp->nodetype = Equivalence; temp->token = id++; temp->astnode.equiv.clist = node; temp->nextstmt = equivList; temp->prevstmt = NULL; equivList = temp; } } /***************************************************************************** * * * eval_const_expr * * * * This function evaluates a floating-point expression which should consist * * of only parameters and constants. The floating-point result is returned. * * * *****************************************************************************/ double eval_const_expr(AST *root) { HASHNODE *p; double result1, result2; if(root == NULL) return 0.0; switch (root->nodetype) { case Identifier: if(!strcmp(root->astnode.ident.name,"*")) return 0.0; p = type_lookup(parameter_table, root->astnode.ident.name); if(p) { if(p->variable->nodetype == Constant) { root->vartype = p->variable->vartype; return ( atof(p->variable->astnode.constant.number) ); } } /* else p==NULL, then the array size is specified with a * variable, but we cant find it in the parameter table. * it is probably an argument to the function. do nothing * here, just fall through and hit the 'return 0' below. --keith */ return 0.0; case Expression: if (root->astnode.expression.lhs != NULL) eval_const_expr (root->astnode.expression.lhs); result2 = eval_const_expr (root->astnode.expression.rhs); root->token = root->astnode.expression.rhs->token; root->vartype = root->astnode.expression.rhs->vartype; return (result2); case Power: result1 = eval_const_expr (root->astnode.expression.lhs); result2 = eval_const_expr (root->astnode.expression.rhs); root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); return( mypow(result1,result2) ); case Binaryop: result1 = eval_const_expr (root->astnode.expression.lhs); result2 = eval_const_expr (root->astnode.expression.rhs); root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); if(root->astnode.expression.optype == '-') return (result1 - result2); else if(root->astnode.expression.optype == '+') return (result1 + result2); else if(root->astnode.expression.optype == '*') return (result1 * result2); else if(root->astnode.expression.optype == '/') return (result1 / result2); else fprintf(stderr,"eval_const_expr: Bad optype!\n"); return 0.0; case Unaryop: root->vartype = root->astnode.expression.rhs->vartype; /* result1 = eval_const_expr (root->astnode.expression.rhs); if(root->astnode.expression.minus == '-') return -result1; */ break; case Constant: if(debug) printf("### its a constant.. %s\n", root->astnode.constant.number); if(root->token == STRING) { if(!strcmp(root->astnode.ident.name,"*")) return 0.0; else fprintf (stderr, "String in array dec (%s)!\n", root->astnode.constant.number); } else return( atof(root->astnode.constant.number) ); break; case ArrayIdxRange: /* I dont think it really matters what the type of this node is. --kgs */ root->vartype = MIN(root->astnode.expression.lhs->vartype, root->astnode.expression.rhs->vartype); return( eval_const_expr(root->astnode.expression.rhs) - eval_const_expr(root->astnode.expression.lhs) ); case Logicalop: { int lhs=0, rhs; root->nodetype = Constant; root->vartype = Logical; eval_const_expr(root->astnode.expression.lhs); eval_const_expr(root->astnode.expression.rhs); if(root->token != NOT) lhs = root->astnode.expression.lhs->token == TrUE; rhs = root->astnode.expression.rhs->token == TrUE; switch (root->token) { case EQV: root->token = (lhs == rhs) ? TrUE : FaLSE; break; case NEQV: root->token = (lhs != rhs) ? TrUE : FaLSE; break; case AND: root->token = (lhs && rhs) ? TrUE : FaLSE; break; case OR: root->token = (lhs || rhs) ? TrUE : FaLSE; break; case NOT: root->token = (! rhs) ? TrUE : FaLSE; break; } return (double)root->token; } default: fprintf(stderr,"eval_const_expr(): bad nodetype!\n"); return 0.0; } return 0.0; } void printbits(char *header, void *var, int datalen) { int i; printf("%s: ", header); for(i=0;i> 7 ); printf("%1x", ((unsigned char *)var)[i] >> 6 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 5 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 4 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 3 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 2 & 1 ); printf("%1x", ((unsigned char *)var)[i] >> 1 & 1 ); printf("%1x", ((unsigned char *)var)[i] & 1 ); } printf("\n"); } /***************************************************************************** * * * unary_negate_string * * * * This function accepts a string and prepends a '-' in front of it. * * * *****************************************************************************/ char * unary_negate_string(char *num) { char *tempstr, *mchar; /* allocate enough for the number, minus sign, and null char */ tempstr = (char *)f2jalloc(strlen(num) + 5); if(!tempstr) return NULL; strcpy(tempstr, num); if((mchar = first_char_is_minus(tempstr)) != NULL) { *mchar = ' '; return tempstr; } strcpy(tempstr,"-"); strcat(tempstr,num); return tempstr; } /***************************************************************************** * * * first_char_is_minus * * * * Determines whether the number represented by this string is negative. * * If negative, this function returns a pointer to the minus sign. if non- * * negative, returns NULL. * * * *****************************************************************************/ char * first_char_is_minus(char *num) { char *ptr = num; while( *ptr ) { if( *ptr == '-' ) return ptr; if( *ptr != ' ' ) return NULL; ptr++; } return NULL; } /***************************************************************************** * * * gen_incr_expr * * * * this function creates an AST sub-tree representing a calculation of the * * increment for this loop. for null increments, add one. for non-null * * increments, add the appropriate value. * * *****************************************************************************/ AST * gen_incr_expr(AST *counter, AST *incr) { AST *plus_node, *const_node, *assign_node, *lhs_copy, *rhs_copy, *incr_copy; lhs_copy = addnode(); memcpy(lhs_copy, counter, sizeof(AST)); rhs_copy = addnode(); memcpy(rhs_copy, counter, sizeof(AST)); if(incr == NULL) { const_node = addnode(); const_node->token = INTEGER; const_node->nodetype = Constant; const_node->astnode.constant.number = strdup("1"); const_node->vartype = Integer; plus_node = addnode(); plus_node->token = PLUS; rhs_copy->parent = plus_node; const_node->parent = plus_node; plus_node->astnode.expression.lhs = rhs_copy; plus_node->astnode.expression.rhs = const_node; plus_node->nodetype = Binaryop; plus_node->astnode.expression.optype = '+'; } else { incr_copy = addnode(); memcpy(incr_copy, incr, sizeof(AST)); plus_node = addnode(); plus_node->token = PLUS; rhs_copy->parent = plus_node; incr_copy->parent = plus_node; plus_node->astnode.expression.lhs = rhs_copy; plus_node->astnode.expression.rhs = incr_copy; plus_node->nodetype = Binaryop; plus_node->astnode.expression.optype = '+'; } assign_node = addnode(); assign_node->nodetype = Assignment; lhs_copy->parent = assign_node; plus_node->parent = assign_node; assign_node->astnode.assignment.lhs = lhs_copy; assign_node->astnode.assignment.rhs = plus_node; return assign_node; } /***************************************************************************** * * * gen_iter_expr * * * * this function creates an AST sub-tree representing a calculation of the * * number of iterations of a DO loop: * * (stop-start+incr)/incr * * the full expression is MAX(INT((stop-start+incr)/incr),0) but we will * * worry about the rest of it at code generation time. * * * *****************************************************************************/ AST * gen_iter_expr(AST *start, AST *stop, AST *incr) { AST *minus_node, *plus_node, *div_node, *expr_node, *incr_node; minus_node = addnode(); minus_node->token = MINUS; minus_node->astnode.expression.lhs = stop; minus_node->astnode.expression.rhs = start; minus_node->nodetype = Binaryop; minus_node->astnode.expression.optype = '-'; if(incr == NULL) { incr_node = addnode(); incr_node->token = INTEGER; incr_node->nodetype = Constant; incr_node->astnode.constant.number = strdup("1"); incr_node->vartype = Integer; } else incr_node = incr; plus_node = addnode(); plus_node->token = PLUS; plus_node->astnode.expression.lhs = minus_node; plus_node->astnode.expression.rhs = incr_node; plus_node->nodetype = Binaryop; plus_node->astnode.expression.optype = '+'; if(incr == NULL) return plus_node; expr_node = addnode(); expr_node->nodetype = Expression; expr_node->astnode.expression.parens = TRUE; expr_node->astnode.expression.rhs = plus_node; expr_node->astnode.expression.lhs = NULL; div_node = addnode(); div_node->token = DIV; div_node->astnode.expression.lhs = expr_node; div_node->astnode.expression.rhs = incr_node; div_node->nodetype = Binaryop; div_node->astnode.expression.optype = '/'; return div_node; } /***************************************************************************** * * * initialize_name * * * * this function initializes an Identifier node with the given name. * * * *****************************************************************************/ AST * initialize_name(char *id) { HASHNODE *hashtemp; AST *tmp, *tnode; char *tempname; if(debug) printf("initialize_name: '%s'\n",id); tmp=addnode(); tmp->token = NAME; tmp->nodetype = Identifier; tmp->astnode.ident.needs_declaration = FALSE; tmp->astnode.ident.explicit = FALSE; tmp->astnode.ident.which_implicit = INTRIN_NOT_NAMED; tmp->astnode.ident.localvnum = -1; tmp->astnode.ident.array_len = -1; if(omitWrappers) tmp->astnode.ident.passByRef = FALSE; if(type_lookup(java_keyword_table,id)) id[0] = toupper(id[0]); strcpy(tmp->astnode.ident.name, id); tempname = strdup(tmp->astnode.ident.name); uppercase(tempname); if((type_lookup(parameter_table, tmp->astnode.ident.name) == NULL) && (in_dlist(subroutine_names, tmp->astnode.ident.name) == 0)) { if(type_table) { hashtemp = type_lookup(type_table, tmp->astnode.ident.name); if(hashtemp) { if(debug) printf("initialize_name:'%s' in already hash table (type=%s)..\n", id, returnstring[hashtemp->variable->vartype]); tmp->vartype = hashtemp->variable->vartype; if(debug) printf("now type is %s\n", returnstring[tmp->vartype]); tmp->astnode.ident.len = hashtemp->variable->astnode.ident.len; } else { enum returntype ret; if(debug) printf("initialize_name:cannot find name %s in hash table..\n",id); if(methodscan(intrinsic_toks, tempname) != NULL) { tmp->astnode.ident.which_implicit = intrinsic_or_implicit(tmp->astnode.ident.name); } ret = implicit_table[tolower(id[0]) - 'a'].type; if(debug) printf("initialize_name:insert with default implicit type %s\n", returnstring[ret]); tmp->vartype = ret; if(debug) printf("type_insert: %s %d\n", tmp->astnode.ident.name, tmp->nodetype); /* clone the ast node before inserting into the table */ tnode = clone_ident(tmp); tnode->nodetype = Identifier; if(tmp->astnode.ident.which_implicit != INTRIN_NAMED_ARRAY_OR_FUNC_CALL) { if(debug) printf("insert typetable init name\n"); type_insert(type_table, tnode, ret, tnode->astnode.ident.name); } } } } return tmp; } /***************************************************************************** * * * intrinsic_or_implict * * * * Only gets called if it is an intrinsic name. * * * * this functions tries to figure out if it's intrinsic call, array * * or variable. * * * ******************************************************************************/ int intrinsic_or_implicit(char *name) { char *p, *tempname, *space_buffer, *clean_buffer, *tmp_spot; char *words[12] = {"INTEGER", "DOUBLEPRECISION", "CHARACTER", "DATA", "PARAMETER", "LOGICAL", "INTRINSIC", "EXTERNAL", "SAVE", "IMPLICIT", "DIMENSION", "CALL"}; int i, ret_val = INTRIN_NAMED_VARIABLE; tempname = (char *)malloc((strlen(name)+2)*sizeof(char)); space_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char)); clean_buffer = (char *)malloc((strlen(line_buffer)+2)*sizeof(char)); strcpy(tempname, name); uppercase(tempname); strcat(tempname, "("); uppercase(line_buffer); tmp_spot = line_buffer; for(i=0; i<12; i++) { if(!strncmp(line_buffer, words[i], strlen(words[i]))) { tmp_spot = line_buffer + strlen(words[i]); break; } } strcpy(clean_buffer, " \0"); strcat(clean_buffer, tmp_spot); p = strstr(clean_buffer, tempname); while(p) { if((p)&&(!isalpha((int)*(p-1)))) { ret_val=INTRIN_NAMED_ARRAY_OR_FUNC_CALL; break; } for(i=0; i< strlen(tempname); i++) p++; strcpy(space_buffer, " \0"); strcat(space_buffer, p); p = strstr(space_buffer, tempname); } free(space_buffer); free(clean_buffer); free(tempname); return ret_val; } /***************************************************************************** * * * print_sym_table_names * * * * Routine to see what's in the symbol table. * * * *****************************************************************************/ void print_sym_table_names(SYMTABLE *table){ Dlist t_table, tmp; AST *node; t_table = enumerate_symtable(table); dl_traverse(tmp, t_table){ node = (AST *)dl_val(tmp); printf("sym_table %s\n", node->astnode.ident.name); } } /***************************************************************************** * * * insert_name * * * * this function inserts the given node into the symbol table, if it is not * * already there. * * * *****************************************************************************/ void insert_name(SYMTABLE * tt, AST *node, enum returntype ret) { HASHNODE *hash_entry; hash_entry = type_lookup(tt,node->astnode.ident.name); if(hash_entry == NULL) node->vartype = ret; else node->vartype = hash_entry->variable->vartype; type_insert(tt, node, node->vartype, node->astnode.ident.name); } /***************************************************************************** * * * initialize_implicit_table * * * * this function the implicit table, which indicates the implicit typing for * * the current program unit (i.e. which letters correspond to which data * * type). * * * *****************************************************************************/ void initialize_implicit_table(ITAB_ENTRY *itab) { int i; /* first initialize everything to float */ for(i = 0; i < 26; i++) { itab[i].type = Float; itab[i].declared = FALSE; } /* then change 'i' through 'n' to Integer */ for(i = 'i' - 'a'; i <= 'n' - 'a'; i++) itab[i].type = Integer; } /***************************************************************************** * * * add_implicit_to_tree * * * * this adds a node for an implicit variable to typedec * * * *****************************************************************************/ void add_implicit_to_tree(AST *typedec) { Dlist t_table, tmp; AST *ast, *new_node, *last_typedec; last_typedec = typedec; while(last_typedec->nextstmt!=NULL) { last_typedec = last_typedec->nextstmt; } t_table = enumerate_symtable(type_table); dl_traverse(tmp, t_table) { ast = (AST *)dl_val(tmp); if(ast->astnode.ident.explicit == FALSE) { if(debug)printf("implicit name=%s\n", ast->astnode.ident.name); new_node = addnode(); new_node->astnode.typeunit.returns = ast->vartype; new_node->nodetype = Typedec; ast->parent = new_node; new_node->astnode.typeunit.declist = clone_ident(ast); last_typedec->nextstmt = new_node; last_typedec = last_typedec->nextstmt; } } } /***************************************************************************** * * * clone_ident * * * * this function clones an astnode(ident) and passes back the new node * * * *****************************************************************************/ AST * clone_ident(AST *ast) { AST *new_node; int i; new_node = addnode(); new_node->parent = ast->parent; new_node->vartype = ast->vartype; new_node->astnode.ident.dim = ast->astnode.ident.dim; new_node->astnode.ident.position = ast->astnode.ident.position; new_node->astnode.ident.len = ast->astnode.ident.len; new_node->astnode.ident.localvnum = ast->astnode.ident.localvnum; new_node->astnode.ident.which_implicit = ast->astnode.ident.which_implicit; new_node->astnode.ident.passByRef = ast->astnode.ident.passByRef; new_node->astnode.ident.needs_declaration = ast->astnode.ident.needs_declaration; new_node->astnode.ident.explicit = FALSE; for(i=0; i<=MAX_ARRAY_DIM; i++) { new_node->astnode.ident.startDim[i] = ast->astnode.ident.startDim[i]; new_node->astnode.ident.endDim[i] = ast->astnode.ident.endDim[i]; } new_node->astnode.ident.arraylist = ast->astnode.ident.arraylist; if(ast->astnode.ident.leaddim) new_node->astnode.ident.leaddim = strdup(ast->astnode.ident.leaddim); if(ast->astnode.ident.opcode) new_node->astnode.ident.opcode = strdup(ast->astnode.ident.opcode); if(ast->astnode.ident.commonBlockName) new_node->astnode.ident.commonBlockName = strdup(ast->astnode.ident.commonBlockName); strcpy(new_node->astnode.ident.name, ast->astnode.ident.name); if(ast->astnode.ident.merged_name) new_node->astnode.ident.merged_name = strdup(ast->astnode.ident.merged_name); if(ast->astnode.ident.descriptor) new_node->astnode.ident.descriptor = strdup(ast->astnode.ident.descriptor); return new_node; } /***************************************************************************** * * * in_dlist * * * * Returns 1 if the given name is in the list, returns 0 otherwise. * * Assumes that the list contains char pointers. * * * *****************************************************************************/ int in_dlist(Dlist list, char *name) { Dlist ptr; char *list_name; dl_traverse(ptr, list){ list_name = (char *)dl_val(ptr); if(!strcmp(list_name, name)) return 1; } return 0; } /***************************************************************************** * * * in_dlist_stmt_label * * * * Returns 1 if the given label is in the list, returns 0 otherwise. * * Assumes that the list contains AST pointers. * * * *****************************************************************************/ int in_dlist_stmt_label(Dlist list, AST *label) { Dlist ptr; AST *tmp; dl_traverse(ptr, list){ tmp = (AST *)dl_val(ptr); if(!strcmp(tmp->astnode.constant.number, label->astnode.constant.number)) return 1; } return 0; } /***************************************************************************** * * * process_typestmt * * * * Performs processing to handle a list of variable declarations. * * * *****************************************************************************/ AST * process_typestmt(enum returntype this_type, AST *tvlist) { AST *temp, *new; enum returntype ret; HASHNODE *hashtemp, *hashtemp2; new = addnode(); free_ast_node(tvlist->parent); tvlist = switchem(tvlist); new->nodetype = Typedec; for(temp = tvlist; temp != NULL; temp = temp->nextstmt) { temp->vartype = this_type; ret = this_type; if(temp->astnode.ident.len < 0) temp->astnode.ident.len = len; temp->parent = new; hashtemp = type_lookup(args_table, temp->astnode.ident.name); if(hashtemp) hashtemp->variable->vartype = this_type; hashtemp2 = type_lookup(type_table, temp->astnode.ident.name); if(hashtemp2) { temp->vartype = this_type; temp->astnode.ident.explicit = TRUE; hashtemp2->variable = temp; if(debug) printf("explicit: %s\n", hashtemp2->variable->astnode.ident.name); } if(hashtemp) { if(temp->vartype != hashtemp->variable->vartype){ if(debug) printf("different vartypes\n"); hashtemp->variable->vartype=temp->vartype; hashtemp2->variable->vartype=temp->vartype; } } } new->astnode.typeunit.declist = tvlist; new->astnode.typeunit.returns = this_type; return new; } /***************************************************************************** * * * process_array_declaration * * * * Performs processing to handle an array declaration. * * * *****************************************************************************/ AST * process_array_declaration(AST *varname, AST *dimlist) { AST *new, *temp, *tmp, *tnode; int count, i, alen; char *tempname, *id; enum returntype ret; if(debug) printf("we have an array declaration %s\n", varname->astnode.ident.name); tempname = strdup(varname->astnode.ident.name); uppercase(tempname); /* put in type table. we now know this intrinsic name is an array */ if(methodscan(intrinsic_toks, tempname) != NULL) { tmp=addnode(); tmp->token = NAME; tmp->nodetype = Identifier; tmp->astnode.ident.needs_declaration = FALSE; tmp->astnode.ident.explicit = FALSE; tmp->astnode.ident.localvnum = -1; id = strdup(varname->astnode.ident.name); strcpy(tmp->astnode.ident.name, id); ret = implicit_table[tolower(id[0]) - 'a'].type; tmp->vartype = ret; tnode = clone_ident(tmp); tnode->nodetype = Identifier; tnode->astnode.ident.which_implicit = INTRIN_NAMED_ARRAY; type_insert(type_table, tnode, ret, tnode->astnode.ident.name); } new = varname; if(debug) printf("reduced arraydeclaration... calling switchem\n"); new->astnode.ident.arraylist = switchem(dimlist); count = 0; for(temp=new->astnode.ident.arraylist; temp != NULL; temp=temp->nextstmt) count++; if(count > MAX_ARRAY_DIM) { fprintf(stderr,"Error: array %s exceeds max ", new->astnode.ident.name); fprintf(stderr,"number of dimensions: %d\n", MAX_ARRAY_DIM); exit(EXIT_FAILURE); } new->astnode.ident.dim = count; /* * If this is a one-dimensional one-length character array, for example: * character foo(12) * character*1 bar(12) * then don't treat as an array. Set dimension to zero and arraylist * to NULL. Save the arraylist in startDim[2] since we will need it * during code generation. */ if((typedec_context == String) && (len == 1) && (count == 1)) { new->astnode.ident.dim = 0; new->astnode.ident.startDim[2] = new->astnode.ident.arraylist; new->astnode.ident.arraylist = NULL; return new; } alen = 1; for(temp = new->astnode.ident.arraylist, i = 0; temp != NULL; temp=temp->nextstmt, i++) { /* if this dimension is an implied size, then set both * start and end to NULL. */ if((temp->nodetype == Identifier) && (temp->astnode.ident.name[0] == '*')) { new->astnode.ident.startDim[i] = NULL; new->astnode.ident.endDim[i] = NULL; alen = 0; } else if(temp->nodetype == ArrayIdxRange) { new->astnode.ident.startDim[i] = temp->astnode.expression.lhs; new->astnode.ident.endDim[i] = temp->astnode.expression.rhs; alen *= (int)(eval_const_expr(new->astnode.ident.endDim[i]) - eval_const_expr(new->astnode.ident.startDim[i])) + 1; } else { new->astnode.ident.startDim[i] = NULL; new->astnode.ident.endDim[i] = temp; alen *= (int) eval_const_expr(new->astnode.ident.endDim[i]); } } if(alen) new->astnode.ident.array_len = alen; else new->astnode.ident.array_len = -1; new->astnode.ident.leaddim = NULL; /* leaddim might be a constant, so check for that. --keith */ if(new->astnode.ident.arraylist->nodetype == Constant) { new->astnode.ident.leaddim = strdup(new->astnode.ident.arraylist->astnode.constant.number); } else { new->astnode.ident.leaddim = strdup(new->astnode.ident.arraylist->astnode.ident.name); } store_array_var(new); return new; } /***************************************************************************** * * * process_subroutine_call * * * * Performs processing to handle a subroutine/function call or array access. * * * *****************************************************************************/ AST * process_subroutine_call(AST *varname, AST *explist) { char *tempname; AST *new; new = addnode(); varname->parent = new; if(explist != NULL) strcpy(explist->parent->astnode.ident.name, varname->astnode.ident.name); /* * Here we could look up the name in the array table and set * the nodetype to ArrayAccess if it is found. Then the code * generator could easily distinguish between array accesses * and function calls. I'll have to implement the rest of * this soon. -- Keith * * if(type_lookup(array_table, varname->astnode.ident.name)) * new->nodetype = ArrayAccess; * else * new->nodetype = Identifier; */ new->nodetype = Identifier; strcpy(new->astnode.ident.name, varname->astnode.ident.name); /* We don't switch index order. */ if(explist == NULL) { new->astnode.ident.arraylist = addnode(); new->astnode.ident.arraylist->nodetype = EmptyArgList; } else new->astnode.ident.arraylist = switchem(explist); tempname = strdup(new->astnode.ident.name); uppercase(tempname); if(!type_lookup(external_table, new->astnode.ident.name) && !type_lookup(array_table, new->astnode.ident.name) && methodscan(intrinsic_toks, tempname)) { HASHNODE *ife; /* this must be an intrinsic function call, so remove * the entry from the type table (because the code * generator checks whether something is an intrinsic * or not by checking whether it's in the type table). */ ife = type_lookup(type_table, new->astnode.ident.name); if(ife) ife = hash_delete(type_table, new->astnode.ident.name); } free_ast_node(varname); free(tempname); return new; } /***************************************************************************** * * * assign_function_return_type * * * * This function scans the type declarations to see if this function was * * declared. If so, we reset the return type of the function to the * * type declared here. e.g.: * * function dlaneg(n) * * integer n * * integer dlaneg * * Normally the function would have an implicit type of REAL, but it * * will be set to INTEGER in this case. * * * *****************************************************************************/ void assign_function_return_type(AST *func, AST *specs) { AST *temp, *dec_temp; HASHNODE *ht; for(temp = specs; temp; temp=temp->nextstmt) { if(temp->nodetype == Typedec) { for(dec_temp = temp->astnode.typeunit.declist; dec_temp; dec_temp = dec_temp->nextstmt) { if(!strcmp(dec_temp->astnode.ident.name, func->astnode.source.name->astnode.ident.name)) { func->astnode.source.returns = temp->astnode.typeunit.returns; func->vartype = temp->astnode.typeunit.returns; func->astnode.source.name->vartype = temp->astnode.typeunit.returns; ht = type_lookup(type_table, dec_temp->astnode.ident.name); /* the else case shouldn't be hit since the implied variable * should have been inserted already. */ if(ht) ht->variable->vartype = temp->astnode.typeunit.returns; else insert_name(type_table, dec_temp, temp->astnode.typeunit.returns); } } } } } f2j-0.8.1/src/y.tab.h0000600000077700002310000001224011031241064014217 0ustar seymourgraduate/* A Bison parser, made by GNU Bison 2.0. */ /* Skeleton parser for Yacc-like parsing with Bison, Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. 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, or (at your option) any later version. 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. */ /* As a special exception, when this file is copied by Bison into a Bison output file, you may use that output file without restriction. This special exception was added by the Free Software Foundation in version 1.24 of Bison. */ /* Tokens. */ #ifndef YYTOKENTYPE # define YYTOKENTYPE /* Put the tokens into the symbol table, so that GDB and other debuggers know about them. */ enum yytokentype { PLUS = 258, MINUS = 259, OP = 260, CP = 261, STAR = 262, POW = 263, DIV = 264, CAT = 265, CM = 266, EQ = 267, COLON = 268, NL = 269, NOT = 270, AND = 271, OR = 272, RELOP = 273, EQV = 274, NEQV = 275, NAME = 276, DOUBLE = 277, INTEGER = 278, E_EXPONENTIAL = 279, D_EXPONENTIAL = 280, CONST_EXP = 281, TrUE = 282, FaLSE = 283, ICON = 284, RCON = 285, LCON = 286, CCON = 287, FLOAT = 288, CHARACTER = 289, LOGICAL = 290, COMPLEX = 291, NONE = 292, IF = 293, THEN = 294, ELSE = 295, ELSEIF = 296, ENDIF = 297, DO = 298, GOTO = 299, ASSIGN = 300, TO = 301, CONTINUE = 302, STOP = 303, RDWR = 304, END = 305, ENDDO = 306, STRING = 307, CHAR = 308, PAUSE = 309, OPEN = 310, CLOSE = 311, BACKSPACE = 312, REWIND = 313, ENDFILE = 314, FORMAT = 315, PROGRAM = 316, FUNCTION = 317, SUBROUTINE = 318, ENTRY = 319, CALL = 320, RETURN = 321, ARITH_TYPE = 322, CHAR_TYPE = 323, DIMENSION = 324, INCLUDE = 325, COMMON = 326, EQUIVALENCE = 327, EXTERNAL = 328, PARAMETER = 329, INTRINSIC = 330, IMPLICIT = 331, SAVE = 332, DATA = 333, COMMENT = 334, READ = 335, WRITE = 336, PRINT = 337, FMT = 338, EDIT_DESC = 339, REPEAT = 340, OPEN_IOSTAT = 341, OPEN_ERR = 342, OPEN_FILE = 343, OPEN_STATUS = 344, OPEN_ACCESS = 345, OPEN_FORM = 346, OPEN_UNIT = 347, OPEN_RECL = 348, OPEN_BLANK = 349, LOWER_THAN_COMMENT = 350 }; #endif #define PLUS 258 #define MINUS 259 #define OP 260 #define CP 261 #define STAR 262 #define POW 263 #define DIV 264 #define CAT 265 #define CM 266 #define EQ 267 #define COLON 268 #define NL 269 #define NOT 270 #define AND 271 #define OR 272 #define RELOP 273 #define EQV 274 #define NEQV 275 #define NAME 276 #define DOUBLE 277 #define INTEGER 278 #define E_EXPONENTIAL 279 #define D_EXPONENTIAL 280 #define CONST_EXP 281 #define TrUE 282 #define FaLSE 283 #define ICON 284 #define RCON 285 #define LCON 286 #define CCON 287 #define FLOAT 288 #define CHARACTER 289 #define LOGICAL 290 #define COMPLEX 291 #define NONE 292 #define IF 293 #define THEN 294 #define ELSE 295 #define ELSEIF 296 #define ENDIF 297 #define DO 298 #define GOTO 299 #define ASSIGN 300 #define TO 301 #define CONTINUE 302 #define STOP 303 #define RDWR 304 #define END 305 #define ENDDO 306 #define STRING 307 #define CHAR 308 #define PAUSE 309 #define OPEN 310 #define CLOSE 311 #define BACKSPACE 312 #define REWIND 313 #define ENDFILE 314 #define FORMAT 315 #define PROGRAM 316 #define FUNCTION 317 #define SUBROUTINE 318 #define ENTRY 319 #define CALL 320 #define RETURN 321 #define ARITH_TYPE 322 #define CHAR_TYPE 323 #define DIMENSION 324 #define INCLUDE 325 #define COMMON 326 #define EQUIVALENCE 327 #define EXTERNAL 328 #define PARAMETER 329 #define INTRINSIC 330 #define IMPLICIT 331 #define SAVE 332 #define DATA 333 #define COMMENT 334 #define READ 335 #define WRITE 336 #define PRINT 337 #define FMT 338 #define EDIT_DESC 339 #define REPEAT 340 #define OPEN_IOSTAT 341 #define OPEN_ERR 342 #define OPEN_FILE 343 #define OPEN_STATUS 344 #define OPEN_ACCESS 345 #define OPEN_FORM 346 #define OPEN_UNIT 347 #define OPEN_RECL 348 #define OPEN_BLANK 349 #define LOWER_THAN_COMMENT 350 #if ! defined (YYSTYPE) && ! defined (YYSTYPE_IS_DECLARED) #line 120 "f2jparse.y" typedef union YYSTYPE { struct ast_node *ptnode; int tok; enum returntype type; char lexeme[YYTEXTLEN]; } YYSTYPE; /* Line 1318 of yacc.c. */ #line 234 "y.tab.h" # define yystype YYSTYPE /* obsolescent; will be withdrawn */ # define YYSTYPE_IS_DECLARED 1 # define YYSTYPE_IS_TRIVIAL 1 #endif extern YYSTYPE yylval; f2j-0.8.1/src/make.def.in0000600000077700002310000000055311031241064015037 0ustar seymourgraduate CC=@CC@ YACC=@YACC@ PURIFY=@PURIFY@ BYTE_DIR=@BYTE_DIR@ LIBS=@LIBS@ INCLUDES=-I $(BYTE_DIR) F2J_BINDIR=@F2J_INSTALL_PREFIX@/bin # defining DEBUG_MEM includes some code that will # trash any freed memory, thus helping to expose # some memory-related bugs in f2j. # CFLAGS=-Wall -DDEBUG_MEM @CFLAGS@ PFLAGS=-cache-dir=/tmp YFLAGS=-t --debug --defines --verbose f2j-0.8.1/src/LICENSE0000600000077700002310000003537111031241064014050 0ustar seymourgraduate LICENSE The license covering the f2j source code is basically GPL with the addition of the BSD advertising clause. GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave, Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. f2j-0.8.1/src/Makefile0000600000077700002310000000374111031241064014477 0ustar seymourgraduate# $Author: keithseymour $ # $Date: 2007/02/01 01:06:37 $ # $Source: /cvsroot/f2j/f2j/src/Makefile,v $ # Revision:$ .PHONY: clean include make.def OBJS=y.tab.o f2jlex.o f2jmain.o symtab.o \ codegen.o vcg_emitter.o dlist.o typecheck.o \ optimize.o globals.o f2jmem.o F2J_LIBS= -L$(BYTE_DIR) -lbytecode $(LIBS) .c.o: $(CC) $(CFLAGS) $(INCLUDES) -c $< # The main executable. f2java: f2j.h f2jparse.y $(OBJS) $(BYTE_DIR)/libbytecode.a $(CC) $(CFLAGS) $(INCLUDES) -o $@ $(OBJS) $(F2J_LIBS) # The purify version... puref2j: f2j.h f2jparse.y $(OBJS) $(JAVAB) $(PURIFY) $(PFLAGS) $(CC) $(CFLAGS) $(INCLUDES) -o $@ $(OBJS) $(F2J_LIBS) install: f2java install -d -m 755 $(F2J_BINDIR) install -m 755 f2java $(F2J_BINDIR) lexdebug: f2jlex.c $(CC) $(CFLAGS) $(INCLUDES) -o lexdebug -DSTANDALONE f2jlex.c lint: lint codegen.c dlist.c f2jlex.c\ f2jmain.c f2jmem.c y.tab.c globals.c optimize.c\ symtab.c typecheck.c vcg_emitter.c y.tab.c y.tab.h: f2jparse.y $(YACC) $(YFLAGS) f2jparse.y y.tab.o: y.tab.c f2j.h symtab.h dlist.h \ opcodes.h f2jmem.h f2jlex.o: f2jlex.c initialize.h f2j.h symtab.h dlist.h \ opcodes.h y.tab.h f2jmem.h f2jmain.o: f2jmain.c f2j.h symtab.h dlist.h opcodes.h \ y.tab.h f2jmem.h symtab.o: symtab.c f2j.h symtab.h dlist.h opcodes.h \ f2jmem.h codegen.o: codegen.c codegen.h f2j.h symtab.h dlist.h \ opcodes.h y.tab.h f2jmem.h vcg_emitter.o: vcg_emitter.c f2j.h symtab.h dlist.h \ opcodes.h y.tab.h dlist.o: dlist.c dlist.h f2j.h symtab.h opcodes.h \ f2jmem.h typecheck.o: typecheck.c f2j.h symtab.h dlist.h \ opcodes.h y.tab.h f2jmem.h optimize.o: optimize.c f2j.h symtab.h dlist.h \ opcodes.h codegen.h y.tab.h f2jmem.h globals.o: globals.c f2j.h symtab.h dlist.h opcodes.h \ codegen.h y.tab.h f2jmem.o: f2jmem.c f2jmem.h f2j.h symtab.h dlist.h \ opcodes.h clean: rm -f *.o *.class f2jparse.c y.tab.c y.tab.h \ tmp f2j f2java core a.out *.output *~ *.vcg cd test; $(MAKE) clean realclean: clean rm -f ../bin/f2java ../bin/puref2j f2j-0.8.1/src/f2j-config.h.in0000600000077700002310000000034511031241064015536 0ustar seymourgraduate/* * $Source: /cvsroot/f2j/f2j/src/f2j-config.h.in,v $ * $Revision: 1.1 $ * $Date: 2008/06/24 21:03:44 $ * $Author: keithseymour $ */ #ifndef _F2J_CONFIG_H #define _F2J_CONFIG_H #define F2J_VERSION "@F2J_VERSION@" #endif f2j-0.8.1/doc/0000700000077700002310000000000011031241067013011 5ustar seymourgraduatef2j-0.8.1/doc/Makefile0000600000077700002310000000063411031241067014456 0ustar seymourgraduateLATEX=latex BIBTEX=bibtex SOURCES = f2j_ug.tex title.tex f2j_ug.ps: f2j_ug.dvi f2j_ug.dvi: $(SOURCES) $(LATEX) f2j_ug.tex # $(BIBTEX) f2j_ug # $(LATEX) f2j_ug.tex # $(LATEX) f2j_ug.tex f2j_ug.ps: f2j_ug.dvi dvips f2j_ug.dvi -o f2j_ug.ps f2j_ug.pdf: f2j_ug.ps ps2pdf f2j_ug.ps almost_clean: rm -f f2j_ug.dvi f2j_ug.ps *.aux *.log *.out clean: rm -f f2j_ug.dvi f2j_ug.ps f2j_ug.pdf *.aux *.log *.out f2j-0.8.1/doc/f2j_ug.tex0000600000077700002310000004624711031241067014726 0ustar seymourgraduate\documentclass[11pt]{article} \setlength{\oddsidemargin}{.25in} \setlength{\topmargin}{-.25in} \setlength{\textheight}{8.75in} \setlength{\textwidth}{6in} \setlength{\parindent}{.25in} \usepackage{moreverb} \usepackage{longtable} \usepackage{textcomp} \usepackage{graphicx} \usepackage{amstext,amssymb} \usepackage{pslatex} \usepackage{url} \usepackage[ps2pdf,colorlinks]{hyperref} \begin{document} \pagenumbering{roman} \include{title} %\include{license} %\tableofcontents %\listoftables %\listoffigures \newpage \pagenumbering{arabic} \setcounter{page}{1} \section{Introduction} Before using the f2j source code, realize that f2j was originally geared to a very specific problem - that is, translating the LAPACK and BLAS numerical libraries. However, now that the translation of the single and double precision versions of BLAS and LAPACK is complete, the goal is to handle as much Fortran as possible, but there's still a lot left to cover. We have a lot of confidence in the JLAPACK translation, but for a variety of reasons, f2j will most likely not correctly translate your code at first. One of the reasons for putting the code up on SourceForge is to enable easy collaboration with other developers. If you're interested in helping the development of f2j, we'll consider giving commit access to the CVS tree. The purpose of this document is to describe how to build and use the f2j compiler and to give some background on how to extend it to handle your Fortran code. \section{Obtaining the Code} For downloads and CVS access, see the f2j project page at SourceForge: \begin{verbatim} http://sourceforge.net/projects/f2j \end{verbatim} There is a source tarball available in the download section and anonymous CVS access is also available. The GOTO translation code is based on the bytecode parser found in javab, a bytecode parallelizing tool under development at the University of Indiana. That code is covered under its original license, found in the translator source directory. \section{Limitations} There are many limitations to be aware of before using f2j: \begin{itemize} \item Parsing -- the parser has a bug that requires at least one variable declaration in every program unit. Also, the last line of the program cannot be blank. \item Typechecking -- f2j does not aim to do much typechecking. It assumes that you have already tested the code with a real Fortran compiler. \item Data types -- complex numbers are not supported. \item Input/Output -- f2j does not support any file I/O. Formatted I/O support is fairly weak, but works for many simple cases. At worst, the output will be missing or you'll get ``NULL'' printed out instead of numbers. \item Other Features -- Certain forms of Fortran EQUIVALENCE are not supported. f2j can handle a limited form of EQUIVALENCE as long as the variables being equivalenced do not differ in type and are not offset from each other. Multiple entry points are not supported. \end{itemize} With that said, if you have pretty straightforward numerical code (similar to BLAS or LAPACK) f2j may be able to handle it. \section{Building and Using f2java} We have been doing development and testing of f2j on Sun SPARCstations running various versions of Solaris as well as x86 machines running various versions of Linux and Solaris/x86. It may compile on other platforms, though. Using gcc 3.4.4 with the \verb|-Wall| flag, we get no warnings, but using some picky compilers, you may see warnings about unused variables, etc. You can safely ignore them. First, download and uncompress the source code. Building the code follows the typical configure/make process: \begin{verbatim} # ./configure # make \end{verbatim} Optionally, you can ``make install'' which will copy the executables to the location specified in the \verb|--prefix| argument to configure. Now you may want to add the relevant install directory to your PATH. This will vary depending on whether you did ``make install''. If so, the PATH should include \verb|$prefix/bin|. If not, your PATH should include \verb|$f2j_dir/src| and \verb|$f2j_dir/goto_trans|, where \verb|$f2j_dir| is the top-level f2j source directory. You may also want to modify your CLASSPATH to include the f2j util package. If you did ``make install'', this will be \verb|$prefix/lib/f2jutil.jar|. Otherwise, it will be \verb|$f2j_dir/util/f2jutil.jar|. Let's go through a simple example. Say you have the following Fortran code in a file called ``test.f'' \begin{verbatim} program blah external foo write(*,*) 'hi' call foo(12) stop end subroutine foo(y) integer y write(*,*) 'foo ', y return end \end{verbatim} If you translate it with ``\verb|f2java test.f|'', it will produce one class file and one Java source file for each program unit. So, in this case since we have two program units in the Fortran source file, we end up with four generated files: Blah.java, Blah.class, Foo.java, and Foo.class (note the first letter of the name becomes capitalized). You can run the generated class file directly: \begin{verbatim} # java Blah hi foo 12 \end{verbatim} You don't need to compile the Java source, but if you wanted to modify it, you could recompile: \begin{verbatim} # javac Blah.java Foo.java \end{verbatim} However at this point the GOTO statements haven't been converted, so if you run it you'll see some warnings like this: \begin{verbatim} # java Blah hi foo 12 Warning: Untransformed goto remaining in program! (Foo, 999999) Warning: Untransformed label remaining in program! (Foo, 999999) \end{verbatim} So you need to run the GOTO transformer (javab) on the class files: \begin{verbatim} # javab *.class \end{verbatim} and then it'll run fine: \begin{verbatim} # java Blah hi foo 12 \end{verbatim} \section{Command-line Options} There are several command-line options that you should be aware of: \begin{itemize} \item -I specifies a path to be searched for included files (may be used multiple times). \item -c specifies the search path for f2j ``descriptor'' files (ending in .f2j). It is a colon-separated list of paths, like a Java CLASSPATH). For example: \begin{verbatim} f2java -c .:../objects filename.f \end{verbatim} \item -p specifies the name of the package. For example: \begin{verbatim} f2java -p org.netlib.blas filename.f \end{verbatim} \item -o specifies the destination directory to which the code should be written. \item -w forces all scalars to be generated as wrapped objects. The default behavior is to only wrap those scalars that must be passed by reference. Note that using this option will generate less efficient Java code. \item -i causes f2j to generate a high-level interface to each subroutine and function. The high-level interface uses a Java-style calling convention (2D row-major arrays, etc). The low-level routine is still generated because the high-level interface simply performs some conversions and then calls the low-level routine. \item -h displays help information. \item -s causes f2j to simplify the interfaces by removing the offset parameter and using a zero offset. It isn't necessary to specify -i in addition to -s. \item -d causes f2j to generate comments in a format suitable for javadoc. It is a bit of a LAPACK-specific hack -- the longest comment in the program unit is placed in the javadoc comment. It works fine for BLAS/LAPACK code (or any other code where the longest comment is the one that describes the function), but will most likely not work for other code. \item -fm causes f2j to generate code that calls java.lang.StrictMath instead of java.lang.Math. By default, java.lang.Math is used. \item -fs causes f2j to declare the generated code as strictfp (strict floating point). By default, the generated code is not strict. \item -fb enables both the -fm and -fs options. \item -vs causes f2j to generate all variables as static class variables. By default f2j generates variables as locals. \item -va causes f2j to generate arrays as static class variables, but other variables are generated as locals. \end{itemize} After issuing the command ``f2java file.f'' there should be one or more Java files in your current directory, one Java file and one class file per Fortran program unit (function, subroutine, program) in the source file. Initially, we would suggest concatenating all Fortran program units into one file because it makes it easier to perform correct code generation (more about this later). As the example above illustrated, you can run the class file corresponding to the main Fortran program unit or you can use the Java compiler of your choice to compile the resulting Java source code. Make sure that the org.netlib.util package is in your CLASSPATH. This package comes in both the f2j and JLAPACK distributions, so if your CLASSPATH already points to JLAPACK's f2jutil.jar, then you're ok. \section{Organizing Your Fortran Code} Any non-trivial Fortran program will consist of multiple source files, often in many different directories. This can present difficulties for f2j because resolving external functions and subroutines is critical for generating the call correctly. First, we will give some practical advice on organizing your code to be built using f2j. The following section will give a more detailed explanation of why this is all so important. \subsection{Practical Aspects} The easiest method is to just concatenate all your Fortran code into one file and run f2j on it. This might not be practical in all cases, though. If you have to keep code in separate files, you need to understand the dependence relationship between them. For example, if you have files \verb|a.f| and \verb|b.f|, and routines in \verb|a.f| call routines in \verb|b.f|, then you must translate \verb|b.f| first. If there is a cross dependency, then f2j will most likely not generate some calls correctly. Thinking of it as a call tree, you want to start translating at the leaves and work your way back up. This sometimes requires modifying the code. When code exists in separate subdirectories, the procedure is largely the same, except that f2j needs to know the subdirectory names containing files that the current program unit depends on. Modifying the previous example, let's say that \verb|b.f| is in a subdirectory named \verb|../code/foo|. We would first go to \verb|../code/foo| and translate \verb|b.f|, which would result in the creation of a number of descriptor files ending in \verb|.f2j|. Then in the subdirectory containing \verb|a.f|, specify the other subdirectory on the command line: \begin{verbatim} # f2java -c .:../code/foo a.f \end{verbatim} f2j will locate the descriptor files in \verb|../code/foo| and use them to generate the correct calls to the routines contained in \verb|b.f|. You can specify multiple paths separated by a colon. \subsection{Resolving External Routines} This section illustrates in more detail the importance of resolving calls to functions or subroutines which do not appear in the original source file. By ``resolving'', we mean determining the correct calling sequence for the function call, which depends on its method signature. For example, consider the following Fortran program segment: \begin{verbatim} INTEGER X(10) CALL FUNC1( X(5) ) CALL FUNC2( X(5) ) [...] SUBROUTINE FUNC1(A) INTEGER A [...] SUBROUTINE FUNC2(A) INTEGER A(*) \end{verbatim} \begin{table*}[t] \begin{center} \begin{sffamily} \begin{tabular}{ll} \hline \textbf{Calling FUNC1} & \textbf{Calling FUNC2}\\ \hline \verb|getstatic #15 | & \verb|getstatic #15 | \\ \verb|iconst_5| & \verb|iconst_5| \\ \verb|iconst_1| & \verb|iconst_1| \\ \verb|isub| & \verb|isub| \\ \verb|iaload| & \verb|invokestatic #28| \\ \verb|invokestatic #22| & \verb| | \\ \verb| | & \verb|| \\ \hline \end{tabular} \end{sffamily} \end{center} \caption{Differences in Argument Passing.} \label{tab:argpass} \end{table*} The first subroutine, {\tt FUNC1}, expects a scalar argument, while {\tt FUNC2} expects an array argument. These two calls would be generated identically in a standard Fortran compiler, regardless of how {\tt FUNC1} and {\tt FUNC2} were defined --- the address of the fifth element of X would be passed to the subroutine in both cases. However, things are not as simple in Java due to the lack of pointers. To simulate passing array subsections, as necessary for the second call, we actually pass two arguments --- the array reference and an additional integer offset parameter, as shown in the right column of Table \ref{tab:argpass}. However, the first subroutine expects a scalar, so we should pass only the value of the fifth element, without any offset parameter, as shown in the left column of Table \ref{tab:argpass} (in this case, assume that {\tt FUNC1} does not modify the argument, otherwise things get even more complex). Notice that the primary difference between the two calling sequences is that when calling {\tt FUNC1}, the array is first dereferenced using the {\tt iaload} instruction. Also note that the purpose of the arithmetic expression is to decrement the index by 1 to compensate for the fact that Java has 0-based indexing whereas Fortran has 1-based indexing. The only way to determine the correct calling sequence for any given call is to examine the parameters of the corresponding subroutine or function declaration. This is only possible if the declaration had been parsed at the same time as the current program unit, meaning that for code generation to work properly all the source files had to be joined into a big monolithic input file. This was a serious limitation, especially for large libraries, because a modification to any part of the code requires re-compiling {\em all} the source. There are at least a couple of ways to solve this problem. One way would be to obtain the parameter information directly from class files that have already been generated. While this would work well, f2j is written in C and does not have access to nice Java features like reflection, so it would require a lot of extra code to parse the class files. Instead, we use a more lightweight procedure in f2j. At compile-time, f2j creates a {\it descriptor file} which is a text file containing a list of every method generated. Each line of the descriptor file contains the following information: \begin{itemize} \item Class name -- the fully qualified class name which contains the given method. \item Method name -- the name of the method itself. \item Method descriptor -- this method's descriptor, which is a string representing the types of all the arguments as well as the return type. \end{itemize} Continuing with the previous example, the descriptor files for {\tt FUNC1} and {\tt FUNC2} would be: \begin{verbatim} # cat Func1.f2j Func1:func1:(I)V # cat Func2.f2j Func2:func2:([II)V \end{verbatim} To resolve a subroutine or function call, we search all the descriptor files for the matching method name and examine the method descriptor. Based on the method descriptor, we can then correctly generate the calling sequence. The code generator locates the descriptor files based on colon-separated paths specified on the command line or in the environment variable {\tt F2J\_SEARCH\_PATH}. \section{Extending f2j} So, at this point you may be wondering how to extend f2j to handle your code. Typically, the first problem you'll run into is that f2j doesn't parse your code. That could involve something as simple as changing a production in the parser or it could involve a bit more work - e.g. creating a new kind of AST node along with all the appropriate code generation routines. The first thing you'll want to check is whether the parser supports the syntax your code uses (the parsing code is machine generated from a Yacc grammar in f2jparse.y). For example, if your code contains an ENTRY statement, your code will not compile because f2j doesn't support alternate entry points. Suppose you wanted to implement ENTRY in f2j. Your first step would be to define a lexer token to represent the ENTRY keyword (in fact, this exists already, even though ENTRY is not implemented). The lexer sometimes needs to be modified to handle the token correctly, but usually it is sufficient to put the token in the appropriate lexer table. In this case, we would just put the ENTRY keyword in the \verb|tab_stmt| array defined in \verb|globals.c|. That array holds keywords that are at the beginning of statements. You'll notice that this has also been added already. If you're getting parse errors on a line of code that should compile based on your examination of the parser, then the lexer might not be sending the correct tokens to the parser. The lexical analysis code is in f2jlex.c, which is handwritten C code based on Sale's algorithm. There's not really an easy way of describing the structure of the lexer code, but if you enable debugging output (set lexdebug = TRUE) it will show which tokens are being passed from the lexer to the parser. That should help you figure out where the problem is. While you're working on the parsing, you can leave the code section in the Yacc grammar blank. You'll recognize when it finally parses correctly because you'll get a segmentation fault (meaning it passed the parsing phase and failed in a subsequent phase since you didn't pass an AST node back up from that production). At this point, you need to determine what information is needed by the back-end to generate the code. For example, a loop might need a statement label number, an initial value, a final value, and an increment value. The AST node types are defined in \verb|f2j.h|. If the node you're defining is close enough to an existing node, you can reuse it. Otherwise you'll have to create a new one. Then just initialize this node in the code section for your new production. If f2j can parse your code, but the resulting Java code does not compile or does not work, then this may indicate a problem in the f2j back-end. First, try concatenating all your Fortran files into one big file (ok, we admit this is cheesy, but it does work sometimes). This should help with the type analysis phase and may eliminate problems in the resulting Java code. After that, if the generated code is still incorrect, begin looking into the f2j code. After f2j parses your code, it passes through a couple of stages before actually generating code. First, the AST goes through ``type analysis'' (typecheck.c), which simply means that the tree is fully traversed and each node is assigned type information as appropriate. This is not semantic analysis, just annotation. Next, the AST goes through ``scalar optimization'' (optimize.c), which is an optimization stage designed to determine which scalar variables need to be wrapped in objects and which can remain primitives. After that, f2j generates the Java code (codegen.c) based on the modified AST. So, if you notice a type mismatch problem in the generated code, typecheck.c would be a good place to begin debugging. Similarly, if you notice that object wrappers are inappropriately used, check into optimize.c (hint: by passing the -w flag to f2java, the scalar optimization code will be skipped). Most other problems will be with the code generator itself. \end{document} f2j-0.8.1/doc/title.tex0000600000077700002310000000046011031241067014656 0ustar seymourgraduate\thispagestyle{empty} \begin{center} \huge \bf User's Guide to f2j \\ Version 0.8.1 \vspace*{1in} \mbox{} \\ \LARGE \rm Keith Seymour and Jack Dongarra \vspace*{.5in} Innovative Computing Laboratory\\ Department of Computer Science\\ University of Tennessee\\ \vspace*{.5in} June 30, 2008 \end{center} f2j-0.8.1/doc/f2j_ug.pdf0000600000077700002310000010745311031241067014674 0ustar seymourgraduate%PDF-1.2 %Çì¢ 6 0 obj <> stream xœ­TMo1 ½Ï¯ÈŒÄ¦±“8ñ•!Z.”-ĶÛRª¶ôSê¿Ç™ÉL²ìô†æ°Î[Ç~~¶s«¬eóW~7WÝpT Žfë²»í lqSoÖÝÁ1€BkˆÔú¬ƒâˆ&yE‰LJj}Õ}Ó'=˜¾ïW’̦h½Þöh!%}7X6êW½“[˜ ;"ñô‡|cÔý LpP_d4R ú´Â[¹çÁ`ý Y™¢Ó7‚/¶Óg†½5Á{bÖ¿ ö}}ءҔ1ɱð?þ_{°âÎns¶JMœR˜Xy%ëœá:ˆÆ:¯í€†$%11"{–@˜ÁLìà8)ˆ"CðYìU`ãÕŠ0·8²<ê…4 ATdJÀÄ¢ÇlþÊ*9ý%kGŽ]’k }r)êç ¦è#ë«‹8p–qGSêVè’ !ê5íuõ=-¹,éÃŒ:Ñ·¾›j^V^ï2Ê´‰¯kâó>Ër­u7LBB ­Y,R `Fµ’–H]¥ÇGwçhJB[ÆMhlô Ÿz †9†6q#îEÒk’É}îÈŒqâ+"¼.±› ËÕ™½OúÏ¢Î; f³!x>6"yý)ÇòÖEj*×?k¬FТ’·ñ…jö}³¢u@FEyTôÓ<–Z‚v ›ê–ûÖ䮳·]­‡\²8ÛšgãLÿAëíÇiÒ›¥Ù,îÚ2ßMíFqpÖge4bÞã,`É“ºMq¼¼ôyw¼ö•¼×-½ð <çŠ$nŠÿêЈzÝ“¼9ŒôBAÍ:nkmMÞûºñM„íÎ>:o(r÷q~Íš·¢éL“{X)–•Dí*j«ïë\G>Èc¿ô¿­hšÑLèýºû,ß_²{endstream endobj 7 0 obj 679 endobj 15 0 obj <> stream xœ­[Ýv$µ>'—~ ß1Ãô¶Zju7w@H²°ÉB0p¹ðúg׬×6/`^# Ï›*©Jª’4^“pöfÔ’Zªúê¿æ‡Ã¡7‡þ£ÿŸ¼9_ÍágéÓëƒ }hÚáGGOþaÌ¡q½u~<<:?04Yûu]ý¡_a[xòæàÛé¶ë:÷ã0ožv[×ëœß\u¶_íêÍæ®Ûš~ZF?mn;3÷n0Óæ—ÙÂàišù6|Zf¿9é†ÞÏ‹™f¹ü¢3ýê×E®NïùçѧpìîѯÃjðÔ£ë7À1ŸýñÛÍGpºÍYç6ç°fŒ}ðL·ã{/Î0mv0熯àóK|[†“ØÍ+ÂÙ3 î´aè{œ5†Y¸÷}K{Ÿt.íOèñiØÈmÞÇGK¿Î#ÎŽÇÂñcø»ä þð m¶â»ð@qO… îø>ß‘7ÃûÇyóS7‡©»| ¢Bñª—Ý”¿\uHÞÑý`'@ÂÑ)0^1}¸ï¶v€38¶à»¨Ë*¢2/¶£_ÃŽélëºù±3¾F` ¬Ã‰­Û¶_»ÏkvéñM|+};IŸ.Ò²?tÛ Ïǰ"oŠäx—i$ïöi/\6[~Š„Ù2e¶ÆöήK$†XcÈ‚ÐÚëq3ïÂL μ"^Òw|&ÐhÕxa‰Æ‡gx­äŸw‹…O6!Ú|ŒcŸ!­f˜·¤· V„e´ž.û%²¶°S˜€Æûg¢4Ps’ »µf w«QüBÏY€ÖÏž‡Téá|“ òòW<ôu7z8ÑèÙA¼Ç)~UÈ7¸vö™èc¸,‡ñ4ÒOˆd-Ê_’¸GIŒÂ›a‘5‹­®óµ5x¯Èè4ETÀšX…±©ˆîl ¯HÑþÜùdKµ*K¶@otC7܅шLY¶@*kãêILñíIGmÏJ;ó^7-‰ü™Õúð¾»JáC–6?¦ó.>?¾ÖïWN6·uÀë¤l#‚ò&¢±Œ¼R@øðBç}ÓͰ/8<ɧXÙÆŒ>RHîÇÀuK¾ŠPwqIÐVX2a9Y(ƒÝO̺›¿qÀ¯§É”ò§÷:ãºâ޶a w`WÛëÛ¬¢c€¤l@S6)›¢²Ì‘8m5\Â7¬ÜQ N1ÓpBÌâ]VšwsðuI_™?4#Øø¯ñ?èâ[ð-DÊ@¡çŒ°º_É¡úáý)ÝÃêÑ.Ò³ì/*·(1ñŒp–ðž8™€Á± +ÖR…¥Ô§ˆvDÀÚ¿xAƒNúªÐú–ªÝžÚs8Õ®;ET<³d1xBTÑi&§D€\ŠÁ— e­#±®µ«BupbgS<µï™iPJ@•jŠê´=ÞPã'ñÏ€õ1TfÔ¿ŽRÀÅŠRŸŠdlÍ@=tûIZÎ:d;*±ŸKµÊ/¡™ÙÖ“ƒâôŽâõ™Ù*K S»KI¹‰°p+T¢ç**ûFc?)›­…¹LHoyÁtÂ2ncÎE?ï†~X½™ 9±LÙd""Î!Ǽò²ŠlrÎ5_¥µhM¼éʹʤô«´ä,^nõ1 Í»yõíD÷YHoÏvð¬5¦ª399k`Îi‰È'6ÛÇÁ^ÆÄÉlT„®U©óAµtÌMúµÙÑ¡”+Ѧñ*8!¬ÝH`\‡g¬'ä9’nè2/Ûþu ÆXº’1Y¸o„çVºÍDÙ*91ôËD…JÀøCç‚>Ö=^–˜acD~rÁ4ñØMû =)>áÓ]»NŸÞ¦§·iì$¥±ób­^ñ²±d ˆ´Ú ¡Žƒ³§§Q6ã&:ßìésP±üðšÇ¾c˜ N›œ4vÛñXÚö¤"«yìǪrŠŽ.7˽޳MÝòýy eîQ¯Ú_}”R¶¸ìcRUßc"Ä)¸ °y‘çËÑybèûÙjTÉ¡){ëªÅ¤”ëèW²ÉÁ›FA×T­¦\„\{›»šJwßú%4ü2iƒÄ™¢£*íñ¸3 ²cøý+ þ=Ãæ«œâ ÍkϺd†qóï¢å2[›"n­eODš#Êg §ÄÏ–ì¸^%¼¹Çi\÷MÅóˆ&Ý~‚o m¢ÛüƒœÃx¶.þmGlþ˜²Q+måM±Ë‹ÛA¡¸$'O浤Èo0¾ñxŸà…¾èBg98x!á•´è×»öajWÆÉød±+ñn08R®¾2k–L@ìi*^öí‰jXÎk?¤3[y¨è:ÚOêÒ¼]ŠÒ¼,¯—uãôà]ÆpǹN¹§úL3Õ û"—“EÞbÍRöjü>ìA³Iö-÷k¨¢‹n5Ò›mÓ;;GQ°+SøgÌÇ,ôû‰ÕõnNz1Gü¹ç¡N·,Ê6_‘ÈäߣpÄBʦÑ3r¼ùy:Äyã…E'&ÝCC†Œ"žQU8.*á2ïE³*ß‘±Äåâs©ÏtÆã¼RìS„Ç:ã6‘Õn4°‹¶oõÿ†i@ ‡[/+u!m­J«ž³øåYŨXkpbî>[Y¹ËTPé¡ÛòÖÕ$ÿ_=¥}+ ±Œø¿éœ‰Íá2lˆLŠÑevÄ\q»qL]‡A SØ@†«´ç­÷#u{©ìˆêW•ãÒiÚfGý2ï•dFÛäU UQuø¿çŠõÓϹы‘²TÀüC™ï6ÍòŽòäj™½%M×™ôe‡ë~\Anjł j#Ÿë‘ùA쥩¨jõgyÒw]Õ>s[XÒIQòàﳓReÁúUѹ¿=K&GëšòÜF8çǵ¶wË`âqMLŠ|rtðüû/¥ÁÎendstream endobj 16 0 obj 4077 endobj 19 0 obj <> stream xœ½ko·h¿éWhß¾õrùXÒßì Fó@Ó& ‚ -Y'ÉgË:EwJ¬þ çw†œ’»{'ùC‹@ñjøÎ{†£_»Vwøý{öþ(þz¬Ž¿–¯wG¿)ú¥£iÇ/OŽž}§Ô±2­6®?>¹8R4߇6„àŽ]€maäýÑÏ Ó,CÚ¾/›eß*gœ[Ü5º :8µX7ª λ¸Š_Á/V£A]GÜâ6q¡µÊ/N›¥jý ¥q\²‚qã`Õ⇦oàkÛ,M«´Õ´ãÐUKâ–ªU6,.pKë{ïóîo3ô´éuÛë.,~k`¸xüûä+ Žjµ¡ iÓ›Ö›ˆñÍÑÉç?/~lDêÃâNU5‹7MÜØµ@`c…_ÞÅ) A/^ÔóÆÄŸkk[¸¬]làgÝh€Úx“ö´C:ŸÝÓ¥u\v?ï‘)!xÂ]vHB`å «Zåw@·®S*NßÂÖüÁ¨˜¡ &u·œû>iZßDÒö=L³.N»Îç|ß,-ÈI‚° ìGŒUX¼¾.¾Ãÿ}Ñ é{À!Å“ˆ^…Üé,¦éL‹¿xrYbìâ¶aª$ÒÏZ £+þÖÀ%"¥áÜ͸b‹¼ Ïà ñ$K}ÍšÉÒ­ÀêM®ã&4†w_òå—J·FŸh@´×¡ÏDŠ’äþEéAé`Î"x‹KT\ò;Ò—¥æŠ¶,FÓ>À¦~n„ R²pîY“½’’$Crô-ÕD¯ÅÊô¨¸®¦y^Zñ–h÷k¬@9KD\”Lò›„K·n°,\BT·ø‰Za‰Ç~ B$ŠI—ˆB7 JŸ, Ï– om³À’Y[|)@µ Ø` b©µ)ºo, Pº uh²ðžÈ¶M²:ŒuSHlcÍõ]…M´!:r;fj¼ðM!y8ã‚ Ja!.ȧpšQ«²Ú¾!swÁÆßáÊFGjþ€‚Zñ’•ñò..9‹’ $µ:í@óMúÑ0ˆwâ`TÙ·@hÙ]ày“¼@(½@×zKNR;ÐO ³Ó¾í}r’K`ÆÐwû‘?N㇠Ћ@ü1ãdØëNYÕ{ÿ… Ž×ŠW÷èñF$çñèºãœl†Ð ­µ>’rCô°°x˜•Ô9YØ©ÌT µ÷.Š -Š’¨»t(‰–MYÒeS:;m“ùÝ–B ×Ñh–m,¯Èõw¢ü÷yáéDÝÑðÜ‹Ê>#[‡'h…nKN›±âåígŒ\´?â<'¿.DÚÂéÅN2mÎÉTùvPbªVχl&• R–†š¥(TÂÂKÎÊdƒ‹nî§Fu@‘¡Ò™ÂäÉ¥•äÑíÌèÅ nßlÍ jk†ì½$š±áañï}eµ¢HˆmÀ=•Iä+2üqŠ6¢Š9©Â3¦x´!×d7MbÁ*Y2ÎB®.ÌÚBDùŽ7 ó: Û’U‹¿²Gr=V“»rýYNžÃÇ­ˆ H£#ã^âîJa½âÕŒŸf³[`…ÓùVA’@‰GÛ$çõÑ‚ÑEødN_ð’Æ"®ic§ Ѭ2÷¯g¤ø´3XŠþµå€áO( ([ËÊ–Á‰×­åðNdÏ€+×IØNÉJ% ³9žpFfdK?Ï}ØÍp.ÒÚR*ö—fé:À¢C®¢/q<Gs&°À®v!_k½Ø|ÝÊè9âîðíST ò^–fŸ÷N`ç ;àõTçmßµŽ<Þ·(§7„¬‰€×¤pWdàï °ø£¡4ê¬HóSÊ·(´ù˜ Cië…c¨|A×j0IA®&ªóÅQd ª9ÅÌÑBÔH±M’Hðݬ>7¥£cÄ'& óFÅ|ÔCYǸÙé+fÛâLvSWQ"pÞ)jÞåˆZ(ºW¯*ŸS½Ýžl }F÷)  É7U“·ËK£¶æ)+6W¦Ž_H…‡H:³*|ÅaMTÐuǶÚÞ” øR„þæÍê߇RÃö)‡Åz…¯NO¾òìh3/É#Pð”k¾gûyhꩲy•Ga·!Žsi,â0ŒŒàßQ¤7M¬pô%sØà«‹"N1÷eP>ˆãÜIŽÁè¦uÉÇFÇÊb2Q…¤}ú…PçJ:Ñ™ËÚ<^éeEå1«³ÏÊå›’°Vª”üVÚ•®š‰†KR¨ÚÁjVÝT8ñ¶_¼ `L-NƒË^³¥è0ŒCo*Ÿ¸åœ¯ò´ë—|Eüüµ‘{ÁU)m­Â׌|kñ~uTVÊŒ´°âbhÏ)fgª \S$މ­ø_¹ƒ¨<¦O'|Éð ÎÅœ„qœÌAh¶Ï¼byo±Lš*3ë"¨ã«¯Eœœ–ȃS™—ÃÆÃÑ€‹‚=6>׉?ã4÷†?’ìµ!+882‚}T8þúÀƒÏôšAyÖ50•ưó¦B‹Ë Á䊊ðÂK"‘Ý“¤Øa¤‘U†;q)Ù 2·ü ·Tèâï3ÜŠŒJa–}âËãY¢¼Aß4p€PÉ’ì|Ðåô{+°_˜Ü«šîÂCœôŒAÛzlpx,lô5ÜWèåœÉ¾Hnð3w‘‚^P}Ë O»Ø%løc7ü"Ëv2œòX*ßö`÷¬ëPÍgpp»¡º]a*[Wú™TT©ÖŒvýL´iD4ˆÖGWkk©Ó‡ÔÐúVCæR]» t¡UöÆVo2À¯ËE®½³%ø«Z_]©ö4X¾äG Ÿ 죛³kŠÙ‡pîG¾^j˜•$Lr]ó'±ìÈûL‹NœrW®%¡T8¿iÔdBPLà¼|ýQJ8 «ílýŠ`,’¿ÈAC¬}Ó{׬”ç2ã®´‰‡Ì!Z×ϦL, !ñb®*fY`ª˜ëëJeöPð™röædLÞÍÒ…kÀ…ZŠ¡Ý #¾ŒÅrpݤ9¤ÔªˆNô‘«Xe\¢‘d.WQ’<Í!Ik¬³”¥­áÜý©jÄß~Í|ÀlƒÇ,¸cZcG 9W*Mº˜QŒP•ÕeÒëzÒ¾ánbä×ÙlËæ-¼Íƒ§bÙô2†ÊCò¨+"à+OŸ"Œo³BÅyjÿŽ9Y€eaöI)/Afw!ênž¸cñûŸ).XÈK½/Ùm&Và×þa«™4ùvTìÊ«ìˆëW3+Ç@w™¿óÊp!âøeðÑëµ êl[¢âŒÚY}Cèož4ø 0t!êmŒ‡hwÀ¨êÞTÅp.AæW7yN8ÅÙ©‡_fFeê"‘NçD'›kN)›Þ¿(ZA`{ÌT¾ç§¬{²®ÛÅ'h§ˆO03r&ÁE™wO-ᨘ?ªxG7F«Ï¯Ä¯G¾=«eXýòA·¨+Ì«OW9¥'Ó{Ç<Óâlöf™œKŠeTøŽŒ*•ûÁѹۙ›çínö³ìZ¦¯ÆÎ{fÃÿz†ê›Ñ¼‹õè¨$BßGÓáž-?]>Ù{©.§'’ñaûDñrK¸/I1z…ù¿ËÝÅ ]6Yž0]ž¦ç!«š™Bˆóí 2Y2wg4ôÑsà©G.‘×¥ ¼×¾.¿J©|G™§[[ªÊœŠÍ”·Ot;Ù‹½ ùà´!$óŒ™!mÂP¡9Šb%òȦpÀfªŒ$Ññ9²•Èz;"yá^ŒÚºx°ïò”ØQr‹ÎE:Á´0ãÞ›êå g ¾~goy'¯¦Bd~¶@ñòšqU¦?ü”NãSGûö[9m[”à&‡¨ÅW…ÏÍ5‡\O‡¡Æ'eÃÂqË̽²#PaNª†Ñ»Uî¹â“szçäׯTó-_Ÿ/é›cµb*Î- ,©EÝZZÛ¤Z5Ì¿K–É$½Êðì–8™ “.¯Q™…zã+ú¡æÚÐ×Ñ ÖFвÂD®.óÓ äØ^K«)&>&ª$ ‹óäfUG4ß[’€8×S¯Ý'D“´ñ£‹‹#û+ò€FûTÅ :ÔA!Ó_c ï¬¼*®r°z+s’lŒ-‡÷Eòq‹«IUxÓª°Yµùž§ê%¢+ÚfžÃÁ.5;Çþ–ÊPƒ!AÞæ!'eFo[±Àš˜=´×»“öp)¥zE’¦Ú.gr3{Ñê¼ÚVÑgÄ”¯E‹¶žÊÆ\‹ê¶øJ©‰‹!BYŒ«GŠf"ë<ù4×]7 2]ê,—{÷v$Jüª‡=pYnEÇöv£ùíO|÷‰p+a2ͽ4àWƒÔò€f† ÕͬÚW…5þ5õ »‚€‰ mf×´ôk½´Jqk £Þi™:y¤‹Ö*ÄÊŠM;¨Sl"÷úOjÞšñŸHPÇË©ùšëÛØÍ$¨o=/%âáÒ’BR¹I3ÔÛ™Dç·&ñéËOK&kVkþâ8¿ø‹\ÙÚ_KC95É™n… ¨ÏÕ §Tü}‡*O¤d—uƒM+3¬Ó˜œé_íMÚó†u±vš1=¬—VõæØ¨ §J$éS]í¯'Gÿ„ÿþ T¶êVendstream endobj 20 0 obj 3798 endobj 23 0 obj <> stream xœÝZÛrÇ ­Ê#¿‚©ÀŠúøäíÑ7Íç‹¥mnÚ·!hۼßë…véç åÛNÚl³[,õ Ûàúf?ïàg¯Ú x4ÍåÂ5WðÿšŽjn¡å†Z¯áœ öÀø¶ë”Г֏¬ŠËþ_ÿõ„6 vhNðõQ¯ñ]Ö¶eîJþ@ùÞ >¸é•ÔR™ÞÝëøÎjÜiåF*âœ_¢úÖ6mƒÕÍiÔÒ ÐnÎ6jx½°Þ‹ËåþvòåHݺ`Áö'ç`îËS ~K¼€wé¸((‰]ÖÃÒ`™.ZæjÁªmx†æ |_Æíò¸û(KZæó¶1•VðVÝ»f›GnY}+dZOŸPOxO]*ÓZÛé¤ïž [câF;ØZïg C;‚Cäbá"€ú.âj ÍØõ°jZ£W#ÐÙæÕ $/_ ü®a€y!øcïTk‡„ÿ_,–pá:Û¼}úÎ뀒Á“ =lgi[zÂ*Ý|š·yà*·]r Æp.À»¾::ùäêsµ¢'…]›Üu#ž–J+Õ‚²*¯¯åú8ó¯yü*?íòðë,âÕ¨ Ÿ.rï+ÐO‡Ö8Óüefò]nÛÍè\ÜçÞMn»™™û6·­ãSïá,½s-œ» nºá‡»<ñ†ö¡ãÕz_–x;’ š®øáú‘}‹ZÝ"üEoD†ŽŒÚvµ`iê¸oUK?/¶ý¶áÆßN×Êê¾`%U¸-DbÀŸØ~`’zµ±r\Ý„Oß.¨7U^ªó|Tÿÿ`´ìÈiž˜‡oI`c?2žpQ?ž®ƒû<1Œ¼ 5ŒfÀsžž`®×­òÉÓþy±t1¢Ù>†a¼ÜñÈÇÀAö¼4££¿)?1fpp#˜JXh²æi*aßÈAx'9ÅuŒAG(e1"̉ÒVИ7e¹B3tŸžðÈ&À†ÄŸzâRšaăv¤[)ê>þÍý?Coï`Xoxƒ×4øÍ>,P: 6óï(¹í”QgšOrw›»Ïž £û©/xl@Ÿ ë¼çs±ÒÖȰ‹P¤=½‚öÝcp‹vf°L;lð­ÿihÇÂ5^¾V`h ^Íkiû¬Ÿ±­£´Â-–¡îúæ3à“Þö!ÒYØ¡ÞøÄ[‹ï-O«Ò} 0 &xˆOø¡%v»A{„8ЌʄuÚ&kpÒ»¶ N‡`Áåò€»²Nœš:)ZZª1g°­2Æ«äiÛ‘æ&fw‚`x!dÙ]‰&òNûèåæsºŠ'=çWg’FG‹Io…?³ˆ%{‡ì&®øáZ¤Z}ˆËÝÊ éJº»ëš‡W‰s¿x>låÇ}ˆÃQ»K‘\da΢ÓÚ]¯ðøìxGy ¢Ïy™S¦ìñð ÙOKç#\\`‰É\ú´Î¿aKá†h©æ‹rÊQä[Ú>´6º…xÌ×ÂÅÆ½L"÷CN9(h›ãh…a;­]øžÂ[¥ÐÙ‹ã­4 @ÙâÕ–V1á>º¼²%…Dƹg5´["´¡xäð@ëÑfÝGt¤mZåª0# &””ŸJ^z[XøB˜LgY[IHK’ ±•G¶Ik† x©µHSkXœÁâˆÆ`Çy' ˆœ*vš6’|m#ÐÃG ¦š8u¼ñ\„ÈíÚßàxñOª!p”?“àÊh©N{ÅiþK!\Ý„¢ Äæ°¶ÔC:â³ß²!Âw}üßI/á n#àFU|çc錘êfJ_$Y ö27žq¾æ‰³bã+Ί m¹éå¤jqÊo¦yçY]Úè#tSâ: 2·ÜNWÈ è4A\O¥ã%Ÿ!Ñ:¸Ö‰«½âmá¿ÏKQaãºìzÅô“Dz> øÆïèù‚¤@gb“—úi»•IýGÞmÞ¸äÑ{Qji'@XO0U`s5e;iLp‚TT½ý_‚Òê¶³s ¼ù¯A)ãæ]r¨…\UzD¹²žbà¸ÀRÌ܇ÂÍÄ€Ìã-Ì¥\—Èó±§ 7™fú^øx Õ®UåJâ@‚þ®Ä…Ý !»›y*±m9&b$E$b†Ãb½»ïJ©f7Ûe&%i¹ñ”/¥¼Ý t‹rÓ01iÎô¬µ‰tˆÝ çúUht…“ ·üš7³šxK©—,s‘< è1 íÉÓW¦œ3íéV´…‡' ÀpŒïMªo¤šÁ„Žãèùž‹öM\•úa!ï‘ØÇ¦»¤ŠÅwÛA@AX˜9WyýCü'xÖmæTÀcFl>Ý7Ä”Öù&ò)0¤<—“[ºçŒ¡êžÖãö¡$DtÀ84íé/ïlò8XœøÊGläݘ_3Ò‘ÿv,mó‡taë$üRR?Œ ‡•*>kÁ|"¢s#¾NWË\ôÑ=­Ń©'¨½£ØÐ+q±(®u¯qŸ5á1ʯç8wJQ¬ªÈiZ˜ŸÈ%Ô J›o€åCMÊ¥2 }­®ýq:¼ñÝ¡Õ|¦4Ô¨æ¼ßrš¯™ùÔ2¼0ÑñÓŜ⋭á"„±þ}ÜØÒ ¹°”¾†.t9[fz¬˜…wÈC*rW‘õn÷µ“JèOjöªrׯ%Á 6'×Ô¼'cR‘¢k•2“;x.OM#<ÕÊŠ9$,ÏË{6£Ûv'2ÍÇÏFŒ…Þ¢7p²p˜lÞ;²9O*F§Bo‡Ë™´ò‰­à¼²|‘arÉq“ àÂöHšF¨+!÷€Ó¨Tßn<Ô¤;"œôSuÌ‹mŸþcôȄ‘K.• NȘ*iüùâ†Øk½Ñì5Ø wl={@}{öºe.ÑßÝs~†4ù„Éû*°•>Ò9(¢¸ï›ÌåwÒ1#ò­ zä „ITBr±€‘ÙôñCª–â¼ø"T9ùÍ+вÍéou³÷L¡g¦f5&/°,ðÍ•My±Â‹®é6¨*L=K*ñÈ{TÜ­:Êjðà‚B; Jv6i~srô'øócšäendstream endobj 24 0 obj 2939 endobj 27 0 obj <> stream xœ­\[å¶ Ú·ùóÖã"DZ,ùö˜ š4EÓt¢hú0·½Nf&sÙdó7zù½%ER"eùÌLéžµeY¢>’/Þï»Öwø?þó컣ø×cwü§ôëÝÑ÷GŽÿÒñ°ãO_}üÍ Ú¥[Üñ‹—Gއ»n>˜±?~ñÝÑ?wÿmöaÛeØí¿;oöý0·‹wgMØÀͰ»ƒ?/à¿;¼½ÄÛ/at·ÞÂ¥±‹—îáÒ5ü5LíüîÜŇ®øÏÛÆ·]ç\œõ^þrÌÞ?Å7^ÃàïàR»,ó<êŸ2UzR3Ì»7rí*¿þÂV¦×J·qö´ 57­ˆ62†¸]Üvšö^/ýî\V–_¼Þ‹ =Hè_/¾<ê'×v“‡3xqb?iú±íz7ìÞ7ýD¿pòsxŸGY´ÍÞ+Zv_4²Ô{™8Àòäâï5¸¼í).ôy0Ô_ð2Ï£ùªÙ»Oà½ðи,»¯›ÙÃßý‚rœwŸXpaÜý)ÚË;pŸð×ÎÞïoCèzÚ/Šô†€{Ñî~ƒ/;ƒyú! ðuC2Àûïà2L€°úüìúx¦ˆ°×q¸âÝK-ućÀîŽÎÔƒœ—þéà‚‰i5S²”„YDçãºn4®®yïð.ïámÑueÑE/õ!_»³“_ê¹ÎPsßú!ê"‚¶ béguîfùrÑ1D³&D\ö‹Å%zF'É•o²tq¡Þ‡Bº<†d,×Û4„Ã;Bä Ã2ÓÆ¾h|ÄîÜÇcù¡™D$C„>+`ÄY›=¨[4Q¢‹üô§àrYÔßðï‹„Ó]?.Ï-I\ÔÄ~ïArÓ’`uίå¥|»+ÁL‡æPÆ €x£‹O\kÓö:™Ì}¿ 6_ô®'/¬Ò¼‚, åÜ È¹LçQ¨‹ç.ýºçå îg; „h WÜÉœülD†¬8"c›"˽È^I „6è~d¡‘M8#AE tš®'*£\‰P4÷L;°7¥ú¶‘+á´hX{x“hÓË".-Ц9.ó2Ï“ñS×ì‹•¯º\­ã]‚n-ÝG¬K4W¬ÆfÁhWp×.:nó´Éµ®<Orm´ÛcVšŒs3¬4 °b7„ã}ß+“`9 ª9ÊýgKª9 ¸c…pÖÂ's™rC-Ö •&Ÿè“¹TF_&x›_\' -©œ~ü„Ž›Èr$ó–t»Â »“ŽÀ'£Æÿ¹Ù;œndðšÝÊà´§x&Aɹj’ܹð< ÿd'¤¶v©Ѷ¦ïaìõ8 Tú.òµO³gøÐ ÃÚi …ý«ò²7N°wÙWA0‘ÎÀ<ËøLq‚WÞ›5géGȂҔA,–Æÿ9ÏÅÝ,m¼ÌG¥ ~[©î,ÌkŠÅ$L)–ïB¢j¨X â9‰êLãþ¤pY2ÛËzªr"T(¨Ìub-ƒAmMEÔídýn2³ÊþžfŠænp~eH‹Y÷û-êéu²åhÂéÎIáµá÷–ZR,+Œ Œ±€6 ~kÍ“V9ÂtŽ$ä×GÌjƒ;è¾ûÁµýä õ©§l]QÌrie§ŽI®Ï¡¯¹µçœë¶’ä5¯•ä4G̲$&vÁ+>MKôQ‡Ù!WHÇ~7ôqÃ)Ø ®¯Ç+Éà+o4Á\‘–;2CÊ÷&ûÕыߗ;OÌ; ‡-ëÜÊíÔ·AŒCè¢qx²Ó• ïI³†Â[TŽ»½ÓB{2g¼Ü2¬˜7¥D܇³Û=3ÂÞYqŠaû2‚¹Š…ÈÃáh ’ÂÓ8[6¦Ý²dÂíK|¥ÔØÍÚÎ|Þº&´$YÎS2¿'¯áTËK~ Ç%žÊ¼¢ãw§ šûеfNMx³šâ•¹’í›Jæ(„ÀÅB° ^2D{?­Œ&béDµÔmšh;Æ3ø1qÌ2Ž“ ™À‘*+¦Q«˜“à]Ó&9çÒŽDÒÅë{`‰å¡¦bHåW!«µÀ¨â²Kù°ÚÁS„[²a?“O}:–EôÏ:ãÐÁC³Bò:½Å”iÊi„è dh,Íñ¦Ø–7úÜnñ r ÷ÙÀ+hQÙÆ”:]Ö"ý¢ ¤¬)`¶¼0˜j‹evƒÖ~€qŠ-òÃ:ÕW…ÿ¹Hnp{Ò< ,›’ÒP& L) .ˆY-­WcW™6Ý1L”îP5ž;ÁI8œ©`ÑX´]`µ ~d-ȹi²¯Š~zI¬ø:åàß«l< ‹öÖ‹J0½gÿjS Ѩ÷cáð…ÔѱÜZŸ!#ËœZ¸æÌJ5 N´öøÜ<>‚RªöR,0µý4juÅx-3[Š…&5’]m-_ùš •5Yš¢5ÄÛpFׯ¦ÝW’N&§%<Ë8R¢Æ²Ž“x¬Gd²)©Tuî’oT/—´¹cæS)—â`8„Þ¢R~£ë²4˜¿ƒdóiÕ}IO%Ëy¦x¹ÉÉ%/ µ‚g¬*y„­D2'_fØ»ïu]ùåÊe®Ò°lßeù$UÅDzLd™±«’ü#E²0ÑTªýun.íïÕÚ5Ùî-;RòE Uœ¥SHìb ½¦š…x{6pThEë¿ô# !—àÙcáN‡ÜB¿_ñ+³§s¸c—Svjð¹”ècýÙfý?þUüç]‡ë(×úoüŸk“÷œ}²hñökDY#´Ø¿Ólë@9ÝDƒQîe4(;ΩåìÞà ¶þeãGݸÊù•l7jmS%õŒ6ÅtMøÍ†‰9…’ÚåBljˆ®êô4#®SAZÀ›L®R×Us¢é w}l63|Û¸=iàRm¹NC& KØYµ³qnÎxÀŠŸÕõ»f@ÔŒ”:ìžûfXx©é•ü|[ñ}· "]šÆe³'àJÊ«,kô Â&f1S"%¼÷ŽNóñ7΃õÌ÷ØñzÑù\À›ý²€·í¦Ý_š®í–Ñ âoi»Ð{ÌÓî];O~Œv[~^5è^a0HÃánæÝOðø8M¾óµ<,2×:xös®õS sd‡4a9tm€ s7é·ù5÷xu˜ûtuéºÙ®€‚};†i1ïÝbʽ†‡ÚtÍ… B¥ô_iK&ê)Ù¡Ò0æ§iqps±çÏÙ’æ~†¬kbæ&¥E™ÝŠæT‘lP·W¤ùɨHd°te4wai³1þõ†Ku~"ñ{_‹.‡Ü q•¨± bz:Lš-Q&#ZDK·e²à_’Y×iÍ ‚÷©K†öL©Ÿ†ø°SÔÛ”ÔÕ‡Êsåô¥#ÍTÌë9Žó¼­4+Õ ‹º‚.1qŽ©fɧHæLê¡©®oú×UCó[“aNÄ÷ùå(•C\¡Š'-Cn®g>»¦z–‰4xž.é¢ÉÚØd3¯Kų)ênxýšˆˆ3ò%£Î7VýRòmĵW«Œ¡#ž§˜úQ¤uƒ °bI>µëFXàÙ£e|ÍÌu c©!©ê’\ %î„üž¶X;ÔÙ¥Ëì,W¥FN«)«†¶è­í„Ⱥ±`ÛS{Ð*#Sëä7-‚r“9…­éÅPtˆdçj¿Šà8¡iIíw7ÙOnxm“iä¡w*{+¿8ï· –êå,ª3ƒ9Ð ¢+òÓˆÁ|E2–ûê.$ɳÐ~-íc‹¡ëWMvš ªäŸl¿Rc'¥ö©gƒ£„j¬q§‡ÛU#¼)X”z˜i«Äx”0Wmæ&üG>ÔÍ‘(ù’– °s¹¡;kÕ¡.S>g¿ë´ñ6—H&s°Ÿ)ÌǃÆF¼N]ï1ÊÆ_®“/U\|caãˆVšªÊžZY8uP¤ñäC`.Sn±X·?ðÎG”§ëbîI’8¬;øR˜ìLQµo×ôÀŠ˜ƒ‹_h›"œdû³<í‡8)c¿ÏLݲܥ§[ mNæ®nsY´';>î&Ü ŸÉª&-ù¢2;ž óº;F;~3¦Üø°’?»|Ö‡•Bé/P8Ôzz÷·jã^§F(²íkêNDÙñNí…ª)þ—'ŒÐUÁ›+<÷ônuåËcìmœ Vÿú@ÙïJ`“öØ ¶<2»¹ËjŠOLIt[Å'áØ(–"k!O\„ÕDé–;ÈòÀ[E¡ØØÔRƒ’[2øÊgqDæ µ¨ób2ïL·´¿Ë;3y·]G$c1ñ ªþL”:´£WÿÌEþçèeœ7A†5¯Òöe3Ø4˜\ÅFi¼–®~‡ž¦uUŒ|ß”¹¶Ú¨":ã [Û£3 Þð§bÛuñá> stream xœå[mÅŽòqÅJ|Èbç¦ßgP² &˜€s"@h}ëõ>ßÙ·{ÿŽDâ寧»º»ºgvïLŒò!Šœëíé—êªêª§ªšWó®óÿGO^ÌüϹ˜?Ÿ½šk-d«}ÇR·ý¼†¶wfîºN´}Ãï>œ=|4ß]]?};³£Ïðÿî~uþ<üdþ§Ùý‡ó¯Óª›½š úÑÑ–ó»Ç³£Çð½˜of‚†¦†ÁÎíеRÏ_̾_Ük:Ø[:ã«¿9,Λ¥j…PÒñæYn^4K8¤0?k–Òöí`Ýâëþ&/ü¥oj¾—h–B ѵî ëS Uo<½hlAØÞÉ1¾¶3R«…ŒÛýxüùìþñìëB²½•­}!íÍíÐ ^4@‹©¥ãl«dγF·®3V-žú2v—Z[ßÒƒc}«j~=K}'Íþ´J›Å{©S¤> Ûj¹økúú`b™§©ï<õ­i®²‹Ï|§³4çÕ躌66~«-¡ë"6v±ñ}lüN)£ÛNß8™ÛÑR«QÏYÓ²Õ!ŽÁWȯNµºwÄ0è{0^£b4Ö$'€Y¨}ªw­è$(Âñä^ÍJ׌î6µ*ÖaWÅ:ìÚ¥VÅ<ìúˆºše$Ú OÕYÒÆ“$öËÔº¨8\êêOLɨw‚k™xîDôIyZœ—T`,ÀŸ²@h´?E\ÜŸÂ ý»<…øO!öŸbB™ÎëÔzÂWØG]¢à:Q÷„+ÁMgSs^1—Ê_×cVÙ1‰/¯Ó ÉB<ÝæŠyy¿ñ%öbXZcZðRùËØè'˜m÷ªÌE:Õë‰3?¯,äï7ÒžÜi™J0s¦\k³ÑyTr(ï]§#‹­3V×¥‚å«Y•,õ¦œ†æã"3;vÉÔúaQʤ˜P[%l%›þÁ”=[öàë{Ù³©?4Ø+»Af_ç£û¯ºëëøõ£ØåÔ~p¶ÒúìUf½”âé„IIì–Äï|W³E‚Yâ9¶6ék=—[šä›jž²MÊ|£Ö‡ùz^ À—£%Öù#w7€'pçíî>ðÔsðq­Q 9iµÂàtÜ8pJj¼k`Ö Ø(ÕÐ 6¸å€Wеe©·tz>i–¨g4nÓH K€BmòT½¸â?.``½oo ŒËk\à^Îïu¿Jk>ƒ™×ðž¾·iÁtyê‡ÅWG'hDü?¶pX¢EDŒ=Þz é±Tª•*¯G°HÒ€ì .€ÇY¼¡vXg©,ƒz¡@… òH°Aº_ÂO83tÁÍè¤0  aî%a‹ó¼Â…|Ú<´~…H9;ßËR .7L~—¢ü¥1}hm3AÈ\ù vIß•&œÒ®±¹²qË¡o-ª'œl Ä=`mìÈAìÑ@%úÖ åJIV¨j ½ˆ´¯èkzgè“,¬0¼Ð¹Î¡Ë ð9¢ŒäE`ök‹BÀ!JyM¥NØá0{ ¶‚µdq¨ 9ŽRWw²•´q5~3ŸZ˜­ÁªXWÓµÔ=üÔýâÛÆ¡j›Ïê/‡îpšª û/KŠ JˆNa4 ÎñÏÍ2¨þÖs|©ÌÐWâ½»ÌÃvá*楰C+77°¹²œ—ÙÈ£a>špÜ“”ø"q‡UÜd¼N·Ê”t­È­‹3Vš!oÎyçŽéêM׎-öþ½×O´F”+¡qûûMï)¿Px‡NéxÖÔJưã÷/ÞÒ4U ¿OPDc‡7Ü8²N±3šVP†îK¸‹W sÔ—¯o^ ¯äâCçï;þÜŠj´ÐÄÃK@Ž&Ú€e\%@^˜WBÞ'žTôXàçB܃~®iÄ–lÞt /½ SdšÀ"9O¡¿MçÞ‘x_©ÐSX“¼^að¸[’}уNë Sh#z~Í8jÍXúç[Ü„âªZq “½lñT§M<œJùS–ûø%Šj€PïÆì“ªá  &^ÕÀk©‡7øpî’œ«±ØÜÆrkPµ¡X ¯©Fž…H)(üËÀPú•¯I&|“Zo²šŒ/šçp`IýqtõBâà ñ2hÄ„„%¹D‘ =r@¯¨4ÙO]¯©²I\x7ã #âÈ û%LŸMN!N¤âÃ[ž~)FmUäÿ{!…eºèŽË`óç*fž׬r~l _1)6XæárJï6^¯Œªk¯—gðKͼ…Ï9%ðVÎ$1 ”5fÉ2K`õÏÍAÙ~¡`ÁÛ´sì—¾yI!ùB/n ¸¸Î¯rK#*ľC2¢Ü!Eoc!1ö¨Ê׎•aÅɈÁ)n~W  dçJ’‘è.W×7û*“ ç|ìÄŒeZâY“NÌM9Û§„Ìõ„e 8f›‚¤â°)‡~ÂöþJçÎLÂyšœ[)ºä²“í1oäáKä{ÅB¸©ÝERǤ´•K‰Þ$ Eõ] {oÖ?Ñk@Â=x‡õ†úJ›¬Ñ!ßÜu­3åZ-•fñÏFtUœ c&K¯'‹ÎQ¯ÈëøÏ, ½l<'‹i+ X›ç*äõWõe£zm³SØR>!Ž»Ú‡®9ëÑ3½É'\QŽÃõ•†žWÒg˜ü€ÓK_£ÃUh{Œ×Û,fvJl $(ç~K°,­u|Œ½®ë´‘˜9€£ ‡lµÍBÍÅ´¥úˆ|P˜zнg¹÷¢Aüä¤ö…>-[§åâ>ËHžç×[DcpžO4ÊÛ®$0.ÐkºH'.¤Ž×L–„.|» þF¨yU̾.@l‰á³“Ù––ŸSç‰åY-£ Šmê5Ÿµ„Òcx„¡šÃ”Øâ.:æ «ý«ÎåÞFk¼²9 ˆWGeû7%2mH¼yÞÆô)lSåwWh/ Ør°(ã › ãü ãK¨ƒº ìõþ¨è÷b—"y@Ì(“ìNù,Ó,E¸vѸ½"‘–Ùt€,Ö³s“1°ÀtQ©Q² µ!ó;â‹I“@Íô¥ÿIô7|oÖHvùªDGͳÛL>m+†d®+s·MöK»¤R•Îvõ’01ÑPž  p]È6K4â$@·‹n(Y­c:(§tþ8Ÿü²yy䣄n%+=£¤á(¢//A•Gþ”fl" Žêï²dè‹)\‹zè:ÌQåK´f‚£À´C •73Tw¤U®]™}å…]‘m3¡HÇ“ñ sˆëXßjÎ_ßäS1Þ)Îðqyþ¢÷(K£UÌ—g,ÍWQŒÚ²Ðˆrϡ̙b»¥chª,E1ãª8ÅËO(ˆ ëPFu”­Šeª¤1k6{ Ú÷£tŒã´=© Wã8"ena]gÖÖØá³™„Â:¬@{UO.x9‡Á㳉t.Gºx7HoˆŒö!ì*UÐý”â­÷ ð-k·œ‡ú±†‹FBQ@Á!rÎÜ\Eè…øÝEÇùMj„x‡l>D%Ö |y&¸,µp/ú1ioè‘Ò)Ç—§x_S=Êî)¦Þ‰åÊ㓃ßphH°êÂvH‰–5©ë(S2íC¤¨ýÓpž"¸tž’ÍH™OéZ:é×.²'ÓÓÖ>¬®÷ý›ÆçœKó‘5=¨xÂIK)ñ Åõ«ëÛÞ)þ6¾£L@K]þ¸Üÿð‚gƦñ„¨,èí0Ã(—Ê’ð—4ú4e £‹-¥¥d˜ô*Ðeã½¶ÔQŸÐºâÏ× ¾M”$°pW»^y?ÜM+ä=z ˜“˜…ÅËéY–á‹ÙÕUY*r ûßó¥„ñY°¦ j,:‘Ô›>÷ ɯ £ýa/áÖ)+ÄŠ§¼êX;.ËQ‰ì|Âg?ÿ¼(ѧ´rŸÒÒe.ípB.kkª‰ÏOCÊ#¤0ˆc}C%ò¢³å•c¸±ÄÞ¦DF‚$^ccãMNvq¥®j “Y²0*"=“ÔrZј0}Žo2ù›"lÿ"xnƯaâòÂë  JY}^ˆ\§ågò”ÊÀb¾Ð†MÁ¾ëÂM•a¢Ûo´è,|e‚^1ûù_¢Á:ÉøT ¿¡’;oŽ'rðêaa|ز¡¿ñ7¯ÊLä/iv„DéuköaãìçHñªœa͘äy¶øHÍ—âC¸Ò$å‹zŸê{ê«/’íb)þ" Kv˜a6”Œ® ¦¼_ñäùd0UMöäì³ÝÉó § «ÑÔÏÎ gúÅÈ ¾ñ¤+1¡Ž1ÂÃú?¬ÏVYµÓ¶V É| £?Ž®XÐy`K!¹p¦µ=8i`·õeSüjÂþ¿9øzöÉØ§4endstream endobj 32 0 obj 3925 endobj 35 0 obj <> stream xœ½\Ýrå6rN9wz Uå‡)  é›-{â-“õ®½J¶R;¹8£#å‘%Y?ûA²Ï»h »Ñ ‚”ìlm¹Æ:$A ÑøúëœO»¶?íà?ü{þÃIüzÚŸþ;úpòãI_:¼íôó³“WßN¡¡»¹?=»<éñö¾›Nýz4§g?œüy÷e³·»ÛÆøvžÝý/|½hŒK_ÿÒô¾íÌäC›ÝÝ7vl»n4»Ošý0Oí>>6Ãî»Æ…öƒŸÛy𻚽 7»‡ðÐchws¼¾>…[ß5ñrèªïû]l|¤†+úp“zµigøÔ[Ô´û)´ßÅkvw߀<À¨úpó¸;À[a€S|+Üvÿ®éÖCžÎ4Àt¬éâƒp÷-<<¶³HØYšÌ–FÍáÝ©‹»æξ:1Sòì‚ÐÏŽAÎð‡øÅ}ÜÄ>Âç)ùçpq Ã$¹Q –Ä„Q›ÞA—ðnëEOxsxùlÆøŠK\k×;+vÉWÕ}0™½ « ³Ù÷CkʤI]$‘Æ¿?„Þ⇛´˜ Tス>I1¬++K^ô½±I9ñQR· 3xX÷4… qΗ¨UI³âÃÖDuHK*Ö7Œˆ¦q!ÕU9ô>ÎQ•oJKÞ;·¼Ò$ï8‹xéG,•Ëï@ùb_×òÕ—ôEŒÿ<©ŒïÚÑYR™[©_ -1!1 \c3 µóî¬û´ya>ï”~]ÆÀÛ^}Û÷!üÔúaéí¿ Oþ&­~ %A†¬ÙowÜÿU#ÇG"‘:—ïI[r»9«ôâAÇ¥²¼©Þ˜?¡°@tÃ`õ´÷ƒ5í4˜¨ÊÎÍSšiæ!iJšö,§Ýµ“cÛnœO½H^2vÞÌ»ÿŒŸì<î¾æ¶×ÜÖS[M²Ôÿ0·~œTÿGÜ6¨¥.È 6ƒ2õ¦¸¡í>dƒ]@æ+šŠý¥]·›ñ»÷¸O‹­t#ñVeÑŠŽÅž$ °ŽÀjÆ^?¢àÞ“»Šï±Kž,Ùª)À®¶U78Õ$ü­´<iÓa=æ´9ëâ­V¢»b'õ.^ˆÖèmÃZ~YR¶Î·vDeó„›_'£›pVè…ÑYZ¡Œ¡ÙʼnSÛÏC´OwiB±“¸îˆ‚q©Á`Á¥T/ym/5Š/ yQ˜&HþK^.æ"ñM~Y©W4Pñ ˜¥ÐnbûÂ2_WyÀ{|ƒ{—-šÆJŨ¬z i·¿ £Ú‡#ë €ÊÀ‚ãd±µ¿ÁÄ»!"R IJ¾\W12*ø6ÔØ@h©9õÁR8/¡Æ¥LP3zDhzMM=5mëÃ)zÿDk°5é–:\^äÍIšÿà3h Odæ*ZmƘ’ƽì^¡2’¥Tßå¢ßê’ =5ÉZ/fêj*i·ns;õÊãŠz × æ·‹kGü°!t3Ï-ØOñ1ð¹Ëî¥ùW\—Ÿ!ÙwŒ÷3Øš×goã* [Á›WO IoàÃ’;¦'ÇAO†è†;|´áa5€™{¦+¿Çõnóî+{G?¶o¤Æš.ÉWc.óÓŒ¹û(JBó· •{Àð@’4»¨Ôƒq$Àè8˜„R¤Ëç%¸VMi %ÉY)á3ŽP×MCû X»Ÿà.ï”þ9¡ÏW³ºðåóÆ’‘“+G£z@d~,ìåd%I½”zxû¸|k¹Qwf”Jv.Õmˆ”¹t€µ[¾kÀö¢%Ý£ôÒ¹Ôi^´q×Iå‰âÛf Gr‡PZÅ@#jëãøŠ@¥h@GŠÉ  €øÛ†)KÔ/‚VAnˆ&xíã¤Püïø:ã¦@åuª±6‘¡¾ôSaÎÔi±£k2 7’ìTd!K~SÔÌôöÎcÆÿ4¡©e” z²^wäŠý©MyŽŠ1‘Ê—“š‰·ÎAП–»Å%ÿ/-*… ìÀÛ+‹è}òž¼)²›É ç92ÂåÅe³rëå5Aˆ´‰ðæ^CÖ̆dï—± éA`æ«w’ðçÉ•J•àpÏÄF%­Ÿ"Êlë¯ÀlírmoxuìŠVÕëRZuÒ’5ËÎa¥lQR¬ Í“ž-ñe“1ø9™Þ¼Zâžê‹F—œöÍèÕ’äOW o¥K…Ñ;y /ê’)(-BihH’6øº”F !{ §GV|ò|ÐÏÁV© Zñ*úmÉNù%&YŽ0-âTÌI–ëV¿ÁŸìëšÝ=Gý­ã±—Ãi÷èCTÈÉÔ{Ù mNôhÌ ]#jŸàm®›˜¢{ ¤»R 4/åzȤ‡„A;÷Ç¥ál5QÔáFëŠ w#n4ÐÉßMÀó!7ɼmr0¾óFîSaŠ8ö±Ãy@¬SëM=òý胩¸$äF#wWÈy ˜øN¿ö{ 0 ®ÂzKw}‰¨7áÛ4¶‰àûß«(éAӭ—5ç!·Ÿ£—2™BýÈÅÉÞŠoX¥ø¦¤QaÔ0o­Qn“c ÁÀ—ˆQS$±ñÓäfî…Ú%×w?€m|9Œ-xÒãËŒìÒÁÄÞ¤‰$½’½,é‘p>Tb[[ K%#W] - —2¼ÊÊ]% ƒdÎ褆Áàa>vˆZýNÌã€pˆQH ‹Û–útTšò„æ€5õ¸ÏcEéÈÐEÐî ¨y´{ E"„âw ïî—ꌦÐE9ìS˜~ÊÀ ¶´_DiêDŽº™¸Û+şؼPÓ¾ÖüÊ«…¶”f%Œ š¸¾ú1§ÑÜRíj±ÛN"ª»°Š8» ¤´°•]7E»&œåΧŽ|‘|R •˜@©üÙÙK×Ñk>à³wþ„ø£‰R{æ½±{Køò³«5.ªá i™Ké_$oÙ—! É ¥íÔ÷ÄÅ£'{÷]BNRì*(ùïS’ÍQn@øŠd-È¢bþU²HePë6ßBPx¨Ryõ°!°Æ_“k ϨÞEK–·†ÔDÌL†»„‰sÊ‹©x¹ÌFüɼé^ÁÖ˜"õ2T“u¥ž‹ã€ßª©¤ÄÎûÀ¡éÑðšSÑZA+ñà]5®/\º3Dê1Ü«Šð¢ê+¬Ö"ŽºF+©†î˜…Ra*ÿBDõ¬\Câ §Z !öµQG¨âð5$ÄàñK4nù²ªÆÙ.í›5¤½Ò`¯,>%~Y뀡®Kôd®SÄ®,”é¾±ã¯ôÔ/áúitŸ O2oÆlÿ¿ðÊ9òÏטù—Õ¦”K¼A·S)Üþ×Ï[™¨2ðÊmÀÐwâ9|Dä㘤qÞu¸r XѶ ‹Óp%.dwý»\ØV,jÕÇ+——6UÚc€#QXÄ{Q®޼¨`vÞÀnaÀq°È¹Ô6/òïÂíœ @@j‘1 ûWÈåE¶3Õu‰«‚JÐ;yTá^(l%Å5Y'.…­ÎjÏ*ÿ'gÿúyÛAY ª§øé]Cyg‘#ATÄúÖ]4¤ÏÏÙí>n܈¥ãÌV*C*6Í]£áN«ß#R¥ÕÍ@±€š_)Xv2T‰`Ï2ϳeaÐ]Vä>1¶-Ž*·ˆÄðe–‡ëUJ˱ˆbAxënáâmE`l³$isW)ª ¢[÷NÈêêw˜œ¡£RóͱΖ÷®ex”øù&EŽorÈë1cvN6©Í¶fkk"èpÔø5թҬȒQ$XÖ´L¾¬óçõŠs‘Uv…]™× ˆÖ^]UwM‘È¢Šþ ùýª ˆ¡(¿;»ÄòÔ9AEÞ”Þ±]~8ø>†ï¡J}T¥å£/Ë=¡±(÷Ü,<„ôºsVõ}@=>[ˆš»ÁVö\!ªyA!j0tÕ»0Ðr‹œä;µû?•ûy}m‚RÁtm˜ÿÈo€D×EmÀ’ýËø1]¶Ó(ªüŸøò ·/«üÃ>£O—|ÕpÛ÷ò4{ìÉÄ¥w9?à»àÓö»>­¼ë‰Û^ò,´½Ýqãþô¶áëÿ%Ç€£7Ý@cþûKÒü%iþ’,Ÿ-$ùçB¦pùyénâ3ä˜ô7Ÿù¹Í¾£¬r"_ECcqR´O©>ÍÛ²ÊI81ÞÓÆòy NsÂÅ_V×D•UëÅvp,oè9üLutxJBX÷÷a][Xä"ˆ'“I ï8ÐqÂîçlDéö‰rl¥=RÙš©ªÌ¦Rü**£„[Q eÿYgèD‚uo€6϶ª ;ÉÙ‡xNnéY ©Ä3Û@ܺµVúC¯—{‰+ÃúU†<˜ö/°6àsP°²NßAõ=ÆÕó‚4èT¾éZ7² áÃÿ;ÄA¢wà3÷™ä¡%d˜§z¹‚š\µÈNœçÓ5TÈ„»¡¬ÁG9h:M„¸@uÁØN¶É¬n!{!|&jŠ\a»@×J]•ÌIl‹dñó—݈>H›q‘Ûˆ'™Øõ¢¹<–ü©ëŠúml„ÍðÙsõLt vt/*絤McË‚d]g@ÎE¡=( Q´„eqpÎÅrîžn!Ug+M‹U1ø5/¢’0("z„Œ „®*¾Ñ=Ò¢`¬Ee5žLRC;·ñ€þ_šZ®JÂ’÷6—¬œïäĈ:r^ج›ÇW= 3ǹ&ð‘©t, y_I/⋳“oN~<†ÖÇNÒMÁ‡þî˜Q7˜ÖOðs Ÿ¿9yõæw§÷O'¯þtÚŸ¼úþ÷ù^‡?oþíôŸN¾xsúÍê/(¬ŽØu­{9â?òˆ¿ ÆMßRÓknúòùéL¶ÿMgÛqVÓùô3ûY1öMWÓua)´„ôÉØtúܶƒõ&¦lŸžØ®íyÏÍ~žÇÖt#¤%LðجGž‚hÆ!–Q„n26$’¦Þ#9h¨]?ÆOÓö3¨½Ÿ'qìCð·{ åŠÜɽÏ­•¹<Åølr2þ lð4q8‡6R>Ö+«>×Ê“Ñâûã5‰‚SR“ÏøRÕN Tô„Ár›ó©žÚž¥x&ë¿t@Uª„*a%Ç~‘ñލէu§ÙTsœºˆ85w­9鯊h0–™$jLíVwLƒSÖÝ&›c‰W&½}œ÷gè#zT\XS¡ïq©íD'_—åE 'Î\ÿÚÆF ]pY”,>N§ì&”¹Gr ŸÐº!3Êz§êÖIIk‘HRk_œg¡eÆvý“ii?æ ×vùeIÿ8@²ÙÅ2Sÿš”%‡… gÕvíÐÒ 9t›ƲÊR±T*Ó³i¥m²Q2I…mº¾òI¡ED<ÅV­b^hômõTÍÆoè#3I6ËJ9QÖ›\ê¼1ß7*îK§f ‚ôdÒç¨`ƒè~弪 ã³€ÚAO§eVt$–Wƃvf/¿ªª%<‹³¶àâTïs Ž7èÂ2,@àC§T €‚Ë„KŒfý§)ø e.ó£;?°¨ö mYœ@€;ñÔ¦¡&¬îUn—–,ó3bÅñpm¢°Tn—½NN¼ÃÔµøA¨Q>5E9LÄÅòœhTÏY£¥j?ªÙâ ‹ix§Ž ¹â7G„j¥LÒt'Ú>´u@÷aQ¥¤Ô1 yܾ<ŽXLäeþ$iÐfu4Kl¬ŸQ¬”¹Ù£…‡zcˆÀnÙ°$¼iýGŠS³“5ºš™E]J. …F†'vø¤lÌ0¬A8FN߇ìO‘Kn´:• ©ˆºNQ«ÂùÞÂ&ú‰' ­’ò¨ý.’áÏ9ú‘üUê~Ês*íeñ+SSÌ ½9ª7ä¢?ù{Xow•]$‚!ý Š$—Æ­8ê~õoF¿Ý –Ö/ A[¿ç«½)º|‰ÕädÕ§‘v-Á73 îÔs)Õy޳×ÎP®„ÀžEf¯m%nóz‘ãª>rÒT>Lär½ÅØ's’y€ËØ~q6ý¤¡Õܺž¢—¹ß’Ãcœ¾ªô»vú¢®)8¬¨Ûf<ì¤CŸ”/‰eo_ƒ€æà&Î û¾m¼Ã6†õT†m(8íStŸbìÑŸÿæäowõªÍendstream endobj 36 0 obj 5174 endobj 39 0 obj <> stream xœ­\ÛŽ·’7}žiÐŽûÆîf€<$ÄAÄVQ¬vµKÚYϬlË¿á|pX¬ «HöìÈ0 Á³=Ýl^«N*Îwgí¶;ká?úÿåûgñϳîì¯òéí³ïžuôGK·ýñå³Ï¾ZÂ…­o}wöòúYG·/~뽟Î&ZíÏ^¾öïÍ¡7Ͱ¹ ÿ¿ ÿßœã‡ûÆÅ‹/Â…¡ßúaÚ| —vá߇ðo.·ãÖÃæ2Ü —¯Â¿7pyˆ—hÎÇÍ]há]üwÞûp}ö±á]lœZ襅ðòð&¿,Óæ!üÞ¶m×A ø›ŸûÍëø¶1> €NÁ€à–Þm}¿l®ù±>|÷-õ`ô±£;zü@C}Þ„‡Ú¾Ÿb¿ú)40Ç/?4ÿyùų~Z¶wa*_^…™ƒÞ=P+{~ <Ø…7Ø¡wéºô~LwÃKÃmðÇ/åKÿg¸Ÿ¾ÆÅà[öòé#ÌG§›»s'_Ú‡ÒØ6,Ì&~ê7_7縜z@éNéLÁ9ÏÁy7lÇÁ/8 ç=ôÛÍaåç8 !÷Uú.íŸÝW Qï§`˜&  Ìaé—ÍçÐë/^/Ã'¸m6_5S°ó›oÂmAr—f[Þ—¡‚þØÂâµ±ß4]z:wì}‡ø ¼[w~é&ÞP©ãéµ0)Üž@CÍ â9ÜŽØ}DØ-¡án`ØíÒíW„ߨŸ{õ¬[ÂÜãÇ ö]ÂU¸Ôm·ù± ÝmûE­¯ŒpPˆÞ¾­Ü s9À€Í½2нz%?ò'±¼^š…-f€ç`tK&‡6¼C¢]C‡Ð#‚Ãs€a^Ÿ°¶°,ÀóüjþˆÞÃkAáÁ¶÷ˆòK½è`-'9^»Õ¦ìz›Þÿ£½Cµ·Ç¹ž­MÙk”]ÄýåÂ0æ‡ݘã½»æ—ðü÷z)õpLG¢7áß-bp^¶.aðéÍ7´m4ôwÊöˆMÓÖ˜#\Ó}´ë‡a$cP"F¹ˆ5ó˜®Ã¤¼jä‹°ÇÝ4Äñè1&ŽÆ‘6µ=l˜=³}¢Œã@oA^ Ø#AÇ3˜ŒqŽöåž6ñZ@øÊ-Ñœ“‘ä5"ëÀXP³ÀžWð-™Üaœ"èe‰w Ù·è€b'®´QzCt•Ë……ˆ°#ðاï+EÓ&~VfIW,¢—9NÍë&ø6*i sæ:¦´øŒƒMXzg¼'v6A°ŠKÙ…SÖþ5²†vÀY¿”/ï*h¼W½khÉÎá”X;÷ÐÈ@û0´cyIú¹•KÕåèôjdÃúÉM8éÝE3 ØSszbÖÏ åSZÝ-8e¡±×ctÇdGÿ¢}xê}ݶòt0+<Ðîz_͉—ƒÕšæŽ1¸ê¢é­B˜kÂ’,}ÄE¾JÚ‘š¥šÅ‚†9ó“÷ÆWõs¤/£‹)|Uè¾õUü ÕKC‰¸á0­UKá®Ï¾ò:nh·‹£Ð¡k§íÐù³©ï·ãˆ¡Ãc@õÜN½[lnG †¯ýW®äZzâ½|+×°ÕÀ¥s`±íÛ/HÇðù#pû6r…!÷„¯£OJôûø¨C(°mçÙ¼÷&öwBvÙèç‰&Dßtà[¹û’.x?»íìl€ºq âÀ.‡:ïyj2“K“ı;zòè|z`>…"Õ3›R‡6x¹N]Ôd0ì¡.î!ûLÜXKeÁÛFv‰LjoŠÐ羸r“f`‡Æ[‘ÌnÁé¶›ä¤ù@k £œ\%~xŽ„1:Œ…§6šÜĆ)\b«º^ãøÔxÄú‘%çgÖ¸¿K·Ž‘±×ßq(̓.3­¼RÛˆlÌFÕÛeÇ^’Ó-Ó!4NÁ±ÂíÖé£Ö‡¢®Å(Ï·Ä]u\|&\Â×ã‚s¼ô@S²§õ‚‡{$Soª[ÆýîÞEhI´#±–šmdtL‡ “P2ÓMøù6’“ ÍÒ—ïÂ…Z$Äýq%öaAD(÷)tZ¦3›…LŠº[”×úјÅóí­ "w& åàsž+{¸1ONß+l©D|ì¶m[²°,LœÙI>Ážž˜º©UÀXËÉŸF&1azm‡p ›ñ>ñ¾œÃk†´ÆÏ9¨-ÉÚNx“s=#+çœè¢Q7Ö雚Ã}E»ÒŠ…›ákŸ¸¢Óa6:u+ˆö ‰¶ëxyÜ…!ðµˆâ£‰;îÊn ƒI³†.7d*î"0Ï;ÄšÉ;ðì0O×áOR¯ ܹ8±]Àñ0Ä I/¹‹øÝ-µ69~Wb¬r ¬øh<xDÁaÚü)Épù éM™•‰ö… oupÔ)Óa?nûD>˜/<¤™4OÝ4™f[ç¶1:4LfßÅE(5ƒª¦e:Gj·3Êlµ'ŸŒV“ÓQZ\ç‘ÒÔÚI¨ü(±Î˜5‘¬Ø~L{”Ù-&2{r³¯ Slu†kûHv€™<nÂüôš0Çs¶ë¦ìSÂN ÅQÛúBWàg$ª/Zö¦cHÎ[ç%¦$›‘G¸5c«–,h–¬Q}§AMÂŽy=óD!K ûo„ˆ‰8µg,ΘÞe·k6.’b3ëXÈVjažoBžnÉvË¿ÂS‚ÞwÔ‰öjäCÑ‚N[¼ÍlqæK»ŠÜ¯¼±âÄ©ãì]´—ãXÏ?µÍ²›z™Ÿ‹Tظ:!ÔZ×V"%Üo˜£è§ªbò^1æ'nÖCžQŠ äÀ¿iü’œö½—ê“$Ün-ËUCÅ.ôö yBUyË}´a‘ßÙì˜c·¼òb€ø5Ê$ß4¬ ›Ÿ(R&~nö‹Db^Ì76(Ú›¡^Jӗ窣 oºSâ”Ú+2m£R&Ào@sÄ<ÎÃHÍšŸõHÐo½pð£‚àÓsdÉæû ?£`-{uZ|e!gm~­…•%1\ Ú‹²‚wô1aeÒ$‚4oÖ¬­¹Æ’"®Då%¯„;n5Ž!‹8>›§­ ºCƈ΅؟;ªA›Ï£ù޶–ªQà’–#=Íì*——´³I†©´¡%i"þ+Ú±Ï%¥X õòõ©¢»ª¡ÿ!ìuºú5|ô¡±\~)³i˜†25öÚ¼/ÙÈ·Bq¨Ö\a ŠðÛk 8 ò¸RcHã$°º¢%!Ã1´£ù ŒsˆºÇL Q¦j>’Uºä"wM¦µ˜ÜÿÐ+“WŒ‡ds½¡Iö8*3K·rPP/ª)H„¢¹ßö Eo¨ã“K†[ÏÜœ)•×ÚQîköâ$ÛóË‹Vö8E0.< ¿´¡Æ•M|«ÌEî mò‡o­‹ ðžçMï­5RŠ8Ûu^4N4=ùJÚÖš¬ÆkÈy€Þ?7M­Ðu[rÑŒ¹Jkl'1£6îkVkG {HfâÔÆ„M.ú˜%â;hr·¥¶@¯çî·riË—nùÒ‘dYë’2ô›¿H?¯Ù8Ì•`$Ž{ÌæU›ÀaÆ×XçúDö¬˜Æ<}†ÖC'Á. ¥;ŦU6í¾É ÉRÅ Ò'’š©ÆSÊâ 5[Ï&æ‚UŠ óTf¬xu<¶Ô!:ó¨jýù…‰iGåYH5 •¤¼fÎóŸÌûµJ,L½| ³{Ÿ…Ù1.éêe›—ʰ“¦+uvª:87Êöáåø„;‡ÅiLÏØÌô¶ÀAg¥'Ìyèú’r³w*l ™¬Ç´y~j-™ž[1ºl²¿ky­\¿ ËF—+$˜á„Ç2¨‚`C'ò4,]^y[–›Ñç'™^©Dã«§ò)‘rWrIoÄLVÕézTÌó1ª6NÖõ©fkM{5^“ã¾²œ?7BÌQ¿È„®äWt¾82Á/¶¢ˆ@Ö¹†NÄ_5–ú èß2¨•ÓR?¶¿ô‚"$^ªe¨˜ç¥‡J-°l¡-ÝeOÕi‹cª'íÙñàâÇÒ]ñEâ“J‚ šˆ«sì¦f_Ç‹$á2AÂH³³»[B‹ìÒÚ!“JÜ‘@Åý•£cˆΕýÙWÝÞ ò-N‘¨}bSÜSU2‡w:¥¦Çöç¢j…ÛT4\OQŠØP=!c›à©°X)µ#-–Áã€"3©Uƒ32æõs/;•¨‚©°9„ä{$aÌMUY^xÀÞYûd\¡º¡––ºÖˆ®£yȺ¤`̽¡5ÆÕ÷Yõ\f–ø`¡3¤gùNÃàR15¹%STøhhõ¼èq •᪛D’a?ÁÏhøÖN±7ÓöDè•Í-ž-R­ ½ËŽ©…Š•¨Îíd¤/³Øé_º6Y‰ 6£æÃke‹M¬_”¦.Ãsà@ÕMÆ0*fšð‚2HÉDíˆÜ°t¼”r0g§û‘™ÒŠÊ'&0¦/%CâÐx¶Àò+n¯¤R V¾­æ¶7IO®XÀà¨ë𝴶£¸_~nR-Ó~ôütˆU¢ÏK)ŽžÖ]°™ˆŠKÓ—Õõ®QÿŸ0Rª&fÓú¢&Û™n½åÔïd1Ú§:ìû´%±sˆ vÛ¹9iZ§ö¶î9 -EØ6]IËyÓ¨óÔyúùtûâæ,+­ŽlÛ6ëqC%ÇnuŒÜNáTåÅÛëµý+`ãsU6é§­’ÖÅ”U15…»Fjéø¼ ÕðÙcÚ0ê¶Vêò8ÜóRÈæYÅ?çIUŒŸ#–­W—øºš8­IS'Ö’©¦¸ˆYÎeêzõWVrÑ`‘[#YbS~±Ä}Z¤Úr­å ‘jß÷1öL­bèbTšCë:›FrM×ßšs0 Ëè¹VI\j14 kIê=Ý6dl.ù¡’d)4Ëo=¹zšÉ$Qí$ä•­åÉ)9ED¨R¿7þo¥ …,Ì1¿È•KÏ›|Ã?xaìɵšzü,t·‡^Ïãv¦Í1ãÖùü峄ÿþRœüÏendstream endobj 40 0 obj 5075 endobj 4 0 obj <> /Contents 6 0 R >> endobj 14 0 obj <> /Contents 15 0 R >> endobj 18 0 obj <> /Contents 19 0 R >> endobj 22 0 obj <> /Contents 23 0 R >> endobj 26 0 obj <> /Contents 27 0 R >> endobj 30 0 obj <> /Contents 31 0 R >> endobj 34 0 obj <> /Contents 35 0 R >> endobj 38 0 obj <> /Contents 39 0 R >> endobj 3 0 obj << /Type /Pages /Kids [ 4 0 R 14 0 R 18 0 R 22 0 R 26 0 R 30 0 R 34 0 R 38 0 R ] /Count 8 >> endobj 1 0 obj <> endobj 13 0 obj <> endobj 17 0 obj <> endobj 21 0 obj <> endobj 25 0 obj <> endobj 29 0 obj <> endobj 33 0 obj <> endobj 37 0 obj <> endobj 41 0 obj <> endobj 11 0 obj <> endobj 10 0 obj <> endobj 9 0 obj <> endobj 8 0 obj <> endobj 42 0 obj <> endobj 12 0 obj <> endobj 43 0 obj <> endobj 5 0 obj <> /Doc-Start<> /section.1<> /section.2<> /section.3<> /page.2<> /section.4<> /page.3<> /section.5<> /page.4<> /section.6<> /subsection.6.1<> /page.5<> /table.1<> /subsection.6.2<> /page.6<> /section.7<> /page.7<>>>endobj 2 0 obj <>endobj xref 0 44 0000000000 65535 f 0000032424 00000 n 0000035452 00000 n 0000032316 00000 n 0000031150 00000 n 0000033492 00000 n 0000000015 00000 n 0000000764 00000 n 0000033163 00000 n 0000033101 00000 n 0000033031 00000 n 0000032965 00000 n 0000033354 00000 n 0000032532 00000 n 0000031292 00000 n 0000000783 00000 n 0000004932 00000 n 0000032604 00000 n 0000031436 00000 n 0000004953 00000 n 0000008823 00000 n 0000032654 00000 n 0000031580 00000 n 0000008844 00000 n 0000011855 00000 n 0000032704 00000 n 0000031724 00000 n 0000011876 00000 n 0000016676 00000 n 0000032754 00000 n 0000031868 00000 n 0000016697 00000 n 0000020694 00000 n 0000032804 00000 n 0000032020 00000 n 0000020715 00000 n 0000025961 00000 n 0000032865 00000 n 0000032172 00000 n 0000025982 00000 n 0000031129 00000 n 0000032926 00000 n 0000033245 00000 n 0000033438 00000 n trailer << /Size 44 /Root 1 0 R /Info 2 0 R /ID [(Ôy³APõ©W3tûžt+)(Ôy³APõ©W3tûžt+)] >> startxref 35649 %%EOF f2j-0.8.1/goto_trans/0000700000077700002310000000000011031241063014417 5ustar seymourgraduatef2j-0.8.1/goto_trans/byte.c0000600000077700002310000012263111031241063015535 0ustar seymourgraduate /* ************* *** JAVAB *** **************************************************** *** Copyright (c) 1997 *** *** Aart J.C. Bik Indiana University *** *** All Rights Reserved *** **************************************************** *** Please refer to the LICENSE file distributed *** *** with this software for further details on *** *** the licensing terms and conditions. *** *** *** *** Please, report all bugs, comments, etc. *** *** to: ajcbik@extreme.indiana.edu *** **************************************************** *** byte.c : bytecode manipulations *** *** *** Your courtesy in mentioning the use of this bytecode tool *** in any scientific work that presents results obtained *** by using (extensions or modifications of) the tool *** is highly appreciated. *** *** */ /* ******************************************************** *** INCLUDE FILES and DEFINITIONS *** ******************************************************** */ #include "class.h" #define CHECK_TABLE #define GET_IT(a,b) if (valid_cp_entry((a), entry, (b))) { \ n = constant_pool[entry] -> u.indices.index2; \ d = constant_pool[n] -> u.indices.index2; \ s = constant_pool[d] -> u.utf8.s; \ } \ else break; #define HAS_TARGET(b) (((b)>=1u)&&((b)<=3u)) /* ******************************************************** *** EXTERNAL VARIABLES *** ******************************************************** */ extern char *filename; /* global information ****************** */ static attribute_ptr att; static u4_int len; static u1_int *byt, opc, bra, exc; static u2_int pre, pos; static char *mem; static u1_int is_wide; static u1_int is_instm; static u4_int target, next; static u2_int glo_sta, glo_pad, glo_loc, glo_stm; static s4_int glo_def, glo_npa, glo_low, glo_hig; static u2_int cur_sp; static char *thisClassName; #ifndef TRANS_DEBUG #define TRANS_DEBUG 0 #endif static int trdebug = TRANS_DEBUG; static int numChanges; u4_int u4BigEndian(u4_int); char isBigEndian(); /* reaching definitions and uses ***************************** */ static char rd_buf[510]; static char *rd_sig[255]; /* fixed arrays */ /* bytecode table ************** */ static struct bytecode_node { u1_int opcode; /* redundant verify field: bytecode[i].opcode == i *********************** */ char *mnemonic; u1_int operands; /* 9 == lookup */ u1_int stack_pre; /* 9 == lookup */ u1_int stack_post; /* 9 == lookup */ /* *********** */ u1_int exception; /* 0: no exception 1: pot. RUN-TIME exception 2: pot. RUN-TIME exception + has c.p.-entry 3: pot. LINKING exception 4: pot. pot. LINKING exception + has c.p.-entry *********************************************** */ u1_int branch; /* 0: no branch, --------------------------- 1: cond. branch + target, 2: uncond. branch + target, 3: jsr/jsr_w + target, --------------------------- 4: special + continue next 5: special + no-continue next ************************************ */ } bytecode[] = { /* ***--------------------------------------------> opcode **************----------------------------> mnemonic **-----------------------> #operands (in bytes) **-------------------> stack pre (in words) **---------------> stack post (in words) **-----------> exception **-------> branch */ /* *** ************** ** ** ** ** ** */ { 0, "nop", 0, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 1, "aconst_null", 0, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 2, "iconst_m1", 0, 0, 1, 0, 0 }, { 3, "iconst_0", 0, 0, 1, 0, 0 }, { 4, "iconst_1", 0, 0, 1, 0, 0 }, { 5, "iconst_2", 0, 0, 1, 0, 0 }, { 6, "iconst_3", 0, 0, 1, 0, 0 }, { 7, "iconst_4", 0, 0, 1, 0, 0 }, { 8, "iconst_5", 0, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 9, "lconst_0", 0, 0, 2, 0, 0 }, { 10, "lconst_1", 0, 0, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 11, "fconst_0", 0, 0, 1, 0, 0 }, { 12, "fconst_1", 0, 0, 1, 0, 0 }, { 13, "fconst_2", 0, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 14, "dconst_0", 0, 0, 2, 0, 0 }, { 15, "dconst_1", 0, 0, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 16, "bipush", 1, 0, 1, 0, 0 }, { 17, "sipush", 2, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 18, "ldc", 1, 0, 1, 4, 0 }, { 19, "ldc_w", 2, 0, 1, 4, 0 }, { 20, "ldc2_w", 2, 0, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 21, "iload", 1, 0, 1, 0, 0 }, { 22, "lload", 1, 0, 2, 0, 0 }, { 23, "fload", 1, 0, 1, 0, 0 }, { 24, "dload", 1, 0, 2, 0, 0 }, { 25, "aload", 1, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 26, "iload_0", 0, 0, 1, 0, 0 }, { 27, "iload_1", 0, 0, 1, 0, 0 }, { 28, "iload_2", 0, 0, 1, 0, 0 }, { 29, "iload_3", 0, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 30, "lload_0", 0, 0, 2, 0, 0 }, { 31, "lload_1", 0, 0, 2, 0, 0 }, { 32, "lload_2", 0, 0, 2, 0, 0 }, { 33, "lload_3", 0, 0, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 34, "fload_0", 0, 0, 1, 0, 0 }, { 35, "fload_1", 0, 0, 1, 0, 0 }, { 36, "fload_2", 0, 0, 1, 0, 0 }, { 37, "fload_3", 0, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 38, "dload_0", 0, 0, 2, 0, 0 }, { 39, "dload_1", 0, 0, 2, 0, 0 }, { 40, "dload_2", 0, 0, 2, 0, 0 }, { 41, "dload_3", 0, 0, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 42, "aload_0", 0, 0, 1, 0, 0 }, { 43, "aload_1", 0, 0, 1, 0, 0 }, { 44, "aload_2", 0, 0, 1, 0, 0 }, { 45, "aload_3", 0, 0, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 46, "iaload", 0, 2, 1, 1, 0 }, { 47, "laload", 0, 2, 2, 1, 0 }, { 48, "faload", 0, 2, 1, 1, 0 }, { 49, "daload", 0, 2, 2, 1, 0 }, { 50, "aaload", 0, 2, 1, 1, 0 }, /* *** ************** ** ** ** ** ** */ { 51, "baload", 0, 2, 1, 1, 0 }, { 52, "caload", 0, 2, 1, 1, 0 }, { 53, "saload", 0, 2, 1, 1, 0 }, /* *** ************** ** ** ** ** ** */ { 54, "istore", 1, 1, 0, 0, 0 }, { 55, "lstore", 1, 2, 0, 0, 0 }, { 56, "fstore", 1, 1, 0, 0, 0 }, { 57, "dstore", 1, 2, 0, 0, 0 }, { 58, "astore", 1, 1, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 59, "istore_0", 0, 1, 0, 0, 0 }, { 60, "istore_1", 0, 1, 0, 0, 0 }, { 61, "istore_2", 0, 1, 0, 0, 0 }, { 62, "istore_3", 0, 1, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 63, "lstore_0", 0, 2, 0, 0, 0 }, { 64, "lstore_1", 0, 2, 0, 0, 0 }, { 65, "lstore_2", 0, 2, 0, 0, 0 }, { 66, "lstore_3", 0, 2, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 67, "fstore_0", 0, 1, 0, 0, 0 }, { 68, "fstore_1", 0, 1, 0, 0, 0 }, { 69, "fstore_2", 0, 1, 0, 0, 0 }, { 70, "fstore_3", 0, 1, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 71, "dstore_0", 0, 2, 0, 0, 0 }, { 72, "dstore_1", 0, 2, 0, 0, 0 }, { 73, "dstore_2", 0, 2, 0, 0, 0 }, { 74, "dstore_3", 0, 2, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 75, "astore_0", 0, 1, 0, 0, 0 }, { 76, "astore_1", 0, 1, 0, 0, 0 }, { 77, "astore_2", 0, 1, 0, 0, 0 }, { 78, "astore_3", 0, 1, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 79, "iastore", 0, 3, 0, 1, 0 }, { 80, "lastore", 0, 4, 0, 1, 0 }, { 81, "fastore", 0, 3, 0, 1, 0 }, { 82, "dastore", 0, 4, 0, 1, 0 }, /* *** ************** ** ** ** ** ** */ { 83, "aastore", 0, 3, 0, 1, 0 }, { 84, "bastore", 0, 3, 0, 1, 0 }, { 85, "castore", 0, 3, 0, 1, 0 }, { 86, "sastore", 0, 3, 0, 1, 0 }, /* *** ************** ** ** ** ** ** */ { 87, "pop", 0, 1, 0, 0, 0 }, { 88, "pop2", 0, 2, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 89, "dup", 0, 1, 2, 0, 0 }, { 90, "dup_x1", 0, 2, 3, 0, 0 }, { 91, "dup_x2", 0, 3, 4, 0, 0 }, { 92, "dup2", 0, 2, 4, 0, 0 }, { 93, "dup2_x1", 0, 3, 5, 0, 0 }, { 94, "dup2_x2", 0, 4, 6, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 95, "swap", 0, 2, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 96, "iadd", 0, 2, 1, 0, 0 }, { 97, "ladd", 0, 4, 2, 0, 0 }, { 98, "fadd", 0, 2, 1, 0, 0 }, { 99, "dadd", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 100, "isub", 0, 2, 1, 0, 0 }, { 101, "lsub", 0, 4, 2, 0, 0 }, { 102, "fsub", 0, 2, 1, 0, 0 }, { 103, "dsub", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 104, "imul", 0, 2, 1, 0, 0 }, { 105, "lmul", 0, 4, 2, 0, 0 }, { 106, "fmul", 0, 2, 1, 0, 0 }, { 107, "dmul", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 108, "idiv", 0, 2, 1, 1, 0 }, { 109, "ldiv", 0, 4, 2, 1, 0 }, { 110, "fdiv", 0, 2, 1, 0, 0 }, { 111, "ddiv", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 112, "irem", 0, 2, 1, 1, 0 }, { 113, "lrem", 0, 4, 2, 1, 0 }, { 114, "frem", 0, 2, 1, 0, 0 }, { 115, "drem", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 116, "ineg", 0, 1, 1, 0, 0 }, { 117, "lneg", 0, 2, 2, 0, 0 }, { 118, "fneg", 0, 1, 1, 0, 0 }, { 119, "dneg", 0, 2, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 120, "ishl", 0, 2, 1, 0, 0 }, { 121, "lshl", 0, 3, 2, 0, 0 }, { 122, "ishr", 0, 2, 1, 0, 0 }, { 123, "lshr", 0, 3, 2, 0, 0 }, { 124, "iushr", 0, 2, 1, 0, 0 }, { 125, "lushr", 0, 3, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 126, "iand", 0, 2, 1, 0, 0 }, { 127, "land", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 128, "ior", 0, 2, 1, 0, 0 }, { 129, "lor", 0, 4, 2, 0, 0 }, { 130, "ixor", 0, 2, 1, 0, 0 }, { 131, "lxor", 0, 4, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 132, "iinc", 2, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 133, "i2l", 0, 1, 2, 0, 0 }, { 134, "i2f", 0, 1, 1, 0, 0 }, { 135, "i2d", 0, 1, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 136, "l2i", 0, 2, 1, 0, 0 }, { 137, "l2f", 0, 2, 1, 0, 0 }, { 138, "l2d", 0, 2, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 139, "f2i", 0, 1, 1, 0, 0 }, { 140, "f2l", 0, 1, 2, 0, 0 }, { 141, "f2d", 0, 1, 2, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 142, "d2i", 0, 2, 1, 0, 0 }, { 143, "d2l", 0, 2, 2, 0, 0 }, { 144, "d2f", 0, 2, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 145, "i2b", 0, 1, 1, 0, 0 }, { 146, "i2c", 0, 1, 1, 0, 0 }, { 147, "i2s", 0, 1, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 148, "lcmp", 0, 4, 1, 0, 0 }, { 149, "fcmpl", 0, 2, 1, 0, 0 }, { 150, "fcmpg", 0, 2, 1, 0, 0 }, { 151, "dcmpl", 0, 4, 1, 0, 0 }, { 152, "dcmpg", 0, 4, 1, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 153, "ifeq", 2, 1, 0, 0, 1 }, { 154, "ifne", 2, 1, 0, 0, 1 }, { 155, "iflt", 2, 1, 0, 0, 1 }, { 156, "ifge", 2, 1, 0, 0, 1 }, { 157, "ifgt", 2, 1, 0, 0, 1 }, { 158, "ifle", 2, 1, 0, 0, 1 }, /* *** ************** ** ** ** ** ** */ { 159, "if_icmpeq", 2, 2, 0, 0, 1 }, { 160, "if_icmpne", 2, 2, 0, 0, 1 }, { 161, "if_icmplt", 2, 2, 0, 0, 1 }, { 162, "if_icmpge", 2, 2, 0, 0, 1 }, { 163, "if_icmpgt", 2, 2, 0, 0, 1 }, { 164, "if_icmple", 2, 2, 0, 0, 1 }, { 165, "if_acmpeq", 2, 2, 0, 0, 1 }, { 166, "if_acmpne", 2, 2, 0, 0, 1 }, /* *** ************** ** ** ** ** ** */ { 167, "goto", 2, 0, 0, 0, 2 }, { 168, "jsr", 2, 0, 1, 0, 3 }, { 169, "ret", 1, 0, 0, 0, 5 }, /* *** ************** ** ** ** ** ** */ { 170, "tableswitch", 9, 1, 0, 0, 5 }, { 171, "lookupswitch", 9, 1, 0, 0, 5 }, /* *** ************** ** ** ** ** ** */ { 172, "ireturn", 0, 1, 0, 0, 5 }, { 173, "lreturn", 0, 2, 0, 0, 5 }, { 174, "freturn", 0, 1, 0, 0, 5 }, { 175, "dreturn", 0, 2, 0, 0, 5 }, { 176, "areturn", 0, 1, 0, 0, 5 }, { 177, "return", 0, 0, 0, 0, 5 }, /* *** ************** ** ** ** ** ** */ { 178, "getstatic", 2, 0, 9, 4, 0 }, { 179, "putstatic", 2, 9, 0, 4, 0 }, /* *** ************** ** ** ** ** ** */ { 180, "getfield", 2, 1, 9, 2, 0 }, { 181, "putfield", 2, 9, 0, 2, 0 }, /* *** ************** ** ** ** ** ** */ { 182, "invokevirtual", 2, 9, 9, 2, 4 }, { 183, "invokespecial", 2, 9, 9, 2, 4 }, { 184, "invokestatic", 2, 9, 9, 4, 4 }, { 185, "invokeinterface",4, 9, 9, 2, 4 }, /* *** ************** ** ** ** ** ** */ { 186, "xxxunusedxxx", 0, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 187, "new", 2, 0, 1, 4, 0 }, { 188, "newarray", 1, 1, 1, 1, 0 }, { 189, "anewarray", 2, 1, 1, 2, 0 }, /* *** ************** ** ** ** ** ** */ { 190, "arraylength", 0, 1, 1, 1, 0 }, { 191, "athrow", 0, 1, 0, 1, 5 }, /* *** ************** ** ** ** ** ** */ { 192, "checkcast", 2, 1, 1, 2, 0 }, { 193, "instanceof", 2, 1, 1, 4, 0 }, /* *** ************** ** ** ** ** ** */ { 194, "monitorenter", 0, 1, 0, 1, 0 }, { 195, "monitorexit", 0, 1, 0, 1, 0 }, /* *** ************** ** ** ** ** ** */ { 196, "wide", 0, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ { 197, "multianewarray", 3, 9, 1, 2, 0 }, /* *** ************** ** ** ** ** ** */ { 198, "ifnull", 2, 1, 0, 0, 1 }, { 199, "ifnonnull", 2, 1, 0, 0, 1 }, /* *** ************** ** ** ** ** ** */ { 200, "goto_w", 4, 0, 0, 0, 2 }, { 201, "jsr_w", 4, 0, 1, 0, 3 }, /* *** ************** ** ** ** ** ** */ /* reserved opcode: break */ { 202, "???", 0, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ /* _quick opcodes */ { 203, "???", 0, 0, 0, 0, 0 }, { 204, "???", 0, 0, 0, 0, 0 }, { 205, "???", 0, 0, 0, 0, 0 }, { 206, "???", 0, 0, 0, 0, 0 }, { 207, "???", 0, 0, 0, 0, 0 }, { 208, "???", 0, 0, 0, 0, 0 }, { 209, "???", 0, 0, 0, 0, 0 }, { 210, "???", 0, 0, 0, 0, 0 }, { 211, "???", 0, 0, 0, 0, 0 }, { 212, "???", 0, 0, 0, 0, 0 }, { 213, "???", 0, 0, 0, 0, 0 }, { 214, "???", 0, 0, 0, 0, 0 }, { 215, "???", 0, 0, 0, 0, 0 }, { 216, "???", 0, 0, 0, 0, 0 }, { 217, "???", 0, 0, 0, 0, 0 }, { 218, "???", 0, 0, 0, 0, 0 }, { 219, "???", 0, 0, 0, 0, 0 }, { 220, "???", 0, 0, 0, 0, 0 }, { 221, "???", 0, 0, 0, 0, 0 }, { 222, "???", 0, 0, 0, 0, 0 }, { 223, "???", 0, 0, 0, 0, 0 }, { 224, "???", 0, 0, 0, 0, 0 }, { 225, "???", 0, 0, 0, 0, 0 }, { 226, "???", 0, 0, 0, 0, 0 }, { 227, "???", 0, 0, 0, 0, 0 }, { 228, "???", 0, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ /* unused */ { 229, "???", 0, 0, 0, 0, 0 }, { 230, "???", 0, 0, 0, 0, 0 }, { 231, "???", 0, 0, 0, 0, 0 }, { 232, "???", 0, 0, 0, 0, 0 }, { 233, "???", 0, 0, 0, 0, 0 }, { 234, "???", 0, 0, 0, 0, 0 }, { 235, "???", 0, 0, 0, 0, 0 }, { 236, "???", 0, 0, 0, 0, 0 }, { 237, "???", 0, 0, 0, 0, 0 }, { 238, "???", 0, 0, 0, 0, 0 }, { 239, "???", 0, 0, 0, 0, 0 }, { 240, "???", 0, 0, 0, 0, 0 }, { 241, "???", 0, 0, 0, 0, 0 }, { 242, "???", 0, 0, 0, 0, 0 }, { 243, "???", 0, 0, 0, 0, 0 }, { 244, "???", 0, 0, 0, 0, 0 }, { 245, "???", 0, 0, 0, 0, 0 }, { 246, "???", 0, 0, 0, 0, 0 }, { 247, "???", 0, 0, 0, 0, 0 }, { 248, "???", 0, 0, 0, 0, 0 }, { 249, "???", 0, 0, 0, 0, 0 }, { 250, "???", 0, 0, 0, 0, 0 }, { 251, "???", 0, 0, 0, 0, 0 }, { 252, "???", 0, 0, 0, 0, 0 }, { 253, "???", 0, 0, 0, 0, 0 }, /* *** ************** ** ** ** ** ** */ /* reserved opcodes: impdep1 impdep1 */ { 254, "???", 0, 0, 0, 0, 0 }, { 255, "???", 0, 0, 0, 0, 0 } } ; /* ******************************************************** *** PRIVATE FUNCTIONS *** ******************************************************** */ /* **************************************** *** Processing of Method Descriptors *** **************************************** */ static u2_int res_width(u1_int *s) { u2_int p = 1u; u2_int r = 1u; if ((! s) || (s[0] != '(')) javab_out(-1, "invalid method descriptor"); while (s[p++] != ')') ; if (s[p] == 'V') r = 0u; else if ((s[p] == 'D') || (s[p] == 'J')) r = 2u; return r; } static u2_int arg_width(u1_int *s, u1_int set) { u2_int p = 1u, i; u2_int r = (set == 2u) ? 1u : 0u; u2_int b = 0u; if ((! s) || (s[0] != '(')) javab_out(-1, "invalid method descriptor"); while (s[p] != ')') { u2_int oldp = p; if (set) rd_sig[r] = rd_buf + b; r++; switch (s[p]) { case 'D': case 'J': /* additional word */ if (set) rd_sig[r] = NULL; r++; p++; break; case 'L': while (s[p++] != ';'); /* skip */ break; case '[': while (s[++p] == '['); /* skip [[[[[ */ if (s[p++] == 'L') while (s[p++] != ';'); /* skip */ break; case 'B': case 'C': case 'F': case 'I': case 'S': case 'Z': p++; break; default: javab_out(0, "invalid character %c (=%i) in method descriptor", s[p], s[p]); return r; } if (set) { for (i = oldp; i < p; i++) rd_buf[b++] = s[i]; rd_buf[b++] = '\0'; } } return r; } /* ******************************************************** *** Computation of ByteContext Sensitive Information *** *** (next is (mis-)used as an error flag) *** ******************************************************** */ static u2_int det_ops(u4_int i) { u4_int j, lf, lb; switch (byt[i]) { case 170u: /* tableswitch */ glo_pad = (u2_int) (3u - (i % 4u)); /* zero padding */ for (j = i+1u; j <= glo_pad; j++) if (byt[j]) { next = 1; javab_out(0, "invalid padding in 'tableswitch' at %u", j); } glo_def = B2S4(byt[i+glo_pad+1], byt[i+glo_pad+2], byt[i+glo_pad+3], byt[i+glo_pad+4]); glo_low = B2S4(byt[i+glo_pad+5], byt[i+glo_pad+6], byt[i+glo_pad+7], byt[i+glo_pad+8]); glo_hig = B2S4(byt[i+glo_pad+9], byt[i+glo_pad+10], byt[i+glo_pad+11],byt[i+glo_pad+12]); /* Check Validity of all targets */ if (((u4_int) (i+glo_def)) >= len) { next = 1; javab_out(0, "invalid default target in 'tableswitch' at %u", i); } lf = i+glo_pad+13u; lb = glo_hig-glo_low+1u; for (j = 0u; j < lb; j++, lf += 4u) { s4_int loc_off = B2S4(byt[lf],byt[lf+1],byt[lf+2],byt[lf+3]); if (((u4_int) (i+loc_off)) >= len) { next = 1u; javab_out(0, "invalid target in '%s' at %u", mem, i); } } /* Return number of operands (in bytes) */ return ((u2_int) (glo_pad+16u+(glo_hig-glo_low)*4u)); case 171u: /* lookupswitch */ glo_pad = (u2_int) (3u - (i % 4u)); /* zero padding */ for (j = i+1u; j <= glo_pad; j++) if (byt[j]) { next = 1u; javab_out(0, "invalid padding in 'lookupswitch' at %u", j); } glo_def = B2S4(byt[i+glo_pad+1],byt[i+glo_pad+2], byt[i+glo_pad+3],byt[i+glo_pad+4]); glo_npa = B2S4(byt[i+glo_pad+5],byt[i+glo_pad+6], byt[i+glo_pad+7],byt[i+glo_pad+8]); /* Check Validity of all targets */ if (((u4_int) (i + glo_def)) >= len) { next = 1u; javab_out(0, "invalid default target in '%s' at %u", mem, i); } lf = i+glo_pad+9u; lb = glo_npa; for (j = 0u; j < lb; j++, lf += 8u) { s4_int loc_off = B2S4(byt[lf+4],byt[lf+5],byt[lf+6],byt[lf+7]); if (((u4_int) (i+loc_off)) >= len) { next = 1; javab_out(0, "invalid target in '%s' at %u", mem, i); } } /* Return number of operands (in bytes) */ return ((u2_int) (glo_pad+8u+glo_npa*8u)); default: javab_out(-1, "error in det_ops %u at %u", byt[i], i); } return 0u; /* dummy return */ } static u2_int det_pre(u4_int i) { u2_int entry = B2U2(byt[i+1],byt[i+2]); u2_int n, d; u1_int *s; switch(byt[i]) { case 181u: /* putfield */ GET_IT(CONSTANT_Fieldref, mem) return (u2_int) ((s[0] == 'D') || (s[0] == 'J')) ? 3u : 2u; case 179u: /* putstatic */ GET_IT(CONSTANT_Fieldref, mem) return (u2_int) ((s[0] == 'D') || (s[0] == 'J')) ? 2u : 1u; case 185u: /* invokeinterface */ GET_IT(CONSTANT_InterfaceMethodref, mem) if (byt[i+3u] != (1u+arg_width(s, 0u))) javab_out(0, "nargs differs from method descriptor at %u", i); return (u2_int) (byt[i+3u]); case 183u: /* invokespecial */ case 182u: /* invokevirtual */ GET_IT(CONSTANT_Methodref, mem) return (u2_int) (1u+arg_width(s, 0u)); case 184u: /* invokestatic */ GET_IT(CONSTANT_Methodref, mem) return arg_width(s, 0u); case 197u: /* multianewarray */ valid_cp_entry(CONSTANT_Class, entry, "multianewarray"); return (u2_int) (byt[i+3]); default: javab_out(-1, "error in det_pre %u at %u", byt[i], i); } return 0u; } static u2_int det_pos(u4_int i) { u2_int entry = B2U2(byt[i+1],byt[i+2]); u2_int n, d; u1_int *s; switch(byt[i]) { case 180u: /* getfield */ case 178u: /* getstatic */ GET_IT(CONSTANT_Fieldref, mem) return (u2_int) ((s[0] == 'D') || (s[0] == 'J')) ? 2u : 1u; case 185u: /* invokeinterface */ GET_IT(CONSTANT_InterfaceMethodref, mem) return (res_width(s)); case 183u: /* invokespecial */ case 184u: /* invokestatic */ case 182u: /* invokevirtual */ GET_IT(CONSTANT_Methodref, mem); return (res_width(s)); default: javab_out(-1, "error in det_pos %u at %u", byt[i], i); } return 0u; } /* ********************************** *** General bytecode traversal *** ********************************** */ static void byte_trav(u4_int offset) { u4_int i; /* wide counter */ u2_int ops = 0u; u2_int last_op = -1, prev_op = -1; int last_offset = 0, prev_offset = 0; int branch_label, idx, inst_size; char lbuf[100]; int hash(char *); void type_insert(HASHNODE **, int, char *); len = att -> code_length; byt = &(att -> info[8u]); for (i = offset; i < len; i += (1u+ops)) { /* Determine opcode Information */ is_wide = 0u; back: opc = byt[i]; bra = bytecode[opc].branch; ops = bytecode[opc].operands; exc = bytecode[opc].exception; pre = bytecode[opc].stack_pre; pos = bytecode[opc].stack_post; mem = bytecode[opc].mnemonic; /* instruction 'wide'-handling *************************** */ if (is_wide) { if (opc == 132u) /* wide + iinc */ ops = 4u; else if ((21u <= opc) && (opc <= 25u)) /* wide + load */ ops = 2u; else if ((54u <= opc) && (opc <= 58u)) /* wide + store */ ops = 2u; else if (opc == 169u) /* wide + ret */ ops = 2u; else { javab_out(0, "invalid operand '%s' of 'wide' at %u", mem, i); return; } } if (HAS_TARGET(bra)) { /* Compute target from 2-, or 4-byte offset **************************************** */ s4_int off = ((opc == 200u) || (opc == 201u)) ? B2S4(byt[i+1],byt[i+2],byt[i+3],byt[i+4]) /* 4-bytes */ : B2S2(byt[i+1],byt[i+2]); /* 2-bytes */ target = (u4_int) (i + off); if ((target >= len) && (att -> reachable[i] == 1u)) { javab_out(0, "invalid target %u in '%s' at %u", target, mem, i); return; } } /* Determine Context Sensitive Information *************************************** */ glo_pad = 0u; glo_def = glo_npa = glo_low = glo_hig = 0u; next = 0u; /* (mis-)uses as error flag */ if (ops == 9u) ops = det_ops(i); if (pre == 9u) pre = det_pre(i); if (pos == 9u) pos = det_pos(i); if(!is_wide) { if( ((last_op == 18u) || (last_op == 19u)) && (((prev_op >= 3u) && (prev_op <= 8u)) || (prev_op == 16u) || (prev_op == 17u) || (prev_op == 18u) || (prev_op == 19u)) && (opc == 184u)) { u2_int e = B2U2(byt[i+1u], byt[i+2u]); u2_int c1 = constant_pool[e] -> u.indices.index1; u2_int n = constant_pool[e] -> u.indices.index2; u2_int d = constant_pool[n] -> u.indices.index1; u2_int c2 = constant_pool[c1] -> u.indices.index1; char *cla = (char *) constant_pool[c2] -> u.utf8.s; char *met = (char *) constant_pool[d] -> u.utf8.s; char *op; u2_int C1; char *caller = NULL; if(last_op == 18u) { u1_int ee = byt[last_offset+1u]; C1 = constant_pool[ee] -> u.indices.index1; inst_size = 2; } else if(last_op == 19u) { u2_int ee = ((byt[last_offset+1u]) << 8) | byt[last_offset + 2u]; C1 = constant_pool[ee] -> u.indices.index1; inst_size = 3; } else { fprintf(stderr,"internal error\n"); exit(-1); } if(( !strcmp(cla,"Dummy") || !strcmp(cla,"org/netlib/util/Dummy")) && !strcmp(met,"label")) op = "label"; else if(( !strcmp(cla,"Dummy") || !strcmp(cla,"org/netlib/util/Dummy")) && !strcmp(met,"go_to")) op = "goto"; else { if(trdebug) printf("%s: encountered unknown Dummy method! (%s.%s)\n", filename, cla,met); op = "unknown"; } switch(prev_op) { case 3u: /* iconst_0 */ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,0); branch_label = 0; inst_size += 1; break; case 4u: /* iconst_1 */ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,1); branch_label = 1; inst_size += 1; break; case 5u: /* iconst_2 */ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,2); branch_label = 2; inst_size += 1; break; case 6u: /* iconst_3 */ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,3); branch_label = 3; inst_size += 1; break; case 7u: /* iconst_4 */ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,4); branch_label = 4; inst_size += 1; break; case 8u: /* iconst_5 */ if(trdebug) printf("%d: %s %d.\n",prev_offset, op,5); branch_label = 5; inst_size += 1; break; case 16u: /* bipush */ if(trdebug) printf("%d: %s %d\n", prev_offset, op, byt[prev_offset+1u]); branch_label = byt[prev_offset+1u]; inst_size += 2; break; case 17u: /* sipush */ if(trdebug) printf("%d: %s %d\n", prev_offset, op, B2U4(0,0,byt[prev_offset+1u],byt[prev_offset+2u])); branch_label = B2U4(0,0,byt[prev_offset+1u],byt[prev_offset+2u]); inst_size += 3; break; case 18u: /* ldc */ if(trdebug) printf("%d: %s %d\n", prev_offset, op, constant_pool[byt[prev_offset+1u]] -> u.data.val1); branch_label = constant_pool[byt[prev_offset+1u]] -> u.data.val1; inst_size += 2; break; case 19u: /* ldc_w */ { u2_int po = ((byt[prev_offset+1u]) << 8) | byt[prev_offset + 2u]; if(trdebug) printf("%d: %s %d\n", prev_offset, op, constant_pool[po] -> u.data.val1); branch_label = constant_pool[po] -> u.data.val1; inst_size += 3; } break; default: fprintf(stderr,"%s:Bad opcode encountered, output may be incorrect.\n", filename); branch_label = 0; } sprintf(lbuf,"%d",branch_label); if(!strcmp(op,"label")) { caller = (char *) constant_pool[C1]->u.utf8.s; if(type_lookup(att->label_table,lbuf)) fprintf(stderr,"%s: duplicate label: %s\n", filename,lbuf); else if(strcmp(caller, thisClassName)) fprintf(stderr,"%s: invalid label: %s (caller = %s, this = %s)\n", filename,lbuf,caller,thisClassName); else { idx = hash(lbuf) % att->label_table->num_entries; type_insert(&(att->label_table->entry[idx]), prev_offset, strdup(lbuf)); } memset(byt+last_offset, 0, inst_size + 3); numChanges++; } else if(!strcmp(op,"goto")) { HASHNODE *ht; if(trdebug) printf("ok, I'm looking at a goto branching to label %d\n", branch_label); caller = (char *) constant_pool[C1]->u.utf8.s; if(!strcmp(caller,thisClassName)) { if((ht=type_lookup(att->label_table,lbuf)) != NULL) { int temp = ht->val - i; u4_int utemp; if(trdebug) printf("Found the label! offset = %d\n", ht->val); /* zero out the 2 previous instructions. the first 'ldc' is always 2 bytes, so add that to the size of the previous instruction. */ memset(byt+last_offset, 0, inst_size); numChanges++; /* use the goto_w opcode just to be sure we have enough space for the branchoffset */ byt[i-2] = 200; if(trdebug) printf("copying %d (%x) into byt\n",temp,temp); utemp = u4BigEndian((u4_int)temp); memcpy(byt+i-1, &utemp, 4); } else { if(trdebug) printf("did NOT find the label!\n"); } } else { fprintf(stderr,"%s: invalid goto: %s (caller = %s, this = %s)\n", filename,lbuf,caller,thisClassName); memset(byt+last_offset, 0, inst_size + 3); numChanges++; } } else if(!strcmp(op,"unknown")) { if(trdebug) fprintf(stderr,"%s:Skipping unknown method invocation at offset %d\n", filename, i); } else fprintf(stderr,"%s:Weird, op not set properly.\n",filename); } last_op = prev_op; last_offset = prev_offset; prev_op = opc; prev_offset = i; } if (next) return; /* Compute Address of next Opcode ****************************** */ next = (u4_int) (i+ops+1u); if (next > len) { javab_out(0, "invalid implicit target %u in '%s' at %u", next, mem, i); return; } /* instruction 'wide'-handling *************************** */ if (opc == 196u) { if (i+1 < len) { i++; is_wide = 1; goto back; } else { javab_out(0, "invalid occurrence of '%s' at %u", mem, i); return; } } } } /* ******************************************************* *** The actual actions (PRIVATE TRAVERSAL ROUTINES) *** ******************************************************** */ /* ******************************************************* *** Process a Single Code Attributes in .class file *** ******************************************************* */ static void byte_codeattr(attribute_ptr a, u2_int w_arg, u1_int *nm, u1_int *tp, u2_int w_res) { u1_int comp_stuff(u4_int); u4_int i; /* wide_counter */ u1_int *bytes = a -> info; u2_int max_stack = B2U2(bytes[0],bytes[1]); u2_int max_locals = B2U2(bytes[2],bytes[3]); u4_int code_length = B2U4(bytes[4],bytes[5],bytes[6],bytes[7]); u2_int exc_table_l; a->label_table = new_symtable(211); if (a -> attribute_length < 12u + code_length) { javab_out(0, "corrupt code atttribute given for %s%s code_length = %u", nm, tp, code_length); return; } exc_table_l = B2U2(bytes[8+code_length],bytes[9+code_length]); if (code_length + 10u + exc_table_l * 8u >= a -> attribute_length) { javab_out(0, "corrupt exception handler table"); return; } /* Set global attribute (for all subsequent processing!) ***************************************************** */ att = a; /* Quit for empty method body (or for large codelength) or in case too many parameters are passed to method **************************************************** */ if (code_length == 0u) { javab_out(2, " + empty method %s()", nm); return; } else if (code_length >= (U4MAX-1)) { javab_out(2, " + skipping method %s() (cannot be processed internally)", nm); return; } else if (w_arg > max_locals) { javab_out(0, "%u parameter words exceed %u local words of method %s()", w_arg, max_locals, nm); return; } /* Allocate Memory for BYTECODE Information **************************************** */ a -> code_length = code_length; a -> is_leader = (u1_int *) make_mem((code_length+1) * sizeof(u1_int)); a -> my_bb = (bb_ptr *) make_mem((code_length+1) * sizeof(bb_ptr)); a -> reachable = (u1_int *) make_mem(code_length * sizeof(u1_int)); a -> sp_before = (u2_int *) make_mem(code_length * sizeof(u2_int)); a -> st_state = (state_ptr **) make_mem(code_length * sizeof(state_ptr *)); for (i = 0u; i <= code_length; i++) { a -> is_leader[i] = 0u; a -> my_bb[i] = NULL; } for (i = 0u; i < code_length; i++) { a -> reachable[i] = 2u; a -> sp_before[i] = 0u; a -> st_state[i] = NULL; } /* Compute Stack Information: traverse entry point of method (with sp==0 on entry) *and* entry point of every handler (with sp==1 on entry) ******************************************************** */ glo_sta = max_stack; glo_stm = 0u; glo_loc = max_locals; /* Empty Stack */ cur_sp = 0u; byte_trav(0u); byte_trav(0u); } /* ******************************************************** *** PUBLIC FUNCTIONS *** ******************************************************** */ /* *************************** *** Bytecode Processing *** *************************** */ int byte_proc(void) { u4_int i, j; /* wide counters */ char *strtok(char *, const char *); extern char * thisClassName; numChanges = 0; thisClassName = strdup( (char *) constant_pool[constant_pool[this_class]->u.indices.index1]->u.utf8.s); #ifdef CHECK_TABLE /* Verify bytecode table */ for (i = 0u; i < 256u; i++) if (bytecode[i].opcode != i) javab_out(-1, "invalid bytecode initialization at %u", i); #endif /* Scan over methods, and process code-attributes */ for (i = 0u; i < methods_count; i++) { fm_ptr m = methods[i]; u1_int *nm = constant_pool[m -> name_index] -> u.utf8.s; u1_int *tp = constant_pool[m -> descr_index] -> u.utf8.s; u1_int is_inst = (m -> access_flags & ACC_STATIC) ? 0u : 1u; attribute_ptr my_code = NULL; attribute_ptr my_exc = NULL; char *this_arg_type = NULL; /* Determine number of locals that are defined (for Instance Methods: `this' is first-word argument) and number of words pushed back on the caller's operand stack */ u2_int w_arg = arg_width(tp, (is_inst) ? 2u : 1u); u2_int w_res = res_width(tp); if (is_inst) /* Determine type of `this': set to java.lang.Object */ { u2_int e = constant_pool[this_class] -> u.indices.index1; char *s = (char *) constant_pool[e] -> u.utf8.s; u2_int l = strlen(s); this_arg_type = (char *) make_mem((l+2u) * sizeof(char)); sprintf(this_arg_type, "L%s;", s); rd_sig[0u] = this_arg_type; } is_instm = is_inst; javab_out(2, " - processing %s method %s()", (is_inst) ? "instance" : "class", nm); /* Scan Attributes */ for (j = 0u; j < m -> attributes_count; j++) { attribute_ptr a = m -> attributes[j]; constant_ptr ua = constant_pool[a -> attribute_name_index]; if (strcmp((char *) ua -> u.utf8.s, "Code") == 0) { if (my_code) javab_out(0, "multiple code attributes given for %s()", nm); else my_code = a; } else if (strcmp((char *) ua -> u.utf8.s, "Exceptions") == 0) { if (my_exc) javab_out(0, "multiple exception attributes given for %s()", nm); else my_exc = a; } } /* Process Code Attribute */ if (my_code) { if (my_code -> attribute_length < 12u) javab_out(0, "corrupt code attribute given for %s()", nm); else byte_codeattr(my_code, w_arg, nm, tp, w_res); } else javab_out(2, " + no code attribute given for %s()", nm); if (this_arg_type) free(this_arg_type); if (error) break; /* otherwise, a list of method headers appears for switch `-d' */ } return numChanges; } u4_int u4BigEndian(u4_int num) { if(isBigEndian()) return num; else return ((num & 0xFF)<<24) + ((num >> 8 & 0xFF)<<16) + ((num >> 16 & 0xFF)<<8) + (num >> 24); } char isBigEndian() { int x = 1; if (*((char *)&x)== 1) return 0; else return 1; } f2j-0.8.1/goto_trans/class.c0000600000077700002310000005376411031241063015711 0ustar seymourgraduate /* ************* *** JAVAB *** **************************************************** *** Copyright (c) 1997 *** *** Aart J.C. Bik Indiana University *** *** All Rights Reserved *** **************************************************** *** Please refer to the LICENSE file distributed *** *** with this software for further details on *** *** the licensing terms and conditions. *** *** *** *** Please, report all bugs, comments, etc. *** *** to: ajcbik@extreme.indiana.edu *** **************************************************** *** class.c : class file manipulations *** *** *** Your courtesy in mentioning the use of this bytecode tool *** in any scientific work that presents results obtained *** by using (extensions or modifications of) the tool *** is highly appreciated. *** *** */ /* ******************************************************** *** INCLUDE FILES and DEFINITIONS *** ******************************************************** */ #include "class.h" #undef DEBUG_SHADOW /* ******************************************************** *** EXTERNAL VARIABLES *** ******************************************************** */ /* PUBLIC ****** */ u4_int magic; u2_int minor_version, major_version; u2_int constant_pool_count = 0u; constant_ptr *constant_pool = NULL; u2_int access_flags, this_class, super_class; u2_int interfaces_count = 0u; u2_int *interfaces = NULL; u2_int fields_count = 0u; fm_ptr *fields = NULL; u2_int methods_count = 0u; fm_ptr *methods = NULL; u2_int attributes_count = 0u; attribute_ptr *attributes = NULL; /* PRIVATE ******* */ static FILE *file = NULL; static u2_int extra_cp = 0u; static u2_int extra_field = 0u; static u2_int extra_method = 0u; static u2_int shadow_cnt = 0u; static constant_ptr *shadow_cp = NULL; /* ******************************************************** *** PRIVATE FUNCTIONS *** ******************************************************** */ /* read u1_int, u2_int, and u4_int routines **************************************** */ static u1_int read_u1(void) { int u = fgetc(file); if (u == EOF) javab_out(0, "unexpected EOF"); return (u1_int) u; } static u2_int read_u2(void) { u1_int u1 = read_u1(); u1_int u2 = read_u1(); return B2U2(u1,u2); } static u4_int read_u4(void) { u1_int u1 = read_u1(); u1_int u2 = read_u1(); u1_int u3 = read_u1(); u1_int u4 = read_u1(); return B2U4(u1,u2,u3,u4); } /* Read Constant Pool (entry constant_pool[0] is reserved, but included in count) *********************************************************** */ static void read_constant_pool(void) { u4_int i, j; /* wide counters */ constant_pool_count = read_u2(); constant_pool = NULL; if (constant_pool_count == 0u) return; /* Construct the constant pool */ constant_pool = (constant_ptr *) make_mem( constant_pool_count * sizeof(constant_ptr) ); constant_pool[0] = NULL; for (i = 1u; i < constant_pool_count; i++) { constant_pool[i] = (constant_ptr) make_mem( sizeof(struct constant_node) ); constant_pool[i] -> tag = read_u1(); switch(constant_pool[i] -> tag) { case CONSTANT_Class: case CONSTANT_String: constant_pool[i] -> u.indices.index1 = read_u2(); constant_pool[i] -> u.indices.index2 = 0u; break; case CONSTANT_Fieldref: case CONSTANT_Methodref: case CONSTANT_InterfaceMethodref: case CONSTANT_NameAndType: constant_pool[i] -> u.indices.index1 = read_u2(); constant_pool[i] -> u.indices.index2 = read_u2(); break; case CONSTANT_Integer: case CONSTANT_Float: constant_pool[i] -> u.data.val1 = read_u4(); constant_pool[i] -> u.data.val2 = 0u; break; case CONSTANT_Long: case CONSTANT_Double: constant_pool[i] -> u.data.val1 = read_u4(); constant_pool[i] -> u.data.val2 = read_u4(); /* These entries make next entry invalid! ************************************** */ constant_pool[ ++i ] = NULL; break; case CONSTANT_Utf8: /* Read-in constant string value (represented as BYTE sequence) */ { u2_int len = read_u2(); u1_int *s = (u1_int *) make_mem((1+len) * sizeof(u1_int)); for (j = 0u; j < len; j++) s[j] = read_u1(); s[len] = '\0'; constant_pool[i] -> u.utf8.l = len; constant_pool[i] -> u.utf8.s = s; } break; default: javab_out(-1, "invalid constant pool tag (%u)", constant_pool[i] -> tag); } } } /* Read Interfaces **************** */ static void read_interfaces(void) { u4_int i; /* wide counter */ interfaces_count = read_u2(); if (interfaces_count != 0u) { interfaces = (u2_int *) make_mem(interfaces_count * sizeof(u2_int)); for (i = 0u; i < interfaces_count; i++) interfaces[i] = read_u2(); } else interfaces = NULL; } /* Read Attributes *************** */ static attribute_ptr *read_attributes(u2_int ac) { attribute_ptr *a = NULL; if (ac != 0u) { u4_int i, j; /* wide counters */ u4_int len; a = (attribute_ptr *) make_mem(ac * sizeof(attribute_ptr)); for (i = 0u; i < ac; i++) { a[i] = (attribute_ptr) new_attribute(); a[i] -> attribute_name_index = read_u2(); a[i] -> attribute_length = len = read_u4(); if (len == U4MAX) javab_out(-1, "Sorry, my internal u4_int counter will wrap around"); a[i] -> info = (u1_int *) make_mem(len * sizeof(u1_int)); for (j = 0u; j < len; j++) a[i] -> info[j] = read_u1(); } } return a; } /* Read Fields *********** */ static void read_fields(void) { u4_int i; /* wide counter */ fields_count = read_u2(); if (fields_count != 0u) { fields = (fm_ptr *) make_mem(fields_count * sizeof(fm_ptr)); for (i = 0u; i < fields_count; i++) { fields[i] = (fm_ptr) make_mem(sizeof(struct fm_node)); fields[i] -> access_flags = read_u2(); fields[i] -> name_index = read_u2(); fields[i] -> descr_index = read_u2(); fields[i] -> attributes_count = read_u2(); fields[i] -> attributes = read_attributes(fields[i] -> attributes_count); } } else fields = NULL; } /* Read Methods ************ */ static void read_methods(void) { u4_int i; /* wide counter */ methods_count = read_u2(); if (methods_count != 0u) { methods = (fm_ptr *) make_mem(methods_count * sizeof(fm_ptr)); for (i = 0u; i < methods_count; i++) { methods[i] = (fm_ptr) make_mem(sizeof(struct fm_node)); methods[i] -> access_flags = read_u2(); methods[i] -> name_index = read_u2(); methods[i] -> descr_index = read_u2(); methods[i] -> attributes_count = read_u2(); methods[i] -> attributes = read_attributes(methods[i] -> attributes_count); } } else methods = NULL; } /* Read Class-File *************** */ static void read_classfile(void) { javab_out(2, " -- reading class file"); /* Read magic 0xCAFEBABE string and version **************************************** */ magic = read_u4(); if (magic != 0xCAFEBABE) { javab_out(0, "not a class file"); return; } minor_version = read_u2(); major_version = read_u2(); /* Read constant pool ****************** */ read_constant_pool(); /* Read flags and class info ************************* */ access_flags = read_u2(); this_class = read_u2(); super_class = read_u2(); /* Read interfaces, fields, and methods ************************************ */ read_interfaces(); read_fields(); read_methods(); /* Read attributes *************** */ attributes_count = read_u2(); attributes = read_attributes(attributes_count); if (fgetc(file) != EOF) javab_out(1, "additional bytes in class file ignored"); } /* Check Attribute *************** */ static void check_attr(u4_int ac, attribute_ptr *a) { u4_int i; /* wide counter */ for (i = 0; i < ac; i++) valid_cp_entry(CONSTANT_Utf8, a[i] -> attribute_name_index, "attribute"); } /* Check Field/Method ****************** */ static void check_fm(fm_ptr f) { valid_cp_entry(CONSTANT_Utf8, f -> name_index, "fm name index"); valid_cp_entry(CONSTANT_Utf8, f -> descr_index, "fm descriptor index"); check_attr(f -> attributes_count, f -> attributes); } /* Check Class File **************** */ static void check_classfile(void) { u4_int i; /* wide counter */ javab_out(2, " -- verifying class file"); /* Check class references */ valid_cp_entry(CONSTANT_Class, this_class, "this"); if (super_class) valid_cp_entry(CONSTANT_Class, super_class, "super"); /* Check constant pool */ for (i = 1u; i < constant_pool_count; i++) if (constant_pool[i]) switch (constant_pool[i] -> tag) { case CONSTANT_Class: valid_cp_entry(CONSTANT_Utf8, constant_pool[i] -> u.indices.index1, "Class"); break; case CONSTANT_Fieldref: case CONSTANT_Methodref: case CONSTANT_InterfaceMethodref: valid_cp_entry(CONSTANT_Class, constant_pool[i] -> u.indices.index1, "ref"); valid_cp_entry(CONSTANT_NameAndType, constant_pool[i] -> u.indices.index2, "ref"); break; case CONSTANT_String: valid_cp_entry(CONSTANT_Utf8, constant_pool[i] -> u.indices.index1, "String"); break; case CONSTANT_NameAndType: valid_cp_entry(CONSTANT_Utf8, constant_pool[i] -> u.indices.index1, "N_and_T"); valid_cp_entry(CONSTANT_Utf8, constant_pool[i] -> u.indices.index2, "N_and_T"); { constant_ptr c = constant_pool[constant_pool[i] -> u.indices.index2]; if (c -> u.utf8.l == 0) javab_out(0, "invalid field/method descriptor"); } break; } /* Check interfaces */ for (i = 0u; i < interfaces_count; i++) valid_cp_entry(CONSTANT_Class, interfaces[i], "interface"); /* Check Fields */ for (i = 0u; i < fields_count; i++) check_fm(fields[i]); /* Check Methods */ for (i = 0u; i < methods_count; i++) check_fm(methods[i]); /* Check Attributes */ check_attr(attributes_count, attributes); } /* Release Memory Fields of an Attribute ************************************* */ static void cleanup_attributes(u4_int cnt, attribute_ptr *a) { u4_int i, j; /* wide counters */ for (i = 0u; i < cnt; i++) if (a[i]) { if (a[i] -> info) free(a[i] -> info); if (a[i] -> reachable) free(a[i] -> reachable); if (a[i] -> is_leader) free(a[i] -> is_leader); if (a[i] -> sp_before) free(a[i] -> sp_before); if (a[i] -> my_bb) free(a[i] -> my_bb); if (a[i] -> st_state) { for (j = 0u; j < a[i] -> code_length; j++) if (a[i] -> st_state[j]) free(a[i] -> st_state[j]); free(a[i] -> st_state); } free(a[i]); } if (a) free(a); } /* Release Memory of a Constant Pool Entry *************************************** */ static void del_cp(constant_ptr c) { if (c) { if ((c -> tag == CONSTANT_Utf8) && (c -> u.utf8.s)) free(c -> u.utf8.s); free(c); } } /* Release Memory of Class File **************************** */ static void delete_classfile(void) { u4_int i; /* wide counters */ javab_out(2, " -- deleting class file"); /* Delete Constant Pool ******************** */ for (i = 1u; i < constant_pool_count; i++) if (constant_pool[i]) del_cp(constant_pool[i]); if (constant_pool) free(constant_pool); constant_pool_count = 0u; constant_pool = NULL; /* Delete Interfaces ***************** */ if (interfaces) free(interfaces); interfaces = NULL; /* Delete Fields ************* */ if (fields) { for (i = 0u; i < fields_count; i++) if (fields[i]) { cleanup_attributes(fields[i] -> attributes_count, fields[i] -> attributes); free(fields[i]); } free(fields); } fields_count = 0u; fields = NULL; /* Delete Methods ************** */ if (methods) { for (i = 0u; i < methods_count; i++) if (methods[i]) { cleanup_attributes(methods[i] -> attributes_count, methods[i] -> attributes); free(methods[i]); } free(methods); } methods_count = 0u; methods = NULL; /* Delete Attributes **************** */ cleanup_attributes(attributes_count, attributes); attributes_count = 0u; attributes = NULL; /* Delete Additional Space *********************** */ extra_cp = 0u; extra_field = 0u; extra_method = 0u; } /* Show a Field/Method ******************* */ static void show_fm(u4_int i, fm_ptr f, char *s) { u1_int *nm = constant_pool[f -> name_index] -> u.utf8.s; u1_int *tp = constant_pool[f -> descr_index] -> u.utf8.s; fprintf(stderr, " %s[%5u]: 0x%02x %s %s (attr=%u)\n", s, i, f -> access_flags, nm, tp, f -> attributes_count); } /* Output of Class File Summary **************************** */ static void show_classfile(void) { u4_int i; /* wide counter */ fprintf(stderr, "\n*** class file version : %u.%u\n", major_version, minor_version); fprintf(stderr, "*** constant_pool_count : %u\n", constant_pool_count); for (i = 1u; i < constant_pool_count; i++) if (constant_pool[i]) { fprintf(stderr, " constant_pool[%5u]: ", i); show_cp_entry(constant_pool[i]); fputc('\n', stderr); } fprintf(stderr, "*** access flags : 0x%04x\n", access_flags); fprintf(stderr, "*** this_class : %u\n", this_class); fprintf(stderr, "*** super_class : %u\n", super_class); fprintf(stderr, "*** interfaces_count : %u\n", interfaces_count); for (i = 0u; i < interfaces_count; i++) { u2_int i2 = interfaces[i]; u1_int *s = constant_pool[constant_pool[i2] -> u.indices.index1] -> u.utf8.s; fprintf(stderr, " interfaces [%5u]: %u \"%s\"\n", i, i2, s); } fprintf(stderr, "*** fields_count : %u\n", fields_count); for (i = 0u; i < fields_count; i++) show_fm(i, fields[i], "fields "); fprintf(stderr, "*** methods_count : %u\n", methods_count); for (i = 0u; i < methods_count; i++) show_fm(i, methods[i], "methods "); fprintf(stderr, "*** attributes_count : %u\n", attributes_count); } /* *********************************** *** Restore Parts of the Old CP *** *********************************** */ static void add_shadow_cp(void) { u4_int i; /* wide counter */ constant_pool_count = shadow_cnt; constant_pool = (constant_ptr *) make_mem(constant_pool_count * sizeof(constant_ptr)); /* First Pass ********** */ for (i = 0u; i < shadow_cnt; i++) { constant_ptr old = shadow_cp[i]; constant_ptr new = (constant_ptr) make_mem( sizeof(struct constant_node) ); if (old) { #ifdef DEBUG_SHADOW fprintf(stderr, "copy old entry %u\n", i); #endif new -> tag = old -> tag; switch (old -> tag) { case CONSTANT_Class: case CONSTANT_Fieldref: case CONSTANT_Methodref: case CONSTANT_InterfaceMethodref: case CONSTANT_NameAndType: case CONSTANT_String: new -> u.indices.index1 = old -> u.indices.index1; new -> u.indices.index2 = old -> u.indices.index2; break; case CONSTANT_Integer: case CONSTANT_Float: case CONSTANT_Long: case CONSTANT_Double: new -> u.data.val1 = old -> u.data.val1; new -> u.data.val2 = old -> u.data.val2; break; case CONSTANT_Utf8: new -> u.utf8.l = old -> u.utf8.l; new -> u.utf8.s = (u1_int *) strdup((char *) old -> u.utf8.s); break; default: javab_out(-1, "invalid new shadow cp entry %u\n", old -> tag); } constant_pool[i] = new; if ((old -> tag == CONSTANT_Double) || (old -> tag == CONSTANT_Long)) i++; /* Account for NULL CP Entry */ } else { /* Obsoleted Entry */ new -> tag = CONSTANT_Utf8; new -> u.utf8.l = 1u; new -> u.utf8.s = (u1_int *) strdup("-"); constant_pool[i] = new; } } } /* ******************************************************** *** PUBLIC FUNCTIONS *** ******************************************************** */ /* Shadow Constant Pool Operations ******************************* */ void make_shadow_cp(void) { u4_int i; /* wide counter */ if ((shadow_cnt) || (shadow_cp)) javab_out(-1, "re-shadowing not allowed"); shadow_cnt = constant_pool_count; shadow_cp = (constant_ptr *) make_mem(shadow_cnt * sizeof(constant_ptr)); for (i = 0u; i < shadow_cnt; i++) shadow_cp[i] = NULL; } void mark_shadow_cp(u2_int index) { if (index < shadow_cnt) { if (! shadow_cp[index]) { constant_ptr c = constant_pool[index]; shadow_cp[index] = c; #ifdef DEBUG_SHADOW fprintf(stderr, "mark cp entry %u\n", index); #endif switch(c -> tag) { case CONSTANT_Class: case CONSTANT_String: mark_shadow_cp(c -> u.indices.index1); break; case CONSTANT_Fieldref: case CONSTANT_Methodref: case CONSTANT_InterfaceMethodref: case CONSTANT_NameAndType: mark_shadow_cp(c -> u.indices.index1); mark_shadow_cp(c -> u.indices.index2); break; case CONSTANT_Integer: case CONSTANT_Float: case CONSTANT_Long: case CONSTANT_Double: case CONSTANT_Utf8: break; default: javab_out(-1, "invalid new shadow cp entry %u\n", c -> tag); } } } else javab_out(-1, "invalid index into shadow cp %u", index); } void take_shadow_cp(void) { u4_int i; /* wide counter */ for (i = 0u; i < shadow_cnt; i++) if (shadow_cp[i]) { constant_pool[i] = NULL; #ifdef DEBUG_SHADOW fprintf(stderr, "take cp entry %u\n", i); #endif } } void dump_shadow_cp(void) { u1_int set = 0u; u4_int i; /* wide counter */ for (i = 0u; i < shadow_cnt; i++) if (shadow_cp[i]) { set = 1u; break; } if (set) add_shadow_cp(); else constant_pool_count = 1u; /* reserved entry */ } void elim_shadow_cp(void) { u4_int i; /* wide counter */ if (shadow_cp) { for (i = 0u; i < shadow_cnt; i++) if (shadow_cp[i]) { #ifdef DEBUG_SHADOW fprintf(stderr, "postponed deletion of cp entry %u\n", i); #endif del_cp(shadow_cp[i]); } free(shadow_cp); } shadow_cnt = 0u; shadow_cp = NULL; } /* Class File Processing ********************* */ void process_classfile(FILE *f, u1_int com) { file = f; switch (com) { case 0u: /* Process a Class File */ if (f) read_classfile(); break; case 1u: /* Check a Class File */ check_classfile(); break; case 2u: /* Show a Class File */ show_classfile(); break; case 3u: /* Delete a Class File */ delete_classfile(); break; } } /* Check constant pool entry ************************* */ u1_int valid_cp_entry(u1_int tag, u2_int entry, char *mess) { if ((entry != 0u) && (entry < constant_pool_count)) { constant_ptr p = constant_pool[entry]; if ((! p) || (p -> tag != tag)) { javab_out(0, "invalid reference of %s to constant pool (%u)", mess, entry); return 0; } } else { javab_out(0, "invalid index of %s into constant pool (%u)", mess, entry); return 0; } return 1u; } /* Output information in class file ******************************** */ void show_cp_entry(constant_ptr c) { switch (c -> tag) { case CONSTANT_Class: fprintf(stderr, " "); show_cp_entry(constant_pool[c -> u.indices.index1]); break; case CONSTANT_Fieldref: show_cp_entry(constant_pool[c -> u.indices.index1]); fputc('.', stderr); show_cp_entry(constant_pool[c -> u.indices.index2]); break; case CONSTANT_Methodref: show_cp_entry(constant_pool[c -> u.indices.index1]); fputc('.', stderr); show_cp_entry(constant_pool[c -> u.indices.index2]); break; case CONSTANT_InterfaceMethodref: show_cp_entry(constant_pool[c -> u.indices.index1]); fputc('.', stderr); show_cp_entry(constant_pool[c -> u.indices.index2]); break; case CONSTANT_String: fputc('\"', stderr); show_cp_entry(constant_pool[c -> u.indices.index1]); fputc('\"', stderr); break; case CONSTANT_Integer: fprintf(stderr, " %ix", (s4_int) c -> u.data.val1); break; case CONSTANT_Float: fprintf(stderr, " 0x%04x", c -> u.data.val1); break; case CONSTANT_Long: fprintf(stderr, " 0x%04x%04x", c -> u.data.val1, c -> u.data.val2); break; case CONSTANT_Double: fprintf(stderr, " 0x%04x%04x", c -> u.data.val1, c -> u.data.val2); break; case CONSTANT_NameAndType: show_cp_entry(constant_pool[c -> u.indices.index1]); fputc(' ', stderr); show_cp_entry(constant_pool[c -> u.indices.index2]); break; case CONSTANT_Utf8: if (c -> u.utf8.s) fprintf(stderr, (char *) c -> u.utf8.s); break; } } /* Obtain a new attribute ********************** */ attribute_ptr new_attribute(void) { attribute_ptr a = (attribute_ptr) make_mem(sizeof(struct attribute_node)); a -> attribute_name_index = 0u; a -> attribute_length = 0u; a -> info = NULL; /* JAVAB Specific Information */ a -> reachable = NULL; a -> is_leader = NULL; a -> sp_before = NULL; a -> my_bb = NULL; a -> st_state = NULL; return a; } f2j-0.8.1/goto_trans/class.h0000600000077700002310000002720111031241063015701 0ustar seymourgraduate/* ************* *** JAVAB *** **************************************************** *** Copyright (c) 1997 *** *** Aart J.C. Bik Indiana University *** *** All Rights Reserved *** **************************************************** *** Please refer to the LICENSE file distributed *** *** with this software for further details on *** *** the licensing terms and conditions. *** *** *** *** Please, report all bugs, comments, etc. *** *** to: ajcbik@extreme.indiana.edu *** **************************************************** *** class.h : definitions and function prototypes *** *** *** Your courtesy in mentioning the use of this bytecode tool *** in any scientific work that presents results obtained *** by using (extensions or modifications of) the tool *** is highly appreciated. *** *** *** */ #include #include #include #include #include "symtab.h" #define MAX(a,b) (((a)>=(b)) ? (a) : (b)) #define MIN(a,b) (((a)<=(b)) ? (a) : (b)) /* ************************************* *** JVM-specific Type Definitions *** ************************************* *** u1_int == unsigned 8 bits *** *** s1_int == signed 8 bits *** ************************************* *** u2_int == unsigned 16 bits *** *** s2_int == signed 16 bits *** ************************************* *** u4_int == unsigned 32 bits *** *** s4_int == signed 32 bits *** ************************************* */ #define U1MAX 255u #define U2MAX 65535u #define U4MAX 4294967295u #define S4MAX 2147483647 #if ((CHAR_BIT == 8u) && (UCHAR_MAX == U1MAX)) #define U1 "char" typedef unsigned char u1_int; typedef signed char s1_int; #endif #if (USHRT_MAX == U2MAX) #define U2 "short int" typedef unsigned short int u2_int; typedef signed short int s2_int; #elif (UINT_MAX == U2MAX) #define U2 "int" typedef unsigned int u2_int; typedef signed int s2_int; #endif #if (UINT_MAX == U4MAX) #define U4 "int" typedef unsigned int u4_int; typedef signed int s4_int; #elif (ULONG_MAX == U4MAX) #define U4 "long int" typedef unsigned long int u4_int; typedef signed long int s4_int; #elif (ULONGLONG_MAX == U4MAX) #define U4 "long long int" typedef unsigned long long int u4_int; typedef signed long long int s4_int; #endif /* byte <-> int conversions (JVM uses big-endian order) **************************************************** */ #define B2U2(b1,b2) ((((u2_int)(b1))<<8)+((u2_int)(b2))) #define B2U4(b1,b2,b3,b4) ((((u4_int)(B2U2((b1),(b2)))<<16)) + \ ((u4_int)(B2U2((b3),(b4))))) #define B2S2(b1,b2) ((s2_int)(B2U2((b1),(b2)))) #define B2S4(b1,b2,b3,b4) ((s4_int)(B2U4((b1),(b2),(b3),(b4)))) #define LOWB_U2(u) ((u1_int)( (u) & 0xff)) #define HIGB_U2(u) ((u1_int)(((u) >> 8) & 0xff)) #define LOWB_U4(u) ((u1_int)(((u) >> 16) & 0xff)) #define HIGB_U4(u) ((u1_int)(((u) >> 24) & 0xff)) /* ******************************************** *** Class-file-specific Type Definitions *** ******************************************** */ /* Access and Modifier Flags ************************* */ #define ACC_PUBLIC 0x0001 #define ACC_PRIVATE 0x0002 #define ACC_PROTECTED 0x0004 #define ACC_STATIC 0x0008 #define ACC_FINAL 0x0010 #define ACC_SUPER 0x0020 #define ACC_SYNCHRONIZED 0x0020 /* overloaded */ #define ACC_VOLATILE 0x0040 #define ACC_TRANSIENT 0x0080 #define ACC_NATIVE 0x0100 #define ACC_INTERFACE 0x0200 #define ACC_ABSTRACT 0x0400 /* Constant Pool Tags ****************** */ #define CONSTANT_Utf8 1u #define CONSTANT_Integer 3u #define CONSTANT_Float 4u #define CONSTANT_Long 5u #define CONSTANT_Double 6u #define CONSTANT_Class 7u #define CONSTANT_String 8u #define CONSTANT_Fieldref 9u #define CONSTANT_Methodref 10u #define CONSTANT_InterfaceMethodref 11u #define CONSTANT_NameAndType 12u /* Constant Pool Entries ********************* */ struct constant_node { union { struct { u4_int val1; u4_int val2; } data; struct { u2_int index1; u2_int index2; } indices; struct { u1_int *s; u2_int l; } utf8; } u ; u1_int tag; } ; typedef struct constant_node *constant_ptr; /* Attribute Entries ***************** */ struct attribute_node { u2_int attribute_name_index; u4_int attribute_length; u1_int *info; /* JAVAB specific information ************************** */ u4_int code_length; u1_int *reachable; /* 0u : unreachable 1u : reachable/visited 2u : unvisited *********************** */ u1_int *is_leader; u2_int *sp_before; struct bb_node **my_bb; struct state_node ***st_state; SYMTABLE *label_table; } ; typedef struct attribute_node *attribute_ptr; /* Field/Method Entries ******************** */ struct fm_node { u2_int access_flags; u2_int name_index; u2_int descr_index; u2_int attributes_count; attribute_ptr *attributes; } ; typedef struct fm_node *fm_ptr; /* *************************************** *** JAVAB-specific Type Definitions *** *************************************** */ /* Stack State Component Types *************************** */ enum stack_states { S_BOT, S_EXP, S_REF } ; /* Local Variable Types ******************** */ enum types { TP_UNUSED, TP_2WORD, TP_INT, TP_LONG, TP_FLOAT, TP_DOUBLE, TP_REF, TP_ERROR } ; /* Small Nodes *********** */ struct array_node { struct array_node *next; /* Query Information */ u1_int *q; s4_int *c; u4_int *p; s4_int *dep_l; s4_int *dep_u; u1_int *dep_s; /* 0u: unused 1u: used as loop index 2u: loop-carried ********************** */ /* Other Information */ u4_int dim_ad; u2_int dim_loc; u1_int dim; u1_int lhs; } ; typedef struct array_node *array_ptr; struct ref_node { struct ref_node *gnext; struct ref_node *next; struct state_node *rf; struct state_node *in; u4_int ad; u1_int lhs; } ; typedef struct ref_node *ref_ptr; /* Natural Loops ************* */ struct loop_node { struct loop_node *next; /* Loop Info ********* */ struct bb_node *b; struct bb_node *d; struct bb_node **nl; /* nodes in natural loop (defined by back-edge) ********************** */ struct state_node *compare; struct state_node *up_bnd; struct state_node *lw_bnd; u1_int strict; /* index/bound information ************************ */ struct ref_node *refs; struct array_node *array; /* array information ***************** */ u1_int *load_type; char **load_sig; u2_int load_locs; /* local var. usage **************** */ u4_int min_ad; u4_int max_ad; u4_int exit_ad; u4_int cmp_ad; /* address information ******************* */ u1_int ind_is_w; u2_int ind_step; u2_int ind_loc; u4_int ind_add; /* trivial loop index information ******************************* */ u4_int cnt; u1_int triv; u1_int par; /* loop information **************** */ } ; typedef struct loop_node *loop_ptr; /* Workers ******* */ struct worker_node { struct worker_node *next; /* Worker Fields ************* */ char *qualified_name; char *constr_d; u2_int *load_ind; u1_int *load_type; char **load_sig; /* Local Usage Information *********************** */ u1_int* loop_code; u4_int l_len; /* Loop-Body ********* */ u1_int ind_is_w; u2_int ind_step; u4_int ind_off; /* iinc Information **************** */ u4_int entry_off; u4_int exit_off; u2_int max_stack; u2_int max_locals; /* Additional Information ********************** */ } ; typedef struct worker_node *worker_ptr; /* Stack States ************ */ struct state_node { struct state_node *gnext; union { struct { char *sig; u4_int ad; u2_int loc; u1_int d, d2, set; } ref; struct { u1_int *rd; s4_int con; } exp; } u; u1_int prop; u1_int kind; } ; typedef struct state_node *state_ptr; /* Basic Blocks ************ */ struct bbh_node { struct bb_node *head; struct bbh_node *tail; loop_ptr loop; u1_int exc; /* exception flag */ } ; typedef struct bbh_node *bbh_ptr; struct bb_node { struct bb_node *gnext; /* Data Flow Information ********************* */ u1_int *dominators; u1_int *rd_gen; u1_int *rd_kill; u1_int *rd_in; u1_int *rd_out; u1_int *upw_use; state_ptr *s_gen; state_ptr *s_in; state_ptr *s_out; /* Control Flow Information ************************ */ struct bbh_node *pred; struct bbh_node *succ; u4_int name; u4_int low, high; u1_int visited; } ; typedef struct bb_node *bb_ptr; /* ***************************************** *** Prototypes and External Variables *** ***************************************** */ /* main.c ****** */ extern u1_int my_not; extern u1_int error; extern u4_int n_par, n_nest, n_loop, n_triv; u1_int query(void); void javab_out(s1_int, char *, ...); void *make_mem(int); void *more_mem(void *, int); /* class.c ******* */ extern u4_int magic; extern u2_int minor_version, major_version; extern u2_int constant_pool_count; extern constant_ptr *constant_pool; extern u2_int access_flags, this_class, super_class; extern u2_int interfaces_count; extern u2_int *interfaces; extern u2_int fields_count; extern fm_ptr *fields; extern u2_int methods_count; extern fm_ptr *methods; extern u2_int attributes_count; extern attribute_ptr *attributes; void make_shadow_cp(void); void mark_shadow_cp(u2_int); void take_shadow_cp(void); void dump_shadow_cp(void); void elim_shadow_cp(void); void process_classfile(FILE *, u1_int); u1_int valid_cp_entry(u1_int, u2_int, char *); void show_cp_entry(constant_ptr); attribute_ptr new_attribute(void); void add_cp_entry(u1_int, char *, u2_int, u2_int); void add_field(fm_ptr); void add_method(fm_ptr); /* byte.c ****** */ state_ptr new_stack_state(u1_int, u4_int, s4_int); void check_triv_loop(loop_ptr); int byte_proc(void); /* basic.c ******* */ void nop_loop(attribute_ptr, loop_ptr, u1_int *); void bb_link_sub_back(u1_int *, bb_ptr, bb_ptr); bb_ptr bb_add(u2_int, u2_int, u1_int); void bb_add_pred(bb_ptr, bb_ptr, u1_int); void bb_add_succ(bb_ptr, bb_ptr, u1_int); void bb_first(u2_int, u2_int *, u4_int *, char **, u2_int, u2_int, u2_int *, u4_int *, u1_int *, u2_int); void bb_second(u1_int *); void bb_par(attribute_ptr, u1_int *, u1_int *); void bb_delete(void); void dump_sta(state_ptr); /* dump.c ****** */ void dump_classfile(FILE *); /* par.c ***** */ void output_workers(char *); void parallelize_loop(attribute_ptr, loop_ptr, u1_int *); f2j-0.8.1/goto_trans/dump.c0000600000077700002310000001537111031241063015541 0ustar seymourgraduate /* ************* *** JAVAB *** **************************************************** *** Copyright (c) 1997 *** *** Aart J.C. Bik Indiana University *** *** All Rights Reserved *** **************************************************** *** Please refer to the LICENSE file distributed *** *** with this software for further details on *** *** the licensing terms and conditions. *** *** *** *** Please, report all bugs, comments, etc. *** *** to: ajcbik@extreme.indiana.edu *** **************************************************** *** dump.c : output to class file *** *** *** Your courtesy in mentioning the use of this bytecode tool *** in any scientific work that presents results obtained *** by using (extensions or modifications of) the tool *** is highly appreciated. *** *** */ /* ******************************************************** *** INCLUDE FILES and DEFINITIONS *** ******************************************************** */ #include #include "class.h" /* ******************************************************** *** EXTERNAL VARIABLES *** ******************************************************** */ /* PRIVATE ******* */ static FILE *dumpfile; /* ******************************************************** *** PRIVATE FUNCTIONS *** ******************************************************** */ /* write u1_int, u2_int, and u4_int routines **************************************** */ static void write_u1(u1_int u) { fputc(u, dumpfile); } static void write_u2(u2_int u) { u1_int u1 = HIGB_U2(u); u1_int u2 = LOWB_U2(u); fputc(u1, dumpfile); fputc(u2, dumpfile); } static void write_u4(u4_int u) { u1_int u1 = HIGB_U4(u); u1_int u2 = LOWB_U4(u); u1_int u3 = HIGB_U2(u); u1_int u4 = LOWB_U2(u); fputc(u1, dumpfile); fputc(u2, dumpfile); fputc(u3, dumpfile); fputc(u4, dumpfile); } /* ********************************************************** *** Output of the different components of a class file *** ********************************************************** */ /* output of attribute information ******************************* */ static void dump_attributes(u2_int cnt, attribute_ptr *a) { u4_int i, j; /* wide counters */ write_u2(cnt); if (cnt != 0u) { if (! a) javab_out(-1, "lost attributes in dump_attributes()"); for (i = 0u; i < cnt; i++) { if ((! a[i]) || (! a[i] -> info)) javab_out(-1, "lost attribute entry in dump_attributes()"); else { u2_int ind = a[i] -> attribute_name_index; u4_int len = a[i] -> attribute_length; u1_int *info = a[i] -> info; write_u2(ind); write_u4(len); for (j = 0u; j < len; j++) write_u1(info[j]); } } } } /* output of constant pool information *********************************** */ static void dump_constant_pool(void) { u4_int i, j; /* wide counters */ write_u2(constant_pool_count); if ((constant_pool_count == 0u) || (! constant_pool)) javab_out(-1, "lost constant pool in dump_cpool()"); for (i = 1u; i < constant_pool_count; i++) { constant_ptr ce = constant_pool[i]; if (! ce) javab_out(-1, "lost pool entry in dump_cpool()"); write_u1(ce -> tag); switch(ce -> tag) { case CONSTANT_Class: case CONSTANT_String: write_u2(ce -> u.indices.index1); break; case CONSTANT_Fieldref: case CONSTANT_Methodref: case CONSTANT_InterfaceMethodref: case CONSTANT_NameAndType: write_u2(ce -> u.indices.index1); write_u2(ce -> u.indices.index2); break; case CONSTANT_Integer: case CONSTANT_Float: write_u4(ce -> u.data.val1); break; case CONSTANT_Long: case CONSTANT_Double: write_u4(ce -> u.data.val1); write_u4(ce -> u.data.val2); i++; /* invalid next entry */ break; case CONSTANT_Utf8: { u2_int l = ce -> u.utf8.l; u1_int *s = ce -> u.utf8.s; if (! s) javab_out(-1, "lost UTF8 string in dump_cpool()"); write_u2(l); for (j = 0u; j < l; j++) write_u1(s[j]); } break; default: javab_out(-1, "invalid constant pool entry in dump_cpool()"); } } } /* output of interface information ******************************* */ static void dump_interfaces(void) { u4_int i; /* wide counter */ write_u2(interfaces_count); if (interfaces_count != 0u) { if (! interfaces) javab_out(-1, "lost interfaces in dump_interfaces()"); for (i = 0u; i < interfaces_count; i++) write_u2(interfaces[i]); } } /* output of field information *************************** */ static void dump_fields(void) { u4_int i; /* wide counter */ write_u2(fields_count); if (fields_count != 0u) { if (! fields) javab_out(-1, "lost fields in dump_fields()"); for (i = 0u; i < fields_count; i++) { if (! fields[i]) javab_out(-1, "lost field entry in dump_fields()"); write_u2(fields[i] -> access_flags); write_u2(fields[i] -> name_index); write_u2(fields[i] -> descr_index); dump_attributes(fields[i] -> attributes_count, fields[i] -> attributes); } } } /* output of method information **************************** */ static void dump_methods(void) { u4_int i; /* wide counter */ write_u2(methods_count); if (methods_count != 0u) { if (! methods) javab_out(-1, "lost methods in dump_methods()"); for (i = 0u; i < methods_count; i++) { if (! methods[i]) javab_out(-1, "lost method entry in dump_methods()"); write_u2(methods[i] -> access_flags); write_u2(methods[i] -> name_index); write_u2(methods[i] -> descr_index); dump_attributes(methods[i] -> attributes_count, methods[i] -> attributes); } } } /* output of complete class file structure *************************************** */ static void dump_class(void) { write_u4(magic); /* magic */ write_u2(minor_version); /* versions */ write_u2(major_version); dump_constant_pool(); write_u2(access_flags); /* class info */ write_u2(this_class); write_u2(super_class); dump_interfaces(); dump_fields(); dump_methods(); dump_attributes(attributes_count, attributes); } /* ******************************************************** *** PUBLIC FUNCTIONS *** ******************************************************** */ void dump_classfile(FILE *f) { dumpfile = (f) ? f : stdout; dump_class(); } f2j-0.8.1/goto_trans/main.c0000600000077700002310000001567511031241063015527 0ustar seymourgraduate /* ************* *** JAVAB *** **************************************************** *** Copyright (c) 1997 *** *** Aart J.C. Bik Indiana University *** *** All Rights Reserved *** **************************************************** *** Please refer to the LICENSE file distributed *** *** with this software for further details on *** *** the licensing terms and conditions. *** *** *** *** Please, report all bugs, comments, etc. *** *** to: ajcbik@extreme.indiana.edu *** **************************************************** *** main.c : control program *** *** *** Your courtesy in mentioning the use of this bytecode tool *** in any scientific work that presents results obtained *** by using (extensions or modifications of) the tool *** is highly appreciated. *** *** */ /* ******************************************************** *** INCLUDE FILES and DEFINITIONS *** ******************************************************** */ #include #include "class.h" #undef AUTO_QUERY /* ******************************************************** *** EXTERNAL VARIABLES *** ******************************************************** */ /* PUBLIC ****** */ u1_int my_not = 4u; u1_int error = 0u; u4_int n_par = 0u, n_nest = 0u, n_loop = 0u, n_triv = 0u; char *filename = NULL; /* PRIVATE ******* */ static u1_int tot_err = 0u; static u4_int files = 0u; static FILE *file = NULL; /* ******************************************************** *** PRIVATE FUNCTIONS *** ******************************************************** */ /* Move original 'file.ext' to 'file.old' and open a new 'file.ext' for output ************************************************* */ static FILE *new_file(char *oldname) { int i, last = -1; char *newname = NULL, c = '\0'; FILE *newfile = NULL; if (! oldname) /* Safety */ javab_out(-1, "incorrect invocation of new_file()"); /* Construct new name file.old by stripping last extension from original file.ext */ for (i = 0; oldname[i]; i++) if (oldname[i] == '.') last = i; if (last >= 0) { c = oldname[last]; oldname[last] = '\0'; } /* DYNAMIC MEMORY ALLOCATION -> no restriction on length */ newname = (char *) make_mem(sizeof(char) * (strlen(oldname) + 6)); sprintf(newname, "%s.old", oldname); if (last >= 0) oldname[last] = c; /* Prevent Overwriting of existing file.old */ if((newfile = fopen(newname, "r"))) { javab_out(0, "cannot apply javab to %s" " (%s exists)", oldname, newname); fclose(newfile); newfile = NULL; } else { /* DYNAMIC MEMORY ALLOCATION -> no restriction on length */ char *command = (char *) make_mem(sizeof(char) * (strlen(oldname) + strlen(newname) + 5)); sprintf(command, "mv %s %s", oldname, newname); /* Re-name original file.ext to file.old */ javab_out(2, " -- executing '%s'", command); if (system(command)) javab_out(0, "command %s failed", command); else { /* Re-open original file.ext for new output */ if (! (newfile = fopen(oldname, "w"))) javab_out(0, "cannot open file %s", oldname); else javab_out(2, " -- output to file %s", oldname); } free(command); } free(newname); return newfile; } /* Process a Class File ******************** */ static void process(void) { FILE *outfile; int num; files++; error = 0; process_classfile(file, 0u); /* read */ /* process_classfile(NULL, 1u); */ /* verify */ num = byte_proc(); if(num > 0) { outfile = new_file(filename); if (outfile) { dump_classfile(outfile); fclose(outfile); } } } /* ******************************************************** *** PUBLIC FUNCTIONS *** ******************************************************** */ /* **************************** *** User input on Query *** **************************** *** y/Y : yes *** *** n/N : no *** *** q/Q : no, quit query *** **************************** */ u1_int query(void) { char str[80]; u1_int res = 2u; #ifdef AUTO_QUERY fprintf(stderr, "(y/n/q) => Y\n"); return 1u; #endif do { fprintf(stderr, "(y/n/q) => "); fflush(stderr); fgets(str, 80, stdin); if (strlen(str) != 0) switch (str[0]) { case 'y': case 'Y': res = 1u; break; case 'n': case 'N': res = 0u; break; case 'q': case 'Q': res = 0u; break; } } while (res == 2u); return res; } /* ********************************** *** Error and Warning Messages *** *************************************************************** *** level == -1 : FATAL ERROR, EXIT PROGRAM *** *** level == 0 : ERRROR, SET ERROR FLAG *** *** level == 1 : STRONG MESSAGE *** *** level == 2 : MESSAGE, PRINT ONLY FOR '-v' *** *************************************************************** */ void javab_out(s1_int level, char *fmt, ...) { va_list argv; if (level == 0) tot_err = error = 1; /* else if (level > 1 && ! s_verbose) */ else if (level > 1) return; va_start(argv, fmt); if (file) fprintf(stderr, "%s:: ", (filename) ? filename : "stdin"); vfprintf(stderr, fmt, argv); putc('\n', stderr); va_end(argv); if (level < 0) exit(1); } /* Memory Allocation Functions [for size <= 0, size == 1 is used because some systems return NULL for malloc(0);] ************************************************* */ void *make_mem(int size) { void *p = calloc(((size > 0) ? size : 4), sizeof(u1_int)); if (! p) javab_out(-1, "Out of Memory"); return p; } void *more_mem(void *p, int size) { if (p) { p = realloc(p, ((size > 0) ? size : 1)); if (! p) javab_out(-1, "Out of Memory (re-allocation)"); return p; } else return make_mem(size); } /* ******************** *** Main Program *** ******************** */ int main(int argc, char *argv[]) { int i; u1_int unproc = 1; /* Process Environment Variable */ char *env = getenv("JAVAB_THREADS"); if (env) { my_not = (u1_int) atoi(env); if (my_not < 2u) my_not = 4u; else if (my_not > 16u) my_not = 16u; } for (i = 1; i < argc; i++) { if (argv[i]) { file = fopen(filename = argv[i], "r"); unproc = 0; if (file) { process(); fclose(file); } else javab_out(0, "cannot open file %s", filename); } } /* Process Standard Input by Default */ if (unproc) { file = stdin; process(); } return tot_err; } f2j-0.8.1/goto_trans/symtab.c0000600000077700002310000000470411031241063016071 0ustar seymourgraduate#include #include #include #include "symtab.h" #define symdebug 0 void *malloc(size_t); void *calloc(size_t, size_t); SYMTABLE * new_symtable (int numentries) { SYMTABLE *newtable; newtable = (SYMTABLE *) malloc (sizeof (SYMTABLE)); /* Handle out-of-mem. */ if (newtable == NULL) { perror ("malloc error creating new symboltable"); exit (-1); } newtable->num_entries = numentries; newtable->entry = (HASHNODE **) calloc (numentries, sizeof (HASHNODE *)); /* Handle out-of-mem. */ if (newtable->entry == NULL) { perror ("calloc error creating new symbol table"); exit (-1); } return (newtable); } /* Close new_symtable(). */ void type_insert (HASHNODE ** list, int node_val, char *tag) { HASHNODE *newnode; newnode = (HASHNODE *) malloc (sizeof (HASHNODE)); newnode->ident = tag; newnode->val = node_val; /* Note carefully the dereferencing operators. */ newnode->next = *list; *list = newnode; } /* This is a specific lookup routine to match an id with its associated type. I will need others for matching externals, intrinsics, etc. */ HASHNODE * type_lookup (SYMTABLE * table, char *id) { int index; HASHNODE *hash_entry; int hash(char *); if((table == NULL) || (id == NULL)) { return NULL; } index = hash (id) % table->num_entries; hash_entry = search_hashlist (table->entry[index], id); if (hash_entry == NULL) { if(symdebug)printf ("Not in table.\n"); return NULL; } else /* Attempt to return the value pointed to by "type". */ { if(symdebug)printf("In table.\n"); return (hash_entry); } } HASHNODE * format_lookup(SYMTABLE *table, char *label) { return type_lookup(table,label); } HASHNODE * search_hashlist (HASHNODE * list, char *id) { if(id == NULL) return NULL; for (; list != NULL ; list = list->next) { if(list->ident == NULL) continue; if (!strcmp (list->ident, id)) return (list); } return NULL; /* Not in list. */ } /* Simple hash function: just add the ascii integer values of each character in the string. Added error check for null string and made some other minor changes. 12/5/97 --Keith */ int hash (char *str) { int sum = 0; int i=0, len; if(str == NULL) return 0; len = strlen(str); while (i < len) { sum += (int) str[i]; i++; } return sum; } f2j-0.8.1/goto_trans/symtab.h0000600000077700002310000000052711031241063016075 0ustar seymourgraduate typedef struct hash_node { int val; char *ident; struct hash_node *next; } HASHNODE; typedef struct sym_table { int num_entries; HASHNODE **entry; } SYMTABLE; /* Prototypes. */ HASHNODE * search_hashlist(HASHNODE *, char *); HASHNODE * type_lookup(SYMTABLE *, char *); SYMTABLE * new_symtable(int); f2j-0.8.1/goto_trans/make.def.in0000600000077700002310000000012111031241063016415 0ustar seymourgraduate CC=@CC@ LIBS=@LIBS@ F2J_BINDIR=@F2J_INSTALL_PREFIX@/bin CFLAGS=-Wall @CFLAGS@ f2j-0.8.1/goto_trans/README0000600000077700002310000000440311031241063015302 0ustar seymourgraduate ***************************** *** JAVAB VERSION 1.0BETA *** **************************************************** *** Copyright (c) 1997 *** *** Aart J.C. Bik Indiana University *** *** All Rights Reserved *** **************************************************** *** Please refer to the LICENSE file distributed *** *** with this software for further details on *** *** the licensing terms and conditions. *** *** *** *** Please, report all bugs, comments, etc. *** *** to: ajcbik@extreme.indiana.edu *** **************************************************** Contents: -------- JAVAB : The complete source of JAVAB, the LICENSE file, and this README. JAVAB/DOC : Documentation of JAVAB (file VERSION summarizes changes with respect to previous releases). JAVAB/EXAMPLES/SRC JAVAB/EXAMPLES/CLASSES : Source and class files of some examples. Note that there are now two Java research tools available at the HP-Java page at Indiana University: *** JAVAR -- A prototype Java restructuring compiler. ********* This restructuring compiler can be used to make loop parallelism explicit at *source-code-level* using the multi-threading mechanism of the Java programming language. In this tool, however, loop parallelism must be identified by the programmer by means of annotations. *** JAVAB -- A prototype bytecode parallelization tool. ********* This tool can be used to exploit loop parallelism directly at *bytecode-level* using the multi-threading mechanism of the JVM. In addition, the tool provides some elementary support for the automatic *detection* of implicit loop parallelism. Documentation, manuals, LICENSE information, and the complete source of both JAVAR and JAVAB are made available for education, research, and non-profit purposes at the HP-Java page: http://www.extreme.indiana.edu/hpjava/ Please keep in mind that both JAVAR and JAVAB are research tools, and not robust commercial products. Anyway, please send all your bug reports, but also other comments, experiences, or suggestions to: ajcbik@extreme.indiana.edu f2j-0.8.1/goto_trans/LICENSE0000600000077700002310000000464111031241063015433 0ustar seymourgraduate********************************* *** JAVAB License Information *** ********************************* *** *** --- This file is a REQUIRED part of JAVAB --- *** *** This prototype bytecode parallelization tool has been developed *** at the Indiana University by Aart J.C. Bik. This software is *not* *** in the public domain. However, it is freely available without *** fee for education, research, and non-profit purposes. By obtaining *** copies of this, you, the Licensee, agree to abide by the following *** conditions and understandings with respect to the copyrighted software: *** *** 1. The software is copyrighted by Indiana University (IU) and *** Aart J.C. Bik and they retain ownership of the software. *** *** 2. Permission to use and modify this software and its documentation *** for education, research, and non-profit purposes is hereby granted to *** Licensee, provided that the copyright notice, the original author's *** names and unit identification, and this permission notice appear on *** all such works, and that no charge be made for such copies. *** *** 3. Any entity desiring permission to incorporate this software into *** commercial products should contact: *** *** Dennis Gannon gannon@cs.indiana.edu *** 215 Lindley Hall *** Department of Computer Science *** Indiana University *** Bloomington, IN 47405-4101 USA *** *** 4. Licensee may not use the name, logo, or any other symbol of *** IU nor the names of any of its employees nor any adaptation thereof *** in advertising or publicity pertaining to the software without *** specific prior written approval of the IU. *** *** 5. THE COPYRIGHT HOLDERS MAKE NO REPRESENTATIONS ABOUT THE SUITABILITY *** OF THE SOFTWARE FOR ANY PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS *** OR IMPLIED WARRANTY. *** *** 6. The copyright holders shall not be liable for any damages suffered *** by Licensee from the use of this software. *** *** 7. The software was developed under agreements between the IU and *** the Federal Government which entitle the Government to certain rights. *** *** Your courtesy in mentioning the use of this bytecode compiler in any scientific *** work that presents results obtained by using (extensions or modifications *** of) this bytecode compiler is highly appreciated. *** *** This project has been supported by DARPA under contract *** ARPA F19628-94-C-0057 through a subcontract from Syracuse University *** f2j-0.8.1/goto_trans/Makefile0000600000077700002310000000315411031241063016064 0ustar seymourgraduate # ************* # *** JAVAB *** # **************************************************** # *** Copyright (c) 1997 *** # *** Aart J.C. Bik Indiana University *** # *** All Rights Reserved *** # **************************************************** # *** Please refer to the LICENSE file distributed *** # *** with this software for further details on *** # *** the licensing terms and conditions. *** # *** *** # *** Please, report all bugs, comments, etc. *** # *** to: ajcbik@extreme.indiana.edu *** # **************************************************** # *** Makefile : javab construction # *** # *** # *** Your courtesy in mentioning the use of this bytecode tool # *** in any scientific work that presents results obtained # *** by using (extensions or modifications of) the tool # *** is highly appreciated. include make.def TARGET = javab OBJS = byte.o class.o dump.o main.o symtab.o # Executable # ********** $(TARGET): $(OBJS) $(CC) $(CFLAGS) -o $(TARGET) $(OBJS) install: $(TARGET) install -d -m 755 $(F2J_BINDIR) install -m 755 $(TARGET) $(F2J_BINDIR) # System Program # ************** main.o : main.c class.h $(CC) -c $(CFLAGS) main.c # Modules # ******* symtab.o : symtab.c symtab.h $(CC) -c $(CFLAGS) symtab.c byte.o : byte.c class.h $(CC) -c $(CFLAGS) byte.c class.o : class.c class.h $(CC) -c $(CFLAGS) class.c dump.o : dump.c class.h $(CC) -c $(CFLAGS) dump.c # Cleanup # ******* clean: rm -f $(OBJS) realclean: clean rm -f $(TARGET) f2j-0.8.1/libbytecode/0000700000077700002310000000000011031241063014525 5ustar seymourgraduatef2j-0.8.1/libbytecode/api.c0000600000077700002310000027713111031241063015457 0ustar seymourgraduate/** @file api.c * Contains an API for generating Java bytecode. */ #include "api.h" /** * This code creates the JVM_FIELD structure, assigns the * appropriate values into it, and inserts it into the field list. * * @param cclass -- The class to which the field should be added. * @param name -- The name of the field. * @param desc -- The field descriptor. * @param acc_flag -- The access flags for this field (for example * JVM_ACC_PUBLIC, JVM_ACC_STATIC, etc) * * @returns The new JVM_FIELD structure. */ JVM_FIELD * bc_add_field(JVM_CLASS *cclass, char *name, char *desc, u2 acc_flag) { JVM_FIELD * tmpfield; int c; if(!cclass || !name || !desc) { BAD_ARG(); return NULL; } debug_msg("bc_add_field() creating new field for %s - %s\n",name,desc); tmpfield = (JVM_FIELD *) malloc(sizeof(JVM_FIELD)); if(!tmpfield) return NULL; tmpfield->access_flags = acc_flag; tmpfield->class = cclass; c = cp_find_or_insert(cclass, CONSTANT_Utf8, name); if(c < 0) { free(tmpfield); return NULL; } tmpfield->name_index = c; c = cp_find_or_insert(cclass, CONSTANT_Utf8, desc); if(c < 0) { free(tmpfield); return NULL; } tmpfield->descriptor_index = c; tmpfield->attributes_count = 0; tmpfield->attributes = make_dl(); if(!tmpfield->attributes) { free(tmpfield); return NULL; } dl_insert_b(cclass->fields, tmpfield); cclass->fields_count++; return tmpfield; } /** * Returns the fully-qualified class name for the given class. * Generally this is the package name followed by the class name, * however the class name could already be a qualified name. * * @param thisclass -- The name of the class. * @param package_name -- The name of the package. If NULL, the * fully-qualified name is just the class name. * * @returns The fully-qualified class name. Returns NULL on error. */ char * bc_get_full_classname(char *thisclass, char *package_name) { char *pname, *t; if(!thisclass) { BAD_ARG(); return NULL; } /* maybe this is already qualified. if so, just return a dup of the * class name. */ for(t = thisclass; *t != '\0'; t++) if( (*t == '/') || (*t == '.') ) return char_substitute(thisclass, '.', '/'); if(package_name != NULL) { pname = (char *)malloc(strlen(thisclass) + strlen(package_name) + 2); if(!pname) return NULL; /* issue a warning if the package name has some trailing junk. */ if(!isalnum((int)*(package_name + (strlen(package_name)-1)))) debug_err("WARNING: last char of package name not alphanumeric.\n"); t = char_substitute(package_name, '.', '/'); if(!t) { free(pname); return NULL; } strcpy(pname, t); strcat(pname, "/"); strcat(pname, thisclass); free(t); return pname; } else return strdup(thisclass); } /** * Creates a new class file structure. * * @param name -- The name of the class. * @param srcFile -- The name of the source code file from which this * class was compiled. If NULL, no SourceFile attribute will be created * for this class. * @param super_class -- The name of the superclass for this class. If NULL, * the superclass is set to java.lang.Object. * @param package_name -- The name of the package this class file belongs to. * If NULL, no package will be specified. * @param acc_flag -- The access flags for this class (for example * JVM_ACC_PUBLIC, etc) * * @returns The new class file structure. */ JVM_CLASS * bc_new_class(char *name, char *srcFile, char *super_class, char *package_name, u2 acc_flag) { CP_INFO *utf8node = NULL, *classnode = NULL; JVM_CLASS * tmp = NULL; char * fullclassname = NULL; int c; #define err_new_class() \ if(tmp->constant_pool) dl_delete_list(tmp->constant_pool); \ tmp->constant_pool = NULL; \ if(tmp->fields) dl_delete_list(tmp->fields); \ tmp->fields = NULL; \ if(tmp->interfaces) dl_delete_list(tmp->interfaces); \ tmp->interfaces = NULL; \ if(tmp->attributes) dl_delete_list(tmp->attributes); \ tmp->attributes = NULL; \ if(tmp->methods) dl_delete_list(tmp->methods); \ tmp->methods = NULL; \ if(fullclassname) free(fullclassname); \ if(tmp) free(tmp); \ if(utf8node && utf8node->cpnode.Utf8.bytes) \ free(utf8node->cpnode.Utf8.bytes); \ if(classnode && classnode->cpnode.Utf8.bytes) \ free(classnode->cpnode.Utf8.bytes); if(!name) { BAD_ARG(); return NULL; } tmp = (JVM_CLASS *)malloc(sizeof(JVM_CLASS)); if(!tmp) return NULL; tmp->magic = JVM_MAGIC; bc_set_class_version(tmp, JVM_MAJOR_VER, JVM_MINOR_VER); /* we'll fill out the constant pool and fields later. */ tmp->constant_pool_count = 0; tmp->constant_pool = make_dl(); tmp->fields_count = 0; tmp->fields = make_dl(); tmp->interfaces_count = 0; tmp->interfaces = make_dl(); tmp->attributes_count = 0; tmp->attributes = make_dl(); tmp->methods_count = 0; tmp->methods = make_dl(); tmp->access_flags = acc_flag; if(!tmp->constant_pool || !tmp->fields || !tmp->interfaces || !tmp->attributes || !tmp->methods) { err_new_class(); return NULL; } /* first create an entry for 'this'. the class file variable this_class * points to a CONSTANT_Class_info entry in the constant pool, which in * turn points to a CONSTANT_Utf8_info entry representing the name of * this class. so, first we create the Utf8 entry, then the Class entry. */ fullclassname = bc_get_full_classname(name, package_name); if(!fullclassname) { err_new_class(); return NULL; } debug_msg("##creating new entry, this -> %s\n",fullclassname); c = cp_find_or_insert(tmp, CONSTANT_Class, fullclassname); if(c < 0) { err_new_class(); return NULL; } tmp->this_class = c; /* if a superclass was specified, then insert an entry for it into * the constant pool and set the superclass field in the class struct. * otherwise, set the superclass to java.lang.Object. */ if(super_class) { char *sc; sc = char_substitute(super_class, '.', '/'); if(!sc) { err_new_class(); return NULL; } c = cp_find_or_insert(tmp, CONSTANT_Class, sc); free(sc); if(c < 0) { err_new_class(); if(sc) free(sc); return NULL; } tmp->super_class = c; } else { c = cp_find_or_insert(tmp, CONSTANT_Class, "java/lang/Object"); if(c < 0) { err_new_class(); return NULL; } tmp->super_class = c; } /* the only attributes allowed for a class file are SourceFile and * Deprecated. if srcFile was supplied by the user, then add a * SourceFile attribute to this class. */ if(srcFile) { if(bc_add_source_file_attr(tmp, srcFile)) { err_new_class(); return NULL; } } free(fullclassname); return tmp; } /** * Sets the version for this class file. From the JVM Spec: * * The Java virtual machine implementation of Sun's JDK release 1.0.2 * supports class file format versions 45.0 through 45.3 inclusive. * Sun's JDK releases 1.1.X can support class file formats of versions * in the range 45.0 through 45.65535 inclusive. Implementations of * version 1.2 of the Java 2 platform can support class file formats * of versions in the range 45.0 through 46.0 inclusive. * * @param class -- The class file whose version is to be set. * @param major -- The major version. * @param minor -- The minor version. * * @returns 0 on success, -1 on failure. */ int bc_set_class_version(JVM_CLASS *class, int major, int minor) { if(!class) { BAD_ARG(); return -1; } class->major_version = (u2)major; class->minor_version = (u2)minor; if((unsigned int)class->major_version != major) debug_err("Warning: possible truncation in bc_set_class_version.\n"); if((unsigned int)class->minor_version != minor) debug_err("Warning: possible truncation in bc_set_class_version.\n"); return 0; } /** * Creates a SourceFile attribute containing the specified name and adds it * to the given class file. * * @param class -- The class to which the SourceFile attribute should be * added. * @param filename -- The name of the source code file from which this * class was compiled. * * @returns 0 on success, -1 on failure. */ int bc_add_source_file_attr(JVM_CLASS *class, char *filename) { JVM_ATTRIBUTE *attr_temp; int c; if(!class || !filename) { BAD_ARG(); return -1; } class->attributes_count++; attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!attr_temp) return -1; c = cp_find_or_insert(class, CONSTANT_Utf8, "SourceFile"); if(c < 0) { free(attr_temp); return -1; } attr_temp->attribute_name_index = c; attr_temp->attribute_length = 2; /* SourceFile attr length always 2 */ attr_temp->attr.SourceFile = (struct SourceFile_attribute *) malloc(sizeof(struct SourceFile_attribute)); if(!attr_temp->attr.SourceFile) { free(attr_temp); return -1; } c = cp_find_or_insert(class, CONSTANT_Utf8, filename); if(c < 0) { free(attr_temp); free(attr_temp->attr.SourceFile); return -1; } attr_temp->attr.SourceFile->sourcefile_index = c; dl_insert_b(class->attributes,attr_temp); return 0; } /** * Lets the user define their own attribute and add it to the class file. * * @param class -- The class to which this attribute should be added. * @param attribute_name -- The name of the attribute. * @param attribute_length -- The length of the attribute pointed to by the * 'attribute_data' parameter. * @param attribute_data -- Pointer to the attribute contents. * * @returns 0 on success, -1 on failure. */ int bc_add_user_defined_class_attr(JVM_CLASS *class, char *attribute_name, int attribute_length, void *attribute_data) { JVM_ATTRIBUTE *attr_temp; int c; if(!class || !attribute_name || !attribute_data) { BAD_ARG(); return -1; } attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!attr_temp) return -1; c = cp_find_or_insert(class, CONSTANT_Utf8, attribute_name); if(c < 0) { free(attr_temp); return -1; } attr_temp->attribute_name_index = c; attr_temp->attribute_length = attribute_length; attr_temp->attr.UserDefined = (struct UserDefined_attribute *) malloc(sizeof(struct UserDefined_attribute)); if(!attr_temp->attr.UserDefined) { free(attr_temp); return -1; } attr_temp->attr.UserDefined->data = (void *)malloc(attribute_length); if(!attr_temp->attr.UserDefined->data) { free(attr_temp->attr.UserDefined); free(attr_temp); return -1; } memcpy(attr_temp->attr.UserDefined->data, attribute_data, attribute_length); class->attributes_count++; dl_insert_b(class->attributes,attr_temp); return 0; } /** * Adds the "Deprecated" attribute to the specified class. * * @param class -- The class to be set as deprecated. * * @returns 0 on success, -1 on failure. */ int bc_set_class_deprecated(JVM_CLASS *class) { JVM_ATTRIBUTE *attr_temp; if(!class) { BAD_ARG(); return -1; } attr_temp = bc_new_deprecated_attr(class); if(!attr_temp) return -1; class->attributes_count++; dl_insert_b(class->attributes,attr_temp); return 0; } /** * Adds the specified interface to the list of interfaces that * this class implements. * * @param class -- The class to which the interface should be added. * @param interface -- The name of the interface that this class implements. * * @returns 0 on success, -1 on failure. */ int bc_add_class_interface(JVM_CLASS *class, char *interface) { int *copy; int c; char *t; if(!class || !interface) { BAD_ARG(); return -1; } t = char_substitute(interface, '.', '/'); if(!t) return -1; c = cp_find_or_insert(class, CONSTANT_Class, t); free(t); if(c < 0) { free(t); return -1; } copy = (int *)malloc(sizeof(int)); if(!copy) { free(t); return -1; } *copy = c; class->interfaces_count++; dl_insert_b(class->interfaces, copy); return 0; } /** * Adds the "ConstantValue" attribute to the specified field. This allows * specifying the value that the field should have when the class containing * it is initialized. Since a field with a ConstantValue attribue must be * static, this function will set the JVM_ACC_STATIC flag in the field's * access flags. * * @param field -- The field to which the ConstantValue attribute should be * added. * @param tag -- The type of this constant (e.g. CONSTANT_Integer, * CONSTANT_Utf8, etc). See the JVM_CONSTANT enum for the possible * data types. * @param value -- Pointer to the constant value. * * @returns 0 on success, -1 on failure. */ int bc_set_constant_value_attr(JVM_FIELD *field, JVM_CONSTANT tag, const void *value) { JVM_ATTRIBUTE *attr_temp; int c; int val_idx; if(!field || !value) { BAD_ARG(); return -1; } c = cp_manual_insert(field->class, tag, value); if(c < 0) return -1; val_idx = c; /* JVM spec says that the ACC_STATIC flag must be set for a field * which has a ConstantValue attribute. */ field->access_flags |= JVM_ACC_STATIC; attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!attr_temp) return -1; c = cp_find_or_insert(field->class, CONSTANT_Utf8, "ConstantValue"); if(c < 0) { free(attr_temp); return -1; } attr_temp->attribute_name_index = c; attr_temp->attribute_length = 2; /* ConstantValue attr length always 2 */ attr_temp->attr.ConstantValue = (struct ConstantValue_attribute *) malloc(sizeof(struct ConstantValue_attribute)); if(!attr_temp->attr.ConstantValue) { free(attr_temp); return -1; } attr_temp->attr.ConstantValue->constantvalue_index = val_idx; field->attributes_count++; dl_insert_b(field->attributes,attr_temp); return 0; } /** * Adds the "Synthetic" attribute to the specified field. The Synthetic * attribute is used for class members that do not appear in the source code. * * @param field -- The field to which the Synthetic attribute should be * added. * * @returns 0 on success, -1 on failure. */ int bc_set_field_synthetic(JVM_FIELD *field) { JVM_ATTRIBUTE *attr_temp; if(!field) { BAD_ARG(); return -1; } attr_temp = bc_new_synthetic_attr(field->class); if(!attr_temp) return -1; field->attributes_count++; dl_insert_b(field->attributes,attr_temp); return 0; } /** * Adds the "Deprecated" attribute to the specified field. * * @param field -- The field to which the Deprecated attribute should be * added. * * @returns 0 on success, -1 on failure. */ int bc_set_field_deprecated(JVM_FIELD *field) { JVM_ATTRIBUTE *attr_temp; if(!field) { BAD_ARG(); return -1; } attr_temp = bc_new_deprecated_attr(field->class); if(!attr_temp) return -1; field->attributes_count++; dl_insert_b(field->attributes,attr_temp); return 0; } /** * Adds the "Deprecated" attribute to the specified method. * * @param meth -- The method to which the Deprecated attribute should be * added. * * @returns 0 on success, -1 on failure. */ int bc_set_method_deprecated(JVM_METHOD *meth) { JVM_ATTRIBUTE *attr_temp; if(!meth) { BAD_ARG(); return -1; } attr_temp = bc_new_deprecated_attr(meth->class); if(!attr_temp) return -1; meth->attributes_count++; dl_insert_b(meth->attributes,attr_temp); return 0; } /** * Creates a new "Deprecated" attribute. This attribute can be * added to a class, field, or method. * * @param class -- Class containing the constant pool where this * attribute will be stored. * * @returns Pointer to the new JVM_ATTRIBUTE. * Returns NULL on error. */ JVM_ATTRIBUTE * bc_new_deprecated_attr(JVM_CLASS *class) { JVM_ATTRIBUTE *attr_temp; int c; if(!class) { BAD_ARG(); return NULL; } attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!attr_temp) return NULL; c = cp_find_or_insert(class, CONSTANT_Utf8, "Deprecated"); if(c < 0) { free(attr_temp); return NULL; } attr_temp->attribute_name_index = c; attr_temp->attribute_length = 0; /* Deprecated attr length always 0 */ return attr_temp; } /** * Creates a new "Synthetic" attribute. This attribute can be * added to a field or method. * * @param class -- Class containing the constant pool where this * attribute will be stored. * * @returns Pointer to the new JVM_ATTRIBUTE. * Returns NULL on error. */ JVM_ATTRIBUTE * bc_new_synthetic_attr(JVM_CLASS *class) { JVM_ATTRIBUTE *attr_temp; int c; if(!class) { BAD_ARG(); return NULL; } attr_temp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!attr_temp) return NULL; c = cp_find_or_insert(class, CONSTANT_Utf8, "Synthetic"); if(c < 0) { free(attr_temp); return NULL; } attr_temp->attribute_name_index = c; attr_temp->attribute_length = 0; /* Synthetic attr length always 0 */ return attr_temp; } /** * Adds the "Synthetic" attribute to the specified method of the specified * class. * * @returns 0 on success, -1 on failure. */ int bc_set_method_synthetic(JVM_METHOD *meth) { JVM_ATTRIBUTE *attr_temp; if(!meth) { BAD_ARG(); return -1; } attr_temp = bc_new_synthetic_attr(meth->class); if(!attr_temp) return -1; meth->attributes_count++; dl_insert_b(meth->attributes,attr_temp); return 0; } /** * Adds an exception that this method could throw. * * @param meth -- The method to which the exception should be added. * @param exception -- The name of the exception that this method * may throw. * * @returns 0 on success, -1 on failure. */ int bc_add_method_exception(JVM_METHOD *meth, char *exception) { JVM_ATTRIBUTE *attr; int *copy; int c; char *t; if(!meth || !exception) { BAD_ARG(); return -1; } t = char_substitute(exception, '.', '/'); if(!t) return -1; c = cp_find_or_insert(meth->class, CONSTANT_Class, t); free(t); if(c < 0) return -1; copy = (int *)malloc(sizeof(int)); if(!copy) return -1; *copy = c; attr = find_attribute(meth->class, meth->attributes, "Exceptions"); if(!attr) { attr = bc_new_exceptions_attr(meth->class); if(!attr) { free(copy); return -1; } meth->attributes_count++; dl_insert_b(meth->attributes, attr); } attr->attribute_length+=2; attr->attr.Exceptions->number_of_exceptions++; dl_insert_b(attr->attr.Exceptions->exception_index_table, copy); return 0; } /** * Adds the "InnerClasses" attribute to the specified class. * * @param class -- The class to which the attribute should be added. * @param inner_class -- The name of the inner class. * @param outer_class -- The name of the class containing the inner class. * @param inner_name -- Specify NULL for an anonymous inner class. Otherwise * this is the simple name of the inner class. * @param acc_flags -- The access flags for the inner class (for example * JVM_ACC_PUBLIC, JVM_ACC_STATIC, etc) * * @returns 0 on success, -1 on failure. */ int bc_add_inner_classes_attr(JVM_CLASS *class, char *inner_class, char *outer_class, char *inner_name, int acc_flags) { struct InnerClassEntry *entry; JVM_ATTRIBUTE *attr; int c; char *t; if(!class) { BAD_ARG(); return -1; } attr = find_attribute(class, class->attributes, "InnerClasses"); if(!attr) { attr = bc_new_inner_classes_attr(class); if(!attr) return -1; class->attributes_count++; dl_insert_b(class->attributes, attr); } /* increment the length by the size of one entry in the inner class list */ entry = (struct InnerClassEntry *)malloc(sizeof(struct InnerClassEntry)); if(!entry) return -1; entry->inner_class_info_index = 0; entry->outer_class_info_index = 0; entry->inner_name_index = 0; entry->inner_class_access_flags = acc_flags; if(inner_class) { t = char_substitute(inner_class, '.', '/'); if(!t) { free(entry); return -1; } c = cp_find_or_insert(class, CONSTANT_Class, t); free(t); if(c < 0) { free(entry); return -1; } entry->inner_class_info_index = c; } if(outer_class) { t = char_substitute(outer_class, '.', '/'); if(!t) { free(entry); return -1; } c = cp_find_or_insert(class, CONSTANT_Class, t); free(t); if(c < 0) { free(entry); return -1; } entry->outer_class_info_index = c; } if(inner_name) { t = char_substitute(inner_name, '.', '/'); if(!t) { free(entry); return -1; } c = cp_find_or_insert(class, CONSTANT_Utf8, t); free(t); if(c < 0) { free(entry); return -1; } entry->inner_name_index = c; } attr->attribute_length+=8; attr->attr.InnerClasses->number_of_classes++; dl_insert_b(attr->attr.InnerClasses->classes, entry); return 0; } /** * Sets the name of a local variable in the specified method. * * @param meth -- The method containing the local variable. * @param num -- The local variable number whose name should be set. * @param name -- The name of the variable. * @param desc -- The descriptor of the variable. * * @returns Pointer to the local variable table entry created for * this variable. Returns NULL on error. */ JVM_LOCAL_VARIABLE_TABLE_ENTRY * bc_set_local_var_name(JVM_METHOD *meth, int num, char *name, char *desc) { JVM_LOCAL_VARIABLE_TABLE_ENTRY *loc; if(!meth || !name || !desc) { BAD_ARG(); return NULL; } loc = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *) malloc(sizeof(JVM_LOCAL_VARIABLE_TABLE_ENTRY)); if(!loc) return NULL; loc->index = num; loc->name = strdup(name); loc->name_index = 0; loc->descriptor = char_substitute(desc, '.', '/'); loc->descriptor_index = 0; loc->start = NULL; loc->end = NULL; if(!loc->descriptor || !loc->name) { if(loc->name) free(loc->name); if(loc->descriptor) free(loc->descriptor); free(loc); return NULL; } dl_insert_b(meth->locals_table, loc); return loc; } /** * Sets the start of this named local variable. That is, the instruction from * which the given local variable table entry is valid. * * @param loc -- The local variable table entry for the variable. * @param instr -- The first instruction for which this variable is defined. * * @returns 0 on success, -1 on failure. */ int bc_set_local_var_start(JVM_LOCAL_VARIABLE_TABLE_ENTRY *loc, JVM_CODE_GRAPH_NODE *instr) { if(!loc || !instr) { BAD_ARG(); return -1; } loc->start = instr; return 0; } /** * Sets the end of this named local variable. That is, the instruction after * which the given local variable table entry would not be valid. * * @param loc -- The local variable table entry for the variable. * @param instr -- The last instruction for which this variable is defined. * * @returns 0 on success, -1 on failure. */ int bc_set_local_var_end(JVM_LOCAL_VARIABLE_TABLE_ENTRY *loc, JVM_CODE_GRAPH_NODE *instr) { if(!loc || !instr) { BAD_ARG(); return -1; } loc->end = instr; return 0; } /** * Sets the line number (from the original source file) for the given * JVM instruction. * * @param meth -- The method containing the line number table to be updated. * @param instr -- The instruction corresponding to the given line number. * @param lnum -- The line number from the original source code. * * @returns 0 on success, -1 on failure. */ int bc_set_line_number(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *instr, int lnum) { JVM_LINE_NUMBER_TABLE_ENTRY *tmp; if(!meth || !instr) { BAD_ARG(); return -1; } tmp = (JVM_LINE_NUMBER_TABLE_ENTRY *) malloc(sizeof(JVM_LINE_NUMBER_TABLE_ENTRY)); if(!tmp) return -1; tmp->op = instr; tmp->line_number = lnum; dl_insert_b(meth->line_table, tmp); return 0; } /** * Creates a new exception table entry. The exception table entry * represents the range of instructions for which the given exception * should be trapped. * * @param meth -- The method containing the following instructions. * @param from -- The first instruction from which the exception should be * caught. * @param to -- The last instruction to which the exception applies. * @param target -- The first instruction of the catch block. This is where * the JVM branches when the exception is caught. * @param exc_class -- The name of the exception class which should be caught. * * @returns The exception table entry. */ JVM_EXCEPTION_TABLE_ENTRY * bc_new_exception_table_entry(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *from, JVM_CODE_GRAPH_NODE * to, JVM_CODE_GRAPH_NODE * target, char *exc_class) { JVM_EXCEPTION_TABLE_ENTRY *new_et; if(!meth || !from || !to || !target) { BAD_ARG(); return NULL; } new_et = (JVM_EXCEPTION_TABLE_ENTRY *)malloc(sizeof(JVM_EXCEPTION_TABLE_ENTRY)); if(!new_et) return NULL; new_et->from = from; new_et->to = to; new_et->target = target; /* check if the exception type was specified, then insert an entry * in the constant pool if necessary and set the catch_type field. * otherwise it should be set to 0. */ if(exc_class) { char *etmp; int c; etmp = char_substitute(exc_class, '.', '/'); if(!etmp) { free(new_et); return NULL; } c = cp_find_or_insert(meth->class, CONSTANT_Class, etmp); free(etmp); if(c < 0) { free(new_et); return NULL; } new_et->catch_type = c; } else new_et->catch_type = 0; return new_et; } /** * Adds the specified exception table entry to the specified method. * * @param meth -- The method to which the exception table entry should be * added. * @param et_entry -- The exception table entry to add to this method. * * @returns 0 on success, -1 on failure. */ int bc_add_exception_handler(JVM_METHOD *meth, JVM_EXCEPTION_TABLE_ENTRY *et_entry) { if(!meth || !et_entry) { BAD_ARG(); return -1; } dl_insert_b(meth->exc_table, et_entry); return 0; } /** * Returns a new code graph node initialized with the given opcode, operand, * and pc. * * @param meth -- The method containing the instruction. * @param op -- The opcode of the instruction. * @param operand -- The instruction's operand. * * @returns The new code graph node with this opcode. */ JVM_CODE_GRAPH_NODE * bc_new_graph_node(JVM_METHOD *meth, JVM_OPCODE op, u4 operand) { JVM_CODE_GRAPH_NODE *tmp; if(!meth) { BAD_ARG(); return NULL; } tmp = (JVM_CODE_GRAPH_NODE *)malloc(sizeof(JVM_CODE_GRAPH_NODE)); if(!tmp) return NULL; tmp->op = op; tmp->operand = operand; tmp->width = bc_op_width(op); /* set pc and branch targets later */ tmp->pc = meth->pc; tmp->branch_target = NULL; tmp->next = NULL; tmp->branch_label = NULL; tmp->stack_depth = -1; tmp->visited = FALSE; return tmp; } /** * Creates a new method structure with the given access flags. * * @param cclass -- The class to which the new method should be added. * @param name -- The name of the method. * @param desc -- The method descriptor. This can be NULL initially but * the method descriptor must be set before calling bc_write_class(). * @param flags -- The access flags for the method. * * @returns Pointer to the new method structure. * Returns NULL on error. */ JVM_METHOD * bc_new_method(JVM_CLASS *cclass, char *name, char *desc, unsigned int flags) { JVM_METHOD *meth; int lv_start; int c; u2 acc; if(!cclass || !name) { BAD_ARG(); return NULL; } #define err_new_meth() \ if(meth && meth->name) free(meth->name); \ free(meth); acc = (u2) flags; if((unsigned int)acc != flags) debug_err("Warning: possible truncation in bc_new_method.\n"); meth = (JVM_METHOD *)malloc(sizeof(JVM_METHOD)); if(!meth) return NULL; meth->access_flags = acc; meth->class = cclass; meth->gen_bytecode = TRUE; /* if this is a static method, then local variables are numbered * starting at 0, otherwise they start at 1. */ if(acc & JVM_ACC_STATIC) lv_start = 0; else lv_start = 1; debug_msg("access flags = %d\n", flags); meth->name = strdup(name); if(!meth->name) { err_new_meth(); return NULL; } c = cp_find_or_insert(cclass, CONSTANT_Utf8, name); if(c < 0) { err_new_meth(); return NULL; } meth->name_index = c; if(desc) { c = cp_find_or_insert(cclass, CONSTANT_Utf8, desc); if(c < 0) { err_new_meth(); return NULL; } meth->descriptor_index = c; /* if there was a descriptor specified, then go ahead and * set the current local and maximum variable numbers. */ meth->cur_local_number = lv_start + num_locals_in_descriptor(desc); meth->max_locals = meth->cur_local_number; } else { /* no descriptor specified yet. we will rely on the user to set * it later. for now set the index to 0 which should cause a * verification error in case the user forgets to set a proper * descriptor index. */ meth->descriptor_index = 0; meth->cur_local_number = 1; meth->max_locals = 1; } meth->attributes = make_dl(); meth->attributes_count = 0; meth->cur_code = new_code_attr(cclass); meth->line_table = make_dl(); meth->locals_table = make_dl(); meth->label_list = make_dl(); meth->exc_table = make_dl(); if(!meth->attributes || !meth->line_table || !meth->locals_table || !meth->label_list || !meth->exc_table) { if(meth->attributes) dl_delete_list(meth->attributes); if(meth->line_table) dl_delete_list(meth->line_table); if(meth->locals_table) dl_delete_list(meth->locals_table); if(meth->label_list) dl_delete_list(meth->label_list); if(meth->exc_table) dl_delete_list(meth->exc_table); if(meth->cur_code) bc_free_code_attribute(cclass, meth->cur_code); meth->attributes = NULL; meth->line_table = NULL; meth->locals_table = NULL; meth->label_list = NULL; meth->exc_table = NULL; meth->cur_code = NULL; err_new_meth(); return NULL; } meth->lastOp = jvm_nop; meth->stacksize = meth->pc = meth->num_handlers = 0; cclass->methods_count++; dl_insert_b(cclass->methods, meth); return meth; } /** * Removes the specified method from its containing class. * * @param meth -- The method to be removed. * * @returns 0 on success, -1 on failure. */ int bc_remove_method(JVM_METHOD *meth) { JVM_METHOD *tmpmeth; Dlist tmpPtr; if(!meth) { BAD_ARG(); return -1; } dl_traverse(tmpPtr,meth->class->methods) { tmpmeth = (JVM_METHOD *) tmpPtr->val; if(tmpmeth == meth) { meth->class->methods_count--; dl_delete_node(tmpPtr); return 0; } } return -1; } /** * Gets the number of bytes of code in this method. * * @param meth -- The method whose length should be returned. * * @returns The code length (in bytes). Returns -1 on failure. */ int bc_get_code_length(JVM_METHOD *meth) { if(!meth) { BAD_ARG(); return -1; } return meth->pc; } /** * Gets the instruction following this instruction. * * @param node -- Pointer to an instruction node. * * @returns The next instruction. */ JVM_CODE_GRAPH_NODE * bc_get_next_instr(JVM_CODE_GRAPH_NODE *node) { if(!node) { BAD_ARG(); return NULL; } return node->next; } /** * Sets the stack depth at the given instruction. Most of the * time it won't be necessary to use this call, however there * may be some exceptional circumstances that require manually * setting the stack depth. * * @param node -- The instruction node for which the stack depth * should be set. * @param depth -- The depth in number of stack entries. * * @returns 0 on success, -1 on failure. */ int bc_set_stack_depth(JVM_CODE_GRAPH_NODE *node, int depth) { if(!node) { BAD_ARG(); return -1; } node->stack_depth = depth; return 0; } /** * Gets the last opcode in the given method. * * @param meth -- Pointer to a method structure. * * @returns The last opcode (see the JVM_OPCODE enum). Returns -1 on failure. */ JVM_OPCODE bc_get_last_opcode(JVM_METHOD *meth) { if(!meth) { BAD_ARG(); return -1; } return meth->lastOp; } /** * Sets the method descriptor index in the specified method. This would be * useful in situations where you don't know the descriptor when the method * is first created. * * @param meth -- The method whose descriptor should be set. * @param desc -- The method descriptor. * * @returns 0 on success, -1 on failure. */ int bc_set_method_descriptor(JVM_METHOD *meth, char *desc) { int c; if(!meth) { BAD_ARG(); return -1; } if(desc) { c = cp_find_or_insert(meth->class, CONSTANT_Utf8, desc); if(c < 0) return -1; meth->descriptor_index = c; } return 0; } /** * Creates a new local variable table attribute. * * @param meth -- The method which will contain the local variable table. * * @returns Pointer to the new local variable table attribute. * Returns NULL on error. */ JVM_ATTRIBUTE * bc_new_local_variable_table_attr(JVM_METHOD *meth) { JVM_ATTRIBUTE * tmp; int c; Dlist list_tmp, entries, const_table; if(!meth) { BAD_ARG(); return NULL; } const_table = meth->class->constant_pool; entries = meth->locals_table; tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!tmp) return NULL; c = cp_find_or_insert(meth->class, CONSTANT_Utf8, "LocalVariableTable"); if(c < 0) { free(tmp); return NULL; } tmp->attribute_name_index = c; tmp->attribute_length = 0; tmp->attr.LocalVariableTable = (struct LocalVariableTable_attribute *) malloc(sizeof(struct LocalVariableTable_attribute)); if(!tmp->attr.LocalVariableTable) { free(tmp); return NULL; } tmp->attr.LocalVariableTable->local_variable_table_length = 0; dl_traverse(list_tmp, entries) { JVM_LOCAL_VARIABLE_TABLE_ENTRY *entry; entry = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *)list_tmp->val; c = cp_find_or_insert(meth->class, CONSTANT_Utf8, entry->name); if(c < 0) { free(tmp); return NULL; } entry->name_index = c; c = cp_find_or_insert(meth->class, CONSTANT_Utf8, entry->descriptor); if(c < 0) { free(tmp); return NULL; } entry->descriptor_index = c; if(!entry->end) entry->end = dl_last(meth->cur_code->attr.Code->code)->val; tmp->attr.LocalVariableTable->local_variable_table_length++; } /* each local var table entry is 10 bytes, plus 2 bytes for the length */ tmp->attribute_length = (tmp->attr.LocalVariableTable->local_variable_table_length * 10) + 2; tmp->attr.LocalVariableTable->local_variable_table = entries; return tmp; } /** * Creates a new line number table attribute. * * @param meth -- The method which will contain the line number table. * * @returns Pointer to the new line number table attribute. * Returns NULL on error. */ JVM_ATTRIBUTE * bc_new_line_number_table_attr(JVM_METHOD *meth) { JVM_ATTRIBUTE * tmp; int c; Dlist list_tmp, entries; if(!meth) { BAD_ARG(); return NULL; } entries = meth->line_table; tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!tmp) return NULL; c = cp_find_or_insert(meth->class, CONSTANT_Utf8, "LineNumberTable"); if(c < 0) { free(tmp); return NULL; } tmp->attribute_name_index = c; tmp->attribute_length = 0; tmp->attr.LineNumberTable = (struct LineNumberTable_attribute *) malloc(sizeof(struct LineNumberTable_attribute)); if(!tmp->attr.LineNumberTable) { free(tmp); return NULL; } tmp->attr.LineNumberTable->line_number_table_length = 0; dl_traverse(list_tmp, entries) { tmp->attr.LineNumberTable->line_number_table_length++; } /* each line number table entry is 4 bytes, plus 2 bytes for the length */ tmp->attribute_length = (tmp->attr.LineNumberTable->line_number_table_length * 4) + 2; tmp->attr.LineNumberTable->line_number_table = entries; return tmp; } /** * Creates a new attribute structure and initializes the * Exception_attribute section with some initial values. * * @param cclass -- The class which will contain the attribute. * * @returns Pointer to the new exceptions attribute. * Returns NULL on error. */ JVM_ATTRIBUTE * bc_new_exceptions_attr(JVM_CLASS *cclass) { JVM_ATTRIBUTE * tmp; int c; if(!cclass) { BAD_ARG(); return NULL; } tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!tmp) return NULL; c = cp_find_or_insert(cclass, CONSTANT_Utf8, "Exceptions"); if(c < 0) { free(tmp); return NULL; } tmp->attribute_name_index = c; tmp->attr.Exceptions = (struct Exceptions_attribute *) malloc(sizeof(struct Exceptions_attribute)); if(!tmp->attr.Exceptions) { free(tmp); return NULL; } /* initially the attribute length is 2 which covers the size of the * 2-byte length field. */ tmp->attribute_length = 2; tmp->attr.Exceptions->number_of_exceptions = (u2) 0; tmp->attr.Exceptions->exception_index_table = make_dl(); if(!tmp->attr.Exceptions->exception_index_table) { free(tmp->attr.Exceptions); free(tmp); return NULL; } return tmp; } /** * Creates a new InnerClasses attribute structure. * * @param cclass -- The class which will contain the attribute. * * @returns Pointer to the new InnerClasses attribute. * Returns NULL on error. */ JVM_ATTRIBUTE * bc_new_inner_classes_attr(JVM_CLASS *cclass) { JVM_ATTRIBUTE * tmp; int c; if(!cclass) { BAD_ARG(); return NULL; } tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!tmp) return NULL; c = cp_find_or_insert(cclass, CONSTANT_Utf8, "InnerClasses"); if(c < 0) { free(tmp); return NULL; } tmp->attribute_name_index = c; tmp->attr.InnerClasses = (struct InnerClasses_attribute *) malloc(sizeof(struct InnerClasses_attribute)); if(!tmp->attr.InnerClasses) { free(tmp); return NULL; } /* initially the attribute length is 2 which covers the size of the * 2-byte length field. */ tmp->attribute_length = 2; tmp->attr.InnerClasses->number_of_classes = (u2) 0; tmp->attr.InnerClasses->classes = make_dl(); if(!tmp->attr.InnerClasses->classes) { free(tmp->attr.InnerClasses); free(tmp); return NULL; } return tmp; } /** * This function 'releases' a local variable. That is, calling this * function signifies that we no longer need this local variable. * * @param meth -- The method containing the local variable. * @param vtype -- The JVM data type of the variable (see the JVM_DATA_TYPE * enum). * * @returns The current local variable number. Returns -1 on error. */ int bc_release_local(JVM_METHOD *meth, JVM_DATA_TYPE vtype) { if(!meth) { BAD_ARG(); return -1; } if((vtype == jvm_Double) || (vtype == jvm_Long)) meth->cur_local_number-=2; else meth->cur_local_number--; return meth->cur_local_number; } /** * This function returns the next available local variable number and * updates the max if necessary. * * @param meth -- The method containing the local variable. * @param vtype -- The JVM data type of the variable (see the JVM_DATA_TYPE * enum). * * @returns The next local variable number. Returns -1 on error. */ int bc_get_next_local(JVM_METHOD *meth, JVM_DATA_TYPE vtype) { if(!meth) { BAD_ARG(); return -1; } if((vtype == jvm_Double) || (vtype == jvm_Long)) meth->cur_local_number+=2; else meth->cur_local_number++; if(meth->cur_local_number > meth->max_locals) meth->max_locals = meth->cur_local_number; return meth->cur_local_number - (((vtype == jvm_Double) || (vtype == jvm_Long)) ? 2 : 1); } /** * Sets the current local variable number for this method. If the new value * is greater than the current maximum number of locals, then the max_locals * field is set also. * * @param meth -- The method whose local variable number should be set. * @param curlocal -- The current local variable number. * * @returns 0 on success, -1 on failure. */ int bc_set_cur_local_num(JVM_METHOD *meth, unsigned int curlocal) { if(!meth) { BAD_ARG(); return -1; } meth->cur_local_number = curlocal; if(curlocal > meth->max_locals) meth->max_locals = curlocal; return 0; } /** * Allow suspending the generation of bytecode for situations in which the * code generation ordering is very different between java source and JVM * bytecode. * * @param meth -- The method to suspend/enable bytecode generation. * @param value -- If TRUE, calls which generate code (e.g. bc_append()) * will actually add the instructions to the code graph. If FALSE, you * can still call these routines, but they will have no effect. * * @returns 0 on success, -1 on failure. */ int bc_set_gen_status(JVM_METHOD *meth, BOOL value) { if(!meth) { BAD_ARG(); return -1; } meth->gen_bytecode = value; return 0; } /** * Creates the bytecode for a new default constructor and adds it to the * given class. * * @param cur_class -- The class for which the default constructor should * be created. * @param acc_flag -- The access flags for the constructor (for example * JVM_ACC_PUBLIC, JVM_ACC_STATIC, etc) * * @returns Pointer to the new constructor (a JVM_METHOD structure). * Returns NULL on error. */ JVM_METHOD * bc_add_default_constructor(JVM_CLASS *cur_class, u2 acc_flag) { JVM_METHOD *meth_tmp; char *cur_sc; CP_NODE *c; int idx; if(!cur_class) { BAD_ARG(); return NULL; } c = cp_entry_by_index(cur_class, cur_class->super_class); if(!c) return NULL; c = cp_entry_by_index(cur_class, c->val->cpnode.Class.name_index); if(!c) return NULL; cur_sc = cp_null_term_utf8(c->val); if(!cur_sc) return NULL; meth_tmp = bc_new_method(cur_class, "", "()V", acc_flag); if(!meth_tmp) { free(cur_sc); return NULL; } idx = bc_new_methodref(cur_class, cur_sc, "", "()V"); if(idx < 0) { free(cur_sc); return NULL; } bytecode0(meth_tmp, jvm_aload_0); bytecode1(meth_tmp, jvm_invokespecial, idx); bytecode0(meth_tmp, jvm_return); bc_set_cur_local_num(meth_tmp, 1); free(cur_sc); return meth_tmp; } /** * Creates bytecode for a new multi dimensional array. * * @param meth -- The method to which this instruction should be added. * @param dimensions -- The number of dimensions to be created. * @param desc -- The descriptor of the array. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_new_multi_array(JVM_METHOD *meth, u4 dimensions, char *desc) { u4 operand; int c; if(!meth || !desc) { BAD_ARG(); return NULL; } c = cp_find_or_insert(meth->class, CONSTANT_Class, desc); if(c < 0) return NULL; operand = (c<<8) | dimensions; return bytecode1(meth, jvm_multianewarray, operand); } /** * Generates an instruction to load the specified field onto the * stack (jvm_getfield). * * @param meth -- The method to which this instruction should be added. * @param class -- The name of the class containing the field. * @param field -- The field name. * @param desc -- The field descriptor. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_get_field(JVM_METHOD *meth, char *class, char *field, char *desc) { int field_idx; if(!meth || !class || !field || !desc) { BAD_ARG(); return NULL; } field_idx = bc_new_fieldref(meth->class, class, field, desc); if(field_idx < 0) return NULL; return bytecode1(meth, jvm_getfield, field_idx); } /** * Generates an instruction to store the top stack value to the * specified field (jvm_putfield). * * @param meth -- The method to which this instruction should be added. * @param class -- The name of the class containing the field. * @param field -- The field name. * @param desc -- The field descriptor. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_put_field(JVM_METHOD *meth, char *class, char *field, char *desc) { int field_idx; if(!meth || !class || !field || !desc) { BAD_ARG(); return NULL; } field_idx = bc_new_fieldref(meth->class, class, field, desc); if(field_idx < 0) return NULL; return bytecode1(meth, jvm_putfield, field_idx); } /** * Generates an instruction to load the specified static field onto the * stack (jvm_getstatic). * * @param meth -- The method to which this instruction should be added. * @param class -- The name of the class containing the field. * @param field -- The field name. * @param desc -- The field descriptor. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_get_static(JVM_METHOD *meth, char *class, char *field, char *desc) { int field_idx; if(!meth || !class || !field || !desc) { BAD_ARG(); return NULL; } field_idx = bc_new_fieldref(meth->class, class, field, desc); if(field_idx < 0) return NULL; return bytecode1(meth, jvm_getstatic, field_idx); } /** * Generates an instruction to store the top stack value to the * specified static field (jvm_putstatic). * * @param meth -- The method to which this instruction should be added. * @param class -- The name of the class containing the field. * @param field -- The field name. * @param desc -- The field descriptor. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_put_static(JVM_METHOD *meth, char *class, char *field, char *desc) { int field_idx; if(!meth || !class || !field || !desc) { BAD_ARG(); return NULL; } field_idx = bc_new_fieldref(meth->class, class, field, desc); if(field_idx < 0) return NULL; return bytecode1(meth, jvm_putstatic, field_idx); } /** * Generates an "instanceof" instruction which determines whether the * operand on top of the stack is an instance of the specified class. * * @param meth -- The method to which this instruction should be added. * @param class -- The name of the class which the object might be an * instance of. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_instanceof(JVM_METHOD *meth, char *class) { int c; if(!meth || !class) { BAD_ARG(); return NULL; } c = cp_find_or_insert(meth->class, CONSTANT_Class, class); if(c < 0) return NULL; return bytecode1(meth, jvm_instanceof, c); } /** * Generates a "checkcast" instruction which determines whether the * operand on top of the stack is of the specified type. * * @param meth -- The method to which this instruction should be added. * @param class -- The name of the class which might be the object's type. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_checkcast(JVM_METHOD *meth, char *class) { int c; if(!meth || !class) { BAD_ARG(); return NULL; } c = cp_find_or_insert(meth->class, CONSTANT_Class, class); if(c < 0) return NULL; return bytecode1(meth, jvm_checkcast, c); } /** * Generates a switch instruction. This will either be a "tableswitch" or * a "lookupswitch" depending on how many empty cases there are after all * cases have been specified. When most of the cases are specified, then * the "tableswitch" instruction is used, but if the switch is more sparsely * filled with cases, the "lookupswitch" would use less space. The value * defined for JVM_SWITCH_FILL_THRESH in bytecode.h determines how many empty * cases there must be before the "lookupswitch" is used. * * @param meth -- The method to which this instruction should be added. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_switch(JVM_METHOD *meth) { JVM_CODE_GRAPH_NODE *instr; if(!meth) { BAD_ARG(); return NULL; } instr = bytecode0(meth, jvm_tableswitch); instr->switch_info = (JVM_SWITCH_INFO *)malloc(sizeof(JVM_SWITCH_INFO)); if(!instr->switch_info) return NULL; /* we will calculate the cell padding, and low/high case numbers later */ instr->switch_info->cell_padding = 0; instr->switch_info->low = 0; instr->switch_info->high = 0; instr->switch_info->offsets = make_dl(); instr->switch_info->num_entries = 0; if(!instr->switch_info->offsets) { free(instr->switch_info); return NULL; } /* the width is unknown at this time, but it doesn't matter because * the real width will be calculated later. */ instr->width = bc_op_width(jvm_tableswitch); return instr; } /** * Adds another case to the given switch instruction. * * @param instr -- The node of the switch instruction. * @param target -- The node of the first instruction in the case to be added. * @param case_num -- The integer corresponding to this case. * * @returns 0 on success, -1 on failure. */ int bc_add_switch_case(JVM_CODE_GRAPH_NODE *instr, JVM_CODE_GRAPH_NODE *target, int case_num) { JVM_SWITCH_ENTRY *newcase; if(!instr || !target) { BAD_ARG(); return -1; } if(dl_empty(instr->switch_info->offsets)) { instr->switch_info->low = case_num; instr->switch_info->high = case_num; } else { if(case_num < instr->switch_info->low) instr->switch_info->low = case_num; if(case_num > instr->switch_info->high) instr->switch_info->high = case_num; } newcase = (JVM_SWITCH_ENTRY *)malloc(sizeof(JVM_SWITCH_ENTRY)); if(!newcase) return -1; newcase->instr = target; newcase->case_num = case_num; dl_insert_b(instr->switch_info->offsets, newcase); instr->switch_info->num_entries++; return 0; } /** * Specifies the default case for the given switch instruction. * * @param instr -- The node of the switch instruction. * @param target -- The node of the first instruction in the default * case to be added. * * @returns 0 on success, -1 on failure. */ int bc_add_switch_default(JVM_CODE_GRAPH_NODE *instr, JVM_CODE_GRAPH_NODE *target) { if(!instr || !target) { BAD_ARG(); return -1; } instr->switch_info->default_case = target; return 0; } /** * Sets the branch target of a JVM_CODE_GRAPH_NODE (that is, which instruction * this instruction branches to, either conditionally or unconditionally). * * @param node -- The node of the conditional or unconditional branching * instruction. * @param target -- The target of the branch instruction. * * @returns 0 on success, -1 on failure. */ int bc_set_branch_target(JVM_CODE_GRAPH_NODE *node, JVM_CODE_GRAPH_NODE *target) { if(!node || !target) { BAD_ARG(); return -1; } node->branch_target = target; return 0; } /** * Sets the label to which this instruction branches. This is used * when implementing languages which can branch forward to labeled * statements. Thus the forward instruction does not need to have been * emitted when the branch target is set. Later the address will be * resolved. * * @param node -- The node of the branch instruction. * @param label -- The label to which the instruction branches. * * @returns 0 on success, -1 on failure. */ int bc_set_branch_label(JVM_CODE_GRAPH_NODE *node, const char *label) { if(!node || !label) { BAD_ARG(); return -1; } node->branch_label = strdup(label); if(!node->branch_label) return -1; return 0; } /** * Same as bc_set_branch_label() except that the label is specified * as an integer instead of a string. * * @param node -- The node of the branch instruction. * @param label -- The label to which the instruction branches. * * @returns 0 on success, -1 on failure. */ int bc_set_integer_branch_label(JVM_CODE_GRAPH_NODE *node, int label_num) { char label[20]; if(!node) { BAD_ARG(); return -1; } sprintf(label, "%d", label_num); return bc_set_branch_label(node, label); } /** * Generates an iinc instruction. First check if the iinc needs to be * preceeded by a jvm_wide opcode and generate that if necessary. The wide * instruction is required if the local variable index or the immediate * operand would exceed a one-byte value. * * @param meth -- The method to which this instruction should be added. * @param idx -- The index of the local variable to be incremented. * @param inc_const -- The constant value to add to the specified local variable. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_iinc(JVM_METHOD *meth, unsigned int idx, int inc_const) { unsigned int operand; if(!meth) { BAD_ARG(); return NULL; } if((idx > 255) || (inc_const < -128) || (inc_const > 127)) { bytecode0(meth, jvm_wide); operand = ((idx & 0xFFFF) << 16) | ((u2)inc_const & 0xFFFF); } else operand = ((idx & 0xFF) << 8) | (inc_const & 0xFF); return bytecode1(meth, jvm_iinc, operand); } /** * This function returns a pointer to the next field type in this descriptor. * * @param str -- The descriptor to be parsed. * * @returns Pointer to the beginning of the next field in the descriptor. * If there are no more field types this function returns NULL. On error, * this function also returns NULL. */ char * bc_next_desc_token(char *str) { char *p = str; if(!str) { BAD_ARG(); return NULL; } switch(*p) { case 'B': case 'C': case 'D': case 'F': case 'I': case 'J': case 'S': case 'Z': return p+1; case 'L': while((*p != ';') && (*p != '\0')) p++; if(*p == '\0') { debug_err("bc_next_desc_token() incomplete classname in desc\n"); return NULL; } return p+1; case '[': return bc_next_desc_token(p+1); case '(': /* we should hit this case at the beginning of the descriptor */ return p+1; case ')': return NULL; default: debug_err("bc_next_desc_token() unrecognized char in desc:%s\n",str); return NULL; } /* should never reach here */ } /** * Generates a return instruction. This can be used in a generic way * and when the class is emitted, the proper type-specific return * instruction is generated based on the method descriptor. * * @param meth -- The method to which this instruction should be added. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_return(JVM_METHOD *meth) { if(!meth) { BAD_ARG(); return NULL; } return bytecode0(meth, jvm_return); } /** * Pushes an integer constant onto the stack. The exact instruction * generated depends on the value of the constant (sipush, bipush, etc). * * @param meth -- The method to which this instruction should be added. * @param ival -- The integer constant to be loaded. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_push_int_const(JVM_METHOD *meth, int ival) { JVM_CODE_GRAPH_NODE *node = NULL; int ct; if(!meth) { BAD_ARG(); return NULL; } ct = cp_find_or_insert(meth->class, CONSTANT_Integer, (void*)&ival); if(ct >= 0) { if(ct > CP_IDX_MAX) node = bytecode1(meth, jvm_ldc_w,ct); else node = bytecode1(meth, jvm_ldc,ct); } else { /* not found, use literal */ if((ival < JVM_SHORT_MIN) || (ival > JVM_SHORT_MAX)) { debug_err("WARNING:expr_emit() bad int literal: %d\n", ival); return NULL; } else if((ival < JVM_BYTE_MIN) || (ival > JVM_BYTE_MAX)) node = bytecode1(meth, jvm_sipush, ival); else if((ival < JVM_ICONST_MIN) || (ival > JVM_ICONST_MAX)) node = bytecode1(meth, jvm_bipush, ival); else node = bytecode0(meth, jvm_iconst_op[ival+1]); } return node; } /** * Pushes a null object value onto the stack. * * @param meth -- The method to which this instruction should be added. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_push_null_const(JVM_METHOD *meth) { if(!meth) { BAD_ARG(); return NULL; } return bytecode0(meth, jvm_aconst_null); } /** * Pushes a float constant onto the stack. * * @param meth -- The method to which this instruction should be added. * @param fval -- The floating point value to be loaded. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_push_float_const(JVM_METHOD *meth, float fval) { JVM_CODE_GRAPH_NODE *node = NULL; int ct; if(!meth) { BAD_ARG(); return NULL; } ct = cp_find_or_insert(meth->class, CONSTANT_Float, (void*)&fval); if(ct >= 0) { if(ct > CP_IDX_MAX) node = bytecode1(meth, jvm_ldc_w,ct); else node = bytecode1(meth, jvm_ldc,ct); } else if(fval == 0.0) node = bytecode0(meth, jvm_fconst_0); else if(fval == 1.0) node = bytecode0(meth, jvm_fconst_1); else if(fval == 2.0) node = bytecode0(meth, jvm_fconst_2); else debug_err("bc_push_float_const(): bad float precision literal\n"); return node; } /** * Pushes a double constant onto the stack. * * @param meth -- The method to which this instruction should be added. * @param dval -- The double precision floating point value to be loaded. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_push_double_const(JVM_METHOD *meth, double dval) { JVM_CODE_GRAPH_NODE *node = NULL; int ct; if(!meth) { BAD_ARG(); return NULL; } ct = cp_find_or_insert(meth->class, CONSTANT_Double, (void*)&dval); if(ct >= 0) node = bytecode1(meth, jvm_ldc2_w, ct); else if(dval == 0.0) node = bytecode0(meth, jvm_dconst_0); else if(dval == 1.0) node = bytecode0(meth, jvm_dconst_1); else debug_err("bc_push_double_const(): bad double precision literal\n"); return node; } /** * Pushes a long constant onto the stack. * * @param meth -- The method to which this instruction should be added. * @param lval -- The long constant to be loaded. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_push_long_const(JVM_METHOD *meth, long long lval) { JVM_CODE_GRAPH_NODE *node = NULL; int ct; if(!meth) { BAD_ARG(); return NULL; } ct = cp_find_or_insert(meth->class, CONSTANT_Long, (void*)&lval); if(ct >= 0) node = bytecode1(meth, jvm_ldc2_w, ct); else if(lval == 0) node = bytecode0(meth, jvm_lconst_0); else if(lval == 1) node = bytecode0(meth, jvm_lconst_1); else debug_err("bc_push_long_const(): bad literal\n"); return node; } /** * Pushes a string constant onto the stack. * * @param meth -- The method to which this instruction should be added. * @param str -- The string value to be loaded. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_push_string_const(JVM_METHOD *meth, char *str) { JVM_CODE_GRAPH_NODE *node = NULL; int ct; if(!meth || !str) { BAD_ARG(); return NULL; } ct = cp_find_or_insert(meth->class, CONSTANT_String, (void*)str); if(ct < 0) return NULL; if(ct > CP_IDX_MAX) node = bytecode1(meth, jvm_ldc_w, ct); else node = bytecode1(meth, jvm_ldc, ct); return node; } /** * This function searches the list of nodes for the given PC. Returns the * node if found, otherwise NULL. This is not very efficient - we should * probably modify it eventually if it becomes an issue. * * @param meth -- The method to which this instruction should be added. * @param num -- The address of the node to find. * * @returns Pointer to the instruction node with the specified address. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_node_at_pc(JVM_METHOD *meth, int num) { JVM_CODE_GRAPH_NODE *nodeptr; Dlist tmp; if(!meth) { BAD_ARG(); return NULL; } dl_traverse(tmp, meth->cur_code->attr.Code->code) { nodeptr = (JVM_CODE_GRAPH_NODE *)tmp->val; if(nodeptr->pc == (unsigned int)num) return nodeptr; if(nodeptr->pc > (unsigned int)num) return NULL; } return NULL; } /** * Get the width of the specified op. * * @param op -- The op to return the length of. * * @returns The width in bytes of this op, including operands. */ u1 bc_op_width(JVM_OPCODE op) { return jvm_opcode[op].width; } /** * Given the local variable number, this function generates a store opcode * to store a value to the local var. * * @param meth -- The method to which this instruction should be added. * @param lvnum -- The local variable number to which the value should * be stored. * @param rt -- The JVM data type of the local variable (see the enumeration * JVM_DATA_TYPE). * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_store_op(JVM_METHOD *meth, unsigned int lvnum, JVM_DATA_TYPE rt) { JVM_CODE_GRAPH_NODE *node; if(!meth) { BAD_ARG(); return NULL; } if(lvnum > 255) { node = bytecode0(meth, jvm_wide); bytecode1(meth, jvm_store_op[rt], lvnum); } else if(lvnum <= 3) node = bytecode0(meth, jvm_short_store_op[rt][lvnum]); else node = bytecode1(meth, jvm_store_op[rt], lvnum); updateMaxLocals(meth, lvnum, rt); return node; } /** * Given the local variable number, this function generates a load opcode * to load a value from the local var. * * @param meth -- The method to which this instruction should be added. * @param lvnum -- The local variable from which the value should be loaded. * @param rt -- The JVM data type of the local variable (see the enumeration * JVM_DATA_TYPE). * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_load_op(JVM_METHOD *meth, unsigned int lvnum, JVM_DATA_TYPE rt) { JVM_CODE_GRAPH_NODE *node; if(!meth) { BAD_ARG(); return NULL; } if(lvnum > 255) { node = bytecode0(meth, jvm_wide); bytecode1(meth, jvm_load_op[rt], lvnum); } else if(lvnum <= 3) node = bytecode0(meth, jvm_short_load_op[rt][lvnum]); else node = bytecode1(meth, jvm_load_op[rt], lvnum); updateMaxLocals(meth, lvnum, rt); return node; } /** * This function generates a load opcode to load a value from an array. * * @param meth -- The method to which this instruction should be added. * @param rt -- The JVM data type of the array (see the enumeration * JVM_DATA_TYPE). * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_array_load_op(JVM_METHOD *meth, JVM_DATA_TYPE rt) { if(!meth) { BAD_ARG(); return NULL; } return bytecode0(meth, jvm_array_load_op[rt]); } /** * This function generates a store opcode to store a value to an array. * * @param meth -- The method to which this instruction should be added. * @param rt -- The JVM data type of the array (see the enumeration * JVM_DATA_TYPE). * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_array_store_op(JVM_METHOD *meth, JVM_DATA_TYPE rt) { if(!meth) { BAD_ARG(); return NULL; } return bytecode0(meth, jvm_array_store_op[rt]); } /** * Generates an instruction to create a new object of the specified class. * Note: this does not completely create a new instance. For that, you will * still need to call the constructor. * * @param meth -- The method to which this instruction should be added. * @param classname -- The name of the class to be created. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_new_obj(JVM_METHOD *meth, char *classname) { int c; char *class; if(!meth || !classname) { BAD_ARG(); return NULL; } class = char_substitute(classname, '.', '/'); if(!class) return NULL; c = cp_find_or_insert(meth->class, CONSTANT_Class, class); free(class); if(c < 0) return NULL; return bc_append(meth, jvm_new, c); } /** * Generates two instructions. The first creates a new object of the * specified class. The second instruction duplicates the new object. * * @param meth -- The method to which this instruction should be added. * @param classname -- The name of the class to be created. * * @returns Pointer to the instruction node (the first instruction). * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_new_obj_dup(JVM_METHOD *meth, char *classname) { JVM_CODE_GRAPH_NODE *newobj; if(!meth || !classname) { BAD_ARG(); return NULL; } newobj = bc_gen_new_obj(meth, classname); if(!newobj) return NULL; bc_append(meth, jvm_dup); return newobj; } /** * Generates a sequence of instructions which completely creates a new * instance of the specified class which must have a constructor with no * arguments. * * @param meth -- The method to which this instruction should be added. * @param classname -- The name of the class to be created. * * @returns Pointer to the first instruction node in the sequence (it will * be the jvm_new instruction). Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_obj_instance_default(JVM_METHOD *meth, char *classname) { JVM_CODE_GRAPH_NODE *newobj; int meth_idx; if(!meth || !classname) { BAD_ARG(); return NULL; } newobj = bc_gen_new_obj_dup(meth, classname); if(!newobj) return NULL; meth_idx = bc_new_methodref(meth->class, classname, "", "()V"); if(meth_idx < 0) return NULL; bc_append(meth, jvm_invokespecial, meth_idx); return newobj; } /** * Generates the instructions to create a new array for any type except * objects (use bc_gen_new_object_array() for objects). * * This will generate an instruction to push the specified size onto the * stack. If you want to omit that instruction (if you're pushing the * size yourself before calling this function), then just specify -1 as * the size. * * @param meth -- The method to which this instruction should be added. * @param size -- The size of the array to be created (-1 to omit the * instruction to push this value). * @param rt -- The JVM data type of the array (see the enumeration * JVM_DATA_TYPE). * * @returns Pointer to the first instruction node emitted. This will * either be an integer load (if the size was specified) or the * jvm_newarray instruction. Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_new_array(JVM_METHOD *meth, int size, JVM_DATA_TYPE rt) { JVM_CODE_GRAPH_NODE *node, *first; if(!meth) { BAD_ARG(); return NULL; } first = NULL; if(size >= 0) first = bc_push_int_const(meth, size); if(rt == jvm_Object) debug_err( "Warning: bc_gen_new_array() shouldn't be used for objects\n"); node = bytecode1(meth, jvm_newarray, jvm_newarray_type[rt]); if(first) return first; else return node; } /** * Generates the instructions to create a new object array. * * This will push the specified size onto the stack. If you want to omit * that instruction (if you're pushing the size yourself before calling this * function), then just specify -1 as the size. * * @param meth -- The method to which this instruction should be added. * @param size -- The size of the array to be created (-1 to omit the * instruction to push this value). * @param class -- The name of the class which represents the data type of * the array elements. * * @returns Pointer to the first instruction node emitted. This will * either be an integer load (if the size was specified) or the * jvm_newarray instruction. Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_gen_new_object_array(JVM_METHOD *meth, int size, char *class) { JVM_CODE_GRAPH_NODE *node, *first; int c; char *tmp; if(!meth || !class) { BAD_ARG(); return NULL; } first = NULL; if(size >= 0) first = bc_push_int_const(meth, size); tmp = char_substitute(class, '.', '/'); if(!tmp) return NULL; c = cp_find_or_insert(meth->class, CONSTANT_Class, tmp); free(tmp); if(c < 0) return NULL; node = bytecode1(meth, jvm_anewarray, c); if(first) return first; else return node; } /** * This function creates a new method reference and inserts it into the * constant pool if necessary. The return value is a pointer to the * constant pool node containing the method reference. * * @param class -- Class containing the constant pool where this * method reference will be stored. * @param cname -- The name of the class. * @param mname -- The name of the method. * @param dnmae -- The method descriptor. * * @returns The constant pool index of the method reference. * Returns -1 on failure. */ int bc_new_methodref(JVM_CLASS *class, char *cname, char *mname, char *dname) { JVM_METHODREF *methodref; int retval; if(!class || !cname || !mname || !dname) { BAD_ARG(); return -1; } methodref = bc_new_method_node(cname,mname,dname); if(!methodref) return -1; retval = cp_find_or_insert(class, CONSTANT_Methodref, methodref); bc_free_fieldref(methodref); return retval; } /** * This function creates a new interface method reference and inserts it * into the constant pool if necessary. The return value is a pointer to * the constant pool node containing the interface method reference. * * @param class -- Class containing the constant pool where this * interface reference will be stored. * @param cname -- The name of the class. * @param mname -- The name of the method. * @param dnmae -- The method descriptor. * * @returns The constant pool index of the interface reference. * Returns -1 on failure. */ int bc_new_interface_methodref(JVM_CLASS *class, char *cname, char *mname, char *dname) { JVM_METHODREF *interfaceref; int retval; if(!class || !cname || !mname || !dname) { BAD_ARG(); return -1; } interfaceref = bc_new_method_node(cname,mname,dname); if(!interfaceref) return -1; retval = cp_find_or_insert(class, CONSTANT_InterfaceMethodref, interfaceref); bc_free_interfaceref(interfaceref); return retval; } /** * This function creates a new method 'node' initialized with the given * values for class name, method name, and descriptor. * * @param cname -- The name of the class. * @param mname -- The name of the method. * @param dnmae -- The method descriptor. * * @returns Pointer to the created method reference node. */ JVM_METHODREF * bc_new_method_node(char *cname, char *mname, char *dname) { JVM_METHODREF *methodref; if(!cname || !mname || !dname) { BAD_ARG(); return NULL; } debug_msg("%%%% new node '%s','%s','%s'\n", cname,mname,dname); methodref = (JVM_METHODREF *)malloc(sizeof(JVM_METHODREF)); if(!methodref) return NULL; methodref->classname = char_substitute(cname, '.', '/'); methodref->methodname = strdup(mname); methodref->descriptor = char_substitute(dname, '.', '/'); if(!methodref->classname || !methodref->methodname || !methodref->descriptor) { if(methodref->classname) free(methodref->classname); if(methodref->methodname) free(methodref->methodname); if(methodref->descriptor) free(methodref->descriptor); free(methodref); return NULL; } return methodref; } /** * This function creates a new reference to a name and descriptor in the * constant pool. * * @param class -- Class containing the constant pool where this * namd-and-type reference will be stored. * @param name -- The name of the item. * @param desc -- The descriptor of the item. * * @returns The constant pool index of the name-and-type reference. * Returns -1 on failure. */ int bc_new_name_and_type(JVM_CLASS *class, char *name, char *desc) { JVM_METHODREF *nameref; int retval; if(!class || !name || !desc) { BAD_ARG(); return -1; } nameref = (JVM_METHODREF *)malloc(sizeof(JVM_METHODREF)); if(!nameref) return -1; nameref->classname = NULL; nameref->methodname = strdup(name); nameref->descriptor = char_substitute(desc, '.', '/'); if(!nameref->methodname || !nameref->descriptor) { bc_free_nameandtype(nameref); return -1; } retval = cp_find_or_insert(class, CONSTANT_NameAndType, nameref); bc_free_nameandtype(nameref); return retval; } /** * This function creates a new field reference and inserts it into the * constant pool if necessary. The return value is a pointer to the * constant pool node containing the field reference. * * @param class -- Class containing the constant pool where this * field reference will be stored. * @param cname -- The name of the class. * @param mname -- The name of the field. * @param dnmae -- The field descriptor. * * @returns The constant pool index of the interface reference. * Returns -1 on failure. */ int bc_new_fieldref(JVM_CLASS *class, char *cname, char *mname, char *dname) { JVM_METHODREF *fieldref; int retval; if(!class || !cname || !mname || !dname) { BAD_ARG(); return -1; } fieldref = bc_new_method_node(cname, mname, dname); if(!fieldref) return -1; retval = cp_find_or_insert(class, CONSTANT_Fieldref, fieldref); bc_free_fieldref(fieldref); return retval; } /** * This function associates a label with a particular instruction. * This information is used later to calculate the branch target * offsets for branch instructions whose targets were labels. * See the bc_set_branch_label() function. * * Misc notes: this function creates a JVM_BRANCH_PC struct and fills * it in with the pc and label number. This is then inserted into the * method info struct. Used later by calc_offsets for goto stmts. * * @param meth -- The method containing the branch and target instructions. * @param node -- The node of the target (that is, the instruction which * corresponds to the label in the source code). * @param label -- The label specified for this instruction. * * @returns 0 on success, -1 on failure. */ int bc_associate_branch_label(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *node, const char *label) { JVM_BRANCH_PC *bp; if(!meth || !node) { BAD_ARG(); return -1; } bp = (JVM_BRANCH_PC *)malloc(sizeof(JVM_BRANCH_PC)); if(!bp) return -1; bp->instr = node; bp->label = strdup(label); dl_insert_b(meth->label_list, bp); return 0; } /** * This function associates a label with a particular instruction. * Same as bc_associate_branch_label() except that the label is * specified as an integer rather than string. * * @param meth -- The method containing the branch and target instructions. * @param node -- The node of the target (that is, the instruction which * corresponds to the label in the source code). * @param label_num -- The label number specified for this instruction. * * @returns 0 on success, -1 on failure. */ int bc_associate_integer_branch_label(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *node, int label_num) { char label[20]; if(!meth || !node) { BAD_ARG(); return -1; } sprintf(label, "%d", label_num); return bc_associate_branch_label(meth, node, label); } /** * This function gets a variable length argument and calls the appropriate * routine. All routines deal with appending an opcode instruction to a * methods code array. * * @param meth -- The method to which this instruction should be added. * @param op -- The opcode to be generated. * @param ... -- The remaining arguments represent the operands of the * instruction. * * @returns Pointer to the instruction node. * Returns NULL on error. */ JVM_CODE_GRAPH_NODE * bc_append(JVM_METHOD *meth, JVM_OPCODE op, ...) { JVM_CODE_GRAPH_NODE *cgNode; int inv_idx, inv_cnt; va_list pvar; u1 index, value; u2 dimensions, idx2; u4 operand; if(!meth) { BAD_ARG(); return NULL; } va_start(pvar, op); switch(op) { case jvm_multianewarray: idx2 = (u2)va_arg(pvar, int); dimensions = (u1)va_arg(pvar, int); operand =(idx2<<8) | dimensions; cgNode = bytecode1(meth, jvm_multianewarray, operand); break; case jvm_tableswitch: case jvm_lookupswitch: cgNode = bc_gen_switch(meth); break; case jvm_invokeinterface: inv_idx = va_arg(pvar, int); inv_cnt = va_arg(pvar, int); operand = (inv_idx << 16) | (inv_cnt << 8); cgNode = bytecode1(meth, op, operand); break; case jvm_xxxunusedxxx: cgNode = bytecode0(meth, op); break; case jvm_goto: cgNode = bytecode0(meth, op); break; case jvm_jsr: cgNode = bytecode0(meth, op); break; case jvm_iinc: index = (u1)va_arg(pvar, int); value = (u1)va_arg(pvar, int); cgNode = bc_gen_iinc(meth, index, value); break; default: if(jvm_opcode[op].width <= 1) { cgNode = bytecode0(meth, op); } else if(jvm_opcode[op].width > 1) { operand = (u4)va_arg(pvar, int); cgNode = bytecode1(meth, op, operand); } } va_end(pvar); return cgNode; } /** * Given a file path, open and create directories along the way, if needed. * * @param file -- The name of the file to be opened. * @param mode -- The file creation mode (man fopen(3)). * @param output_dir -- The prefix for the full file name (if NULL, just * open the file in the current directory). * * @returns A file pointer to the created file. */ FILE * bc_fopen_fullpath(char *file, char *mode, char *output_dir) { char *pwd = NULL, *prev = NULL, *segment = NULL, *full_file = NULL; struct stat *buf = NULL; int cur_size; FILE *f; #define err_fopen_full() \ if(buf) free(buf); \ if(pwd) free(pwd); \ if(segment) free(segment); \ if(full_file) free(full_file); if(!file) { BAD_ARG(); return NULL; } if(!mode) mode = "wb"; cur_size = 2; pwd = (char *)malloc(cur_size); if(!pwd) return NULL; buf = (struct stat *)malloc(sizeof(struct stat)); if(!buf) { err_fopen_full(); return NULL; } while(getcwd(pwd, cur_size) == NULL) { char *tmp; cur_size *= 2; tmp = pwd; pwd = (char *)realloc(pwd,cur_size); if(!pwd) { free(tmp); err_fopen_full(); return NULL; } } if(output_dir != NULL) { full_file = (char *)malloc(strlen(output_dir) + strlen(file) + 3); strcpy(full_file, output_dir); if(output_dir[strlen(output_dir)-1] != BC_FILE_DELIM[0]) strcat(full_file, BC_FILE_DELIM); strcat(full_file, file); } else full_file = strdup(file); if(!full_file) { err_fopen_full(); return NULL; } debug_msg("full_file = '%s'\n", full_file); if( stat(full_file, buf) == 0) if(! S_ISREG(buf->st_mode) ) { err_fopen_full(); return NULL; } if( (f = fopen(full_file, mode)) != NULL ) { err_fopen_full(); return f; } if(full_file[0] == BC_FILE_DELIM[0]) chdir(BC_FILE_DELIM); prev = strtok(full_file, BC_FILE_DELIM); while( (segment = strtok(NULL,BC_FILE_DELIM)) != NULL ) { if( stat(prev, buf) == -1) { if(errno == ENOENT) { #ifdef _WIN32 if(mkdir(prev) == -1) { #else if(mkdir(prev, 0755) == -1) { #endif chdir(pwd); err_fopen_full(); return NULL; } } else { chdir(pwd); err_fopen_full(); return NULL; } } else { if(! S_ISDIR(buf->st_mode)) { chdir(pwd); err_fopen_full(); return NULL; } } if(chdir(prev) == -1) { chdir(pwd); err_fopen_full(); return NULL; } prev = segment; } if( (f = fopen(prev, mode)) != NULL ) { chdir(pwd); err_fopen_full(); return f; } chdir(pwd); free(full_file); free(buf); free(pwd); return NULL; } /** * Frees a method info structure. * * @param m -- The method to be freed. */ void bc_free_method(JVM_METHOD *m) { JVM_ATTRIBUTE *code_attr = NULL; if(!m) { BAD_ARG(); return; } code_attr = find_attribute(m->class,m->attributes,"Code"); bc_free_attributes(m->class, m->attributes); m->attributes = NULL; /* if this method was abstract or native, then the code graph would not * have been inserted as an attribute to this method (because such methods * do not have any code). therefore the code graph (actually a Dlist) * would not have been freed yet, so we free it here. */ if(!code_attr) { bc_free_code_attribute(m->class, m->cur_code); m->cur_code = NULL; } if(m->exc_table) dl_delete_list(m->exc_table); bc_free_locals_table(m); bc_free_line_number_table(m); bc_free_label_list(m); m->attributes = NULL; m->exc_table = NULL; m->label_list = NULL; m->line_table = NULL; if(m->name) free(m->name); free(m); } /** * Frees a line number table. * * @param m -- The method containing the line number table. */ void bc_free_line_number_table(JVM_METHOD *m) { Dlist tmp; dl_traverse(tmp, m->line_table) { free(dl_val(tmp)); } dl_delete_list(m->line_table); m->line_table = NULL; } /** * Frees a local variable table. * * @param m -- The method containing the local variable table. */ void bc_free_locals_table(JVM_METHOD *m) { Dlist tmp; dl_traverse(tmp, m->locals_table) { JVM_LOCAL_VARIABLE_TABLE_ENTRY * loc; loc = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *) dl_val(tmp); if(loc->name) free(loc->name); if(loc->descriptor) free(loc->descriptor); free(loc); } dl_delete_list(m->locals_table); m->locals_table = NULL; } /** * Frees the list of branch labels in a method. * * @param m -- The method containing the local variable table. */ void bc_free_label_list(JVM_METHOD *m) { Dlist tmp; dl_traverse(tmp, m->label_list) { JVM_BRANCH_PC *bp = (JVM_BRANCH_PC *)dl_val(tmp); free(bp->label); free(bp); } dl_delete_list(m->label_list); m->label_list = NULL; } /** * Frees a class (and frees all fields of the class file structure). * * @param class -- The class to be freed. */ void bc_free_class(JVM_CLASS *class) { if(!class) { BAD_ARG(); return; } bc_free_interfaces(class); bc_free_fields(class); bc_free_methods(class); bc_free_attributes(class, class->attributes); /* NOTE: free constant pool last. */ bc_free_constant_pool(class); free(class); } /** * Frees the list of interfaces the class implements. * * @param class -- The class containing the list of interfaces. */ void bc_free_interfaces(JVM_CLASS *class) { int * tmpconst; Dlist tmpPtr; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->interfaces) { tmpconst = (int *) tmpPtr->val; free(tmpconst); } dl_delete_list(class->interfaces); class->interfaces = NULL; } /** * Frees the constant pool. * * @param class -- The class containing the constant pool. */ void bc_free_constant_pool(JVM_CLASS *class) { CP_NODE * tmpconst; Dlist tmpPtr; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->constant_pool) { tmpconst = (CP_NODE *) tmpPtr->val; if(tmpconst->val->tag == CONSTANT_Utf8) free(tmpconst->val->cpnode.Utf8.bytes); free(tmpconst->val); free(tmpconst); } dl_delete_list(class->constant_pool); class->constant_pool = NULL; } /** * Frees the list of fields of this class. * * @param class -- The class containing the list of fields. */ void bc_free_fields(JVM_CLASS *class) { JVM_FIELD *tmpfield; Dlist tmpPtr; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->fields) { tmpfield = (JVM_FIELD *) tmpPtr->val; bc_free_attributes(class, tmpfield->attributes); free(tmpfield); } dl_delete_list(class->fields); class->fields = NULL; } /** * Frees the list of methods of this class. * * @param class -- The class containing the list of methods. */ void bc_free_methods(JVM_CLASS *class) { Dlist tmpPtr; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->methods) { bc_free_method((JVM_METHOD *) tmpPtr->val); } dl_delete_list(class->methods); class->methods = NULL; } /** * Frees a list of attributes. The attribute list may correspond to * a class, method, or field. * * @param class -- The class containing the constant pool relevant to * the attributes. * @param attr_list -- The attribute list to be freed. */ void bc_free_attributes(JVM_CLASS *class, Dlist attr_list) { JVM_ATTRIBUTE *tmpattr; char *attr_name; Dlist tmpPtr, tmpPtr2; CP_NODE *c; if(!attr_list || !class) { BAD_ARG(); return; } dl_traverse(tmpPtr,attr_list) { tmpattr = (JVM_ATTRIBUTE *) tmpPtr->val; c = cp_entry_by_index(class, tmpattr->attribute_name_index); if(c==NULL) { debug_err("WARNING: bc_free_attributes() can't find attr name\n"); continue; } attr_name = cp_null_term_utf8(c->val); if(!attr_name) continue; if(!strcmp(attr_name,"SourceFile")) { free(tmpattr->attr.SourceFile); free(tmpattr); } else if(!strcmp(attr_name,"Deprecated") || !strcmp(attr_name,"Synthetic")) { free(tmpattr); } else if(!strcmp(attr_name,"LocalVariableTable")) { free(tmpattr->attr.LocalVariableTable); free(tmpattr); } else if(!strcmp(attr_name,"LineNumberTable")) { free(tmpattr->attr.LineNumberTable); free(tmpattr); } else if(!strcmp(attr_name,"InnerClasses")) { dl_traverse(tmpPtr2, tmpattr->attr.InnerClasses->classes) free(tmpPtr2->val); dl_delete_list(tmpattr->attr.InnerClasses->classes); free(tmpattr->attr.InnerClasses); free(tmpattr); } else if(!strcmp(attr_name,"ConstantValue")) { free(tmpattr->attr.ConstantValue); free(tmpattr); } else if(!strcmp(attr_name,"Code")) { bc_free_code_attribute(class, tmpattr); } else if(!strcmp(attr_name,"Exceptions")) { dl_traverse(tmpPtr2, tmpattr->attr.Exceptions->exception_index_table) free(tmpPtr2->val); dl_delete_list(tmpattr->attr.Exceptions->exception_index_table); tmpattr->attr.Exceptions->exception_index_table = NULL; free(tmpattr->attr.Exceptions); free(tmpattr); } else { /* if the attribute name doesn't match any of the known attributes * then assume it's a user defined attribute. */ free(tmpattr->attr.UserDefined->data); free(tmpattr->attr.UserDefined); free(tmpattr); } free(attr_name); } dl_delete_list(attr_list); } /** * Frees a code attribute. * * @param class -- The class containing the constant pool relevant to * the code attribute. * @param attr -- The code attribute to be freed. */ void bc_free_code_attribute(JVM_CLASS *class, JVM_ATTRIBUTE *attr) { if(!attr) { BAD_ARG(); return; } bc_free_code(attr->attr.Code->code); if(attr->attr.Code->exception_table_length > 0) free(attr->attr.Code->exception_table); if((attr->attr.Code->attributes_count > 0) && (class != NULL)) bc_free_attributes(class, attr->attr.Code->attributes); else dl_delete_list(attr->attr.Code->attributes); attr->attr.Code->attributes = NULL; free(attr->attr.Code); free(attr); } /** * Frees the list of instruction nodes. * * @param g -- The list of instructions to be freed. */ void bc_free_code(Dlist g) { Dlist tmp; int i; if(!g) { BAD_ARG(); return; } dl_traverse(tmp, g) { JVM_CODE_GRAPH_NODE *instr = (JVM_CODE_GRAPH_NODE *)dl_val(tmp); if((instr->op == jvm_tableswitch) || (instr->op == jvm_lookupswitch)) { dl_delete_list(instr->switch_info->offsets); for(i=0;iswitch_info->num_entries;i++) free(instr->switch_info->sorted_entries[i]); free(instr->switch_info->sorted_entries); free(instr->switch_info); } if(instr->branch_label) free(instr->branch_label); free(tmp->val); } dl_delete_list(g); } /** * This function frees memory previously allocated for a fieldref. * * @param fieldref -- The field reference to be freed. */ void bc_free_fieldref(JVM_METHODREF *fieldref) { if(!fieldref) { BAD_ARG(); return; } free(fieldref->classname); free(fieldref->methodname); free(fieldref->descriptor); free(fieldref); } /** * This function frees memory previously allocated for a methodref. * * @param methodref -- The method reference to be freed. */ void bc_free_methodref(JVM_METHODREF *methodref) { if(!methodref) { BAD_ARG(); return; } bc_free_fieldref(methodref); } /** * This function frees memory previously allocated for an interface method * reference. * * @param interfaceref -- The interface reference to be freed. */ void bc_free_interfaceref(JVM_METHODREF *interfaceref) { if(!interfaceref) { BAD_ARG(); return; } bc_free_fieldref(interfaceref); } /** * This function frees memory previously allocated for a name and descriptor * reference. * * @param nameref -- The name-and-type reference to be freed. */ void bc_free_nameandtype(JVM_METHODREF *nameref) { if(!nameref) { BAD_ARG(); return; } bc_free_fieldref(nameref); } /***************************************************************************** ***************************************************************************** ** ** ** Functions after this point are not exposed as part of the API. ** ** ** ***************************************************************************** *****************************************************************************/ /** * Finds the given attribute in an attribute list. * Returns NULL if the attribute cannot be found. * * @param class -- The class containing the constant pool relevant to * the attribute. * @param attr_list -- The list of attributes to be searched. * @param attr -- The name of the attribute to find. * * @returns Pointer to the attribute, if found. If the attribute is not * found, returns NULL. */ static JVM_ATTRIBUTE * find_attribute(JVM_CLASS *class, Dlist attr_list, char *attr) { JVM_ATTRIBUTE *tmpattr; char *attr_name; Dlist tmpPtr; CP_NODE *c; if(!attr_list || !class || !attr) { BAD_ARG(); return NULL; } dl_traverse(tmpPtr,attr_list) { tmpattr = (JVM_ATTRIBUTE *) tmpPtr->val; c = cp_entry_by_index(class, tmpattr->attribute_name_index); if(c == NULL) { debug_err("WARNING: find_attribute() can't find attr name\n"); continue; } attr_name = cp_null_term_utf8(c->val); if(!attr_name) continue; if(!strcmp(attr_name,attr)) { free(attr_name); return tmpattr; } free(attr_name); } return NULL; } /** * Creates a new attribute structure and initializes the Code_attribute * section with some initial values. * * @param cclass -- The class containing the constant pool relevant to * the attribute. * * @returns Pointer to the new attribute. */ static JVM_ATTRIBUTE * new_code_attr(JVM_CLASS *cclass) { JVM_ATTRIBUTE * tmp; int c; if(!cclass) { BAD_ARG(); return NULL; } tmp = (JVM_ATTRIBUTE *)malloc(sizeof(JVM_ATTRIBUTE)); if(!tmp) return NULL; c = cp_find_or_insert(cclass, CONSTANT_Utf8, "Code"); if(c < 0) { free(tmp); return NULL; } tmp->attribute_name_index = c; tmp->attribute_length = 0; tmp->attr.Code = (struct Code_attribute *) malloc(sizeof(struct Code_attribute)); if(!tmp->attr.Code) { free(tmp); return NULL; } tmp->attr.Code->max_stack = 0; tmp->attr.Code->max_locals = 0; tmp->attr.Code->code_length = 0; tmp->attr.Code->code = make_dl(); tmp->attr.Code->exception_table_length = 0; tmp->attr.Code->exception_table = NULL; tmp->attr.Code->attributes_count = 0; tmp->attr.Code->attributes = make_dl(); if(!tmp->attr.Code->code || !tmp->attr.Code->attributes) { if(tmp->attr.Code->code) dl_delete_list(tmp->attr.Code->code); if(tmp->attr.Code->attributes) dl_delete_list(tmp->attr.Code->attributes); tmp->attr.Code->code = NULL; tmp->attr.Code->attributes = NULL; free(tmp->attr.Code); tmp->attr.Code = NULL; free(tmp); return NULL; } return tmp; } /** * Inserts the given instruction into the code graph. * * @param meth -- The method to which this instruction should be added. * @param op -- The opcode to be generated. * * @returns Pointer to the instruction node. * Returns NULL on error. */ static JVM_CODE_GRAPH_NODE * bytecode0(JVM_METHOD *meth, JVM_OPCODE op) { if(!meth) { BAD_ARG(); return NULL; } return bytecode1(meth, op,0); } /** * Inserts the given instruction into the code graph. * * @param meth -- The method to which this instruction should be added. * @param op -- The opcode to be generated. * @param operand -- The operand to this instruction. * * @returns Pointer to the instruction node. * Returns NULL on error. */ static JVM_CODE_GRAPH_NODE * bytecode1(JVM_METHOD *meth, JVM_OPCODE op, u4 operand) { JVM_CODE_GRAPH_NODE *tmp, *prev; if(!meth) { BAD_ARG(); return NULL; } /* if we should not generate bytecode, then just return a dummy node */ if(!meth->gen_bytecode) { JVM_CODE_GRAPH_NODE *g; /* keep track of the dummy node so that we may reclaim the memory later. */ g = bc_new_graph_node(meth, op, operand); return g; } meth->lastOp = op; if(meth->cur_code->attr.Code->code == NULL) debug_err("ERROR: null code graph.\n"); prev = (JVM_CODE_GRAPH_NODE *) dl_val(dl_last(meth->cur_code->attr.Code->code)); if((prev != NULL) && (prev->op == jvm_xxxunusedxxx)) { prev->op = op; prev->operand = operand; prev->width = bc_op_width(op); meth->pc += bc_op_width(op) - bc_op_width(jvm_xxxunusedxxx); return prev; } tmp = bc_new_graph_node(meth, op, operand); if(!tmp) return NULL; if(prev != NULL) prev->next = tmp; dl_insert_b(meth->cur_code->attr.Code->code, tmp); /* if the previous instruction was 'wide', then we need to * increase the width of this instruction. */ if((prev != NULL) && (prev->op == jvm_wide)) { if( (op == jvm_iload) || (op == jvm_fload) || (op == jvm_aload) || (op == jvm_lload) || (op == jvm_dload) || (op == jvm_istore) || (op == jvm_fstore) || (op == jvm_astore) || (op == jvm_lstore) || (op == jvm_dstore) || (op == jvm_ret)) tmp->width = bc_op_width(op) + 1; else if(op == jvm_iinc) tmp->width = bc_op_width(op) + 2; else debug_err("Error: bad op used after wide instruction (%s)\n", jvm_opcode[op].op); } meth->pc += tmp->width; return tmp; } /** * Given a local variable number (which presumably is the target of some * load/store or other instruction that uses a local), make sure that the * total number of local variables for this method is large enough to * accommodate the specified local variable. If not, then update it based * on the given number. * * @param meth -- The current method. * @param lvnum -- The local variable number being used in some instruction. * @param rt -- The JVM data type of the local variable (see the enumeration * JVM_DATA_TYPE). */ static void updateMaxLocals(JVM_METHOD *meth, unsigned int lvnum, JVM_DATA_TYPE rt) { int max = lvnum + jvm_localvar_width[rt]; if(!meth) { BAD_ARG(); return; } if(max > meth->max_locals) meth->max_locals = max; } /** * Given a method descriptor, this function returns the number of local * variables needed to hold the arguments. doubles and longs use 2 local * vars, while every other data type only uses 1 local. * * @param d -- The method descriptor. * * @returns The number of local variables in this descriptor. */ static int num_locals_in_descriptor(char *d) { int vlen = 0; if(!d) { BAD_ARG(); return 0; } while( (d = bc_next_desc_token(d)) != NULL) { /* if the next token is NULL, then we have no more useful tokens in * this descriptor. */ if(bc_next_desc_token(d) == NULL) break; if((d[0] == 'D') || (d[0] == 'J')) vlen += 2; else vlen++; } return vlen; } /** * This function substitutes every occurrence of 'from_char' with 'to_char' * typically this is used to convert package names: * * e.g. "java.lang.whatever" -> "java/lang/whatever" * * Space for the modified string is allocated by this function. * * @param str -- The string to be converted. * @param from_char -- The character to change from. * @param to_char -- The character to change to. * * @returns The modified string (in newly allocated memory). */ static char * char_substitute(char *str, int from_char, int to_char) { char *newstr, *idx; if(!str) { BAD_ARG(); return NULL; } newstr = strdup(str); if(!newstr) return NULL; while( (idx = strchr(newstr, from_char)) != NULL ) *idx = to_char; return newstr; } f2j-0.8.1/libbytecode/api.h0000600000077700002310000000132411031241063015451 0ustar seymourgraduate#ifndef _API_H #define _API_H #include #include #include #include #include #include #include #ifdef _WIN32 #include #else #include #endif #ifdef _WIN32 #define BC_FILE_DELIM "\\" #else #define BC_FILE_DELIM "/" #endif #include "bytecode.h" static JVM_ATTRIBUTE *find_attribute(JVM_CLASS *, Dlist, char *), *new_code_attr(JVM_CLASS *); static JVM_CODE_GRAPH_NODE *bytecode0(JVM_METHOD *, JVM_OPCODE), *bytecode1(JVM_METHOD *, JVM_OPCODE, u4); static void updateMaxLocals(JVM_METHOD *, unsigned int, JVM_DATA_TYPE); static int num_locals_in_descriptor(char *); static char *char_substitute(char *, int, int); #endif f2j-0.8.1/libbytecode/bytecode.h0000600000077700002310000007121611031241063016505 0ustar seymourgraduate/* bytecode.h. Generated by configure. */ /** @file */ /***************************************************************************** * bytecode.h * * * * Main include file for the bytecode library. Users of the library can * * just include this single header file in their code. * * * *****************************************************************************/ #ifndef _BYTECODE_H #define _BYTECODE_H #include #include #include #include"dlist.h" /* Define if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ /* #undef WORDS_BIGENDIAN */ #define JVM_MAX_RETURNS 7 #define TRUE 1 #define FALSE 0 /***************************************************************************** * CPIDX_MAX is the largest index that can be used with the ldc instruction * * since it has a 1 byte operand. For values larger than CPIDX_MAX, we must * * generate ldc_w. * *****************************************************************************/ #define CP_IDX_MAX 255 /* MAX_CODE_LEN: Currently a method can only have 64k of code. */ #define JVM_MAX_CODE_LEN 65535 /* * If there are more than JVM_SWITCH_FILL_THRESH empty cases in a switch, then * use lookupswitch instead of tableswitch. */ #define JVM_SWITCH_FILL_THRESH 10 /* * Definitions of class/field/method modifiers: */ #define JVM_ACC_PUBLIC 0x0001 #define JVM_ACC_PRIVATE 0x0002 #define JVM_ACC_PROTECTED 0x0004 #define JVM_ACC_STATIC 0x0008 #define JVM_ACC_FINAL 0x0010 #define JVM_ACC_SYNCHRONIZED 0x0020 #define JVM_ACC_SUPER 0x0020 #define JVM_ACC_VOLATILE 0x0040 #define JVM_ACC_TRANSIENT 0x0080 #define JVM_ACC_NATIVE 0x0100 #define JVM_ACC_INTERFACE 0x0200 #define JVM_ACC_ABSTRACT 0x0400 #define JVM_ACC_STRICT 0x0800 /* * array data types for newarray opcode. */ #define JVM_T_UNUSED 0 #define JVM_T_BOOLEAN 4 #define JVM_T_CHAR 5 #define JVM_T_FLOAT 6 #define JVM_T_DOUBLE 7 #define JVM_T_BYTE 8 #define JVM_T_SHORT 9 #define JVM_T_INT 10 #define JVM_T_LONG 11 #define JVM_MAGIC 0xCAFEBABEu #define JVM_MINOR_VER 3 #define JVM_MAJOR_VER 45 /***************************************************************************** * * * Following are some constants that help determine which integer load * * instruction to use. * * * * if intval < JVM_SHORT_MIN or intval > JVM_SHORT_MAX, use ldc * * else if intval < JVM_BYTE_MIN or intval > JVM_BYTE_MAX, use sipush * * else if intval < JVM_ICONST_MIN or intval > JVM_ICONST_MAX, use bipush * * else use iconst_ * * * *****************************************************************************/ #define JVM_SHORT_MIN (-32768) #define JVM_SHORT_MAX 32767 #define JVM_BYTE_MIN (-128) #define JVM_BYTE_MAX 127 #define JVM_ICONST_MIN -1 #define JVM_ICONST_MAX 5 #define CP_INTEGER_CONST 277 #define CP_FLOAT_CONST 279 #define CP_DOUBLE_CONST 276 #define CP_LONG_CONST 282 #define CP_EXPONENTIAL_CONST 278 #define CP_TRUE_CONST 280 #define CP_FALSE_CONST 281 #define CP_STRING_CONST 304 #define CP_CHECK_NONZERO(str,val)\ if((val) == 0)\ fprintf(stderr,"Not expecting zero value (%s)\n", (str)) #define BAD_ARG() fprintf(stderr,"%s:%d -- bad arg.\n", __FILE__, __LINE__); #ifdef BC_DEBUG #define debug_msg(...) fprintf(stderr, __VA_ARGS__) #else #define debug_msg(...) /* nop */ #endif #ifdef BC_VIEW #define debug_err(...) fprintf(stderr, __VA_ARGS__) #else #define debug_err(...) /* nop */ #endif typedef int BOOL; typedef unsigned char u1; typedef unsigned short u2; typedef unsigned int u4; typedef unsigned long long u8; /* the following structure represents a single JVM instruction: */ typedef struct _jvm_op_info { char *op; /* character representation of opcode */ u1 width; /* width in bytes of the opcode + operands */ u1 stack_pre; /* stack before the operation */ u1 stack_post; /* stack after the operation */ } JVM_OP_INFO; /***************************************************************************** * Enumeration of all the JVM instruction opcodes. * *****************************************************************************/ typedef enum _opcode { jvm_nop = 0x0, jvm_aconst_null, jvm_iconst_m1, jvm_iconst_0, jvm_iconst_1, jvm_iconst_2, jvm_iconst_3, jvm_iconst_4, jvm_iconst_5, jvm_lconst_0, jvm_lconst_1, jvm_fconst_0, jvm_fconst_1, jvm_fconst_2, jvm_dconst_0, jvm_dconst_1, jvm_bipush, jvm_sipush, jvm_ldc, jvm_ldc_w, jvm_ldc2_w, jvm_iload, jvm_lload, jvm_fload, jvm_dload, jvm_aload, jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3, jvm_lload_0, jvm_lload_1, jvm_lload_2, jvm_lload_3, jvm_fload_0, jvm_fload_1, jvm_fload_2, jvm_fload_3, jvm_dload_0, jvm_dload_1, jvm_dload_2, jvm_dload_3, jvm_aload_0, jvm_aload_1, jvm_aload_2, jvm_aload_3, jvm_iaload, jvm_laload, jvm_faload, jvm_daload, jvm_aaload, jvm_baload, jvm_caload, jvm_saload, jvm_istore, jvm_lstore, jvm_fstore, jvm_dstore, jvm_astore, jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3, jvm_lstore_0, jvm_lstore_1, jvm_lstore_2, jvm_lstore_3, jvm_fstore_0, jvm_fstore_1, jvm_fstore_2, jvm_fstore_3, jvm_dstore_0, jvm_dstore_1, jvm_dstore_2, jvm_dstore_3, jvm_astore_0, jvm_astore_1, jvm_astore_2, jvm_astore_3, jvm_iastore, jvm_lastore, jvm_fastore, jvm_dastore, jvm_aastore, jvm_bastore, jvm_castore, jvm_sastore, jvm_pop, jvm_pop2, jvm_dup, jvm_dup_x1, jvm_dup_x2, jvm_dup2, jvm_dup2_x1, jvm_dup2_x2, jvm_swap, jvm_iadd, jvm_ladd, jvm_fadd, jvm_dadd, jvm_isub, jvm_lsub, jvm_fsub, jvm_dsub, jvm_imul, jvm_lmul, jvm_fmul, jvm_dmul, jvm_idiv, jvm_ldiv, jvm_fdiv, jvm_ddiv, jvm_irem, jvm_lrem, jvm_frem, jvm_drem, jvm_ineg, jvm_lneg, jvm_fneg, jvm_dneg, jvm_ishl, jvm_lshl, jvm_ishr, jvm_lshr, jvm_iushr, jvm_lushr, jvm_iand, jvm_land, jvm_ior, jvm_lor, jvm_ixor, jvm_lxor, jvm_iinc, jvm_i2l, jvm_i2f, jvm_i2d, jvm_l2i, jvm_l2f, jvm_l2d, jvm_f2i, jvm_f2l, jvm_f2d, jvm_d2i, jvm_d2l, jvm_d2f, jvm_i2b, jvm_i2c, jvm_i2s, jvm_lcmp, jvm_fcmpl, jvm_fcmpg, jvm_dcmpl, jvm_dcmpg, jvm_ifeq, jvm_ifne, jvm_iflt, jvm_ifge, jvm_ifgt, jvm_ifle, jvm_if_icmpeq, jvm_if_icmpne, jvm_if_icmplt, jvm_if_icmpge, jvm_if_icmpgt, jvm_if_icmple, jvm_if_acmpeq, jvm_if_acmpne, jvm_goto, jvm_jsr, jvm_ret, jvm_tableswitch, jvm_lookupswitch, jvm_ireturn, jvm_lreturn, jvm_freturn, jvm_dreturn, jvm_areturn, jvm_return, jvm_getstatic, jvm_putstatic, jvm_getfield, jvm_putfield, jvm_invokevirtual, jvm_invokespecial, jvm_invokestatic, jvm_invokeinterface, jvm_xxxunusedxxx, /* opcode 186 not used */ jvm_new, jvm_newarray, jvm_anewarray, jvm_arraylength, jvm_athrow, jvm_checkcast, jvm_instanceof, jvm_monitorenter, jvm_monitorexit, jvm_wide, jvm_multianewarray, jvm_ifnull, jvm_ifnonnull, jvm_goto_w, jvm_jsr_w, jvm_breakpoint, /* skip 203 - 253 */ jvm_impdep1 = 254, jvm_impdep2 } JVM_OPCODE; /***************************************************************************** * this structure holds information about the state of the stack before and * * after a method call. to correctly calculate the maximum stack depth, we * * need to know how many arguments an invoke[static,virtual,etc] instruction * * will pop off the stack. even though there is only one return value, it * * can occupy zero, one, or two stack entries depending on the return type * * of the method. * *****************************************************************************/ typedef struct _bc_stack_info { int arg_len, /* depth of stack when this method is invoked */ ret_len; /* depth of stack when this method returns */ } JVM_STACK_INFO; /**************************************************************************** * this structure is stored in the dlist label_list in a method info * * struct and is used by calc_offsets. * ****************************************************************************/ typedef struct _bc_branch_pc { struct _code_node *instr; /* instruction with this label */ char *label; /* the label number */ } JVM_BRANCH_PC; typedef struct _bc_switch_entry { struct _code_node *instr; int case_num; } JVM_SWITCH_ENTRY; typedef struct _bc_switch_info { int cell_padding; int low; int high; Dlist offsets; struct _code_node *default_case; int num_entries; struct _bc_switch_entry **sorted_entries; } JVM_SWITCH_INFO; typedef struct _code_node { JVM_OPCODE op; /* the opcode for this instruction */ u4 pc; /* the address in bytecode of this instruction */ u4 operand; /* this opcode's operand (may be u1, u2, u4) */ u1 width; /* width of this op (may vary with wide modifier)*/ struct _bc_switch_info * switch_info; /* parameters for tableswitch if appropriate */ struct _code_node * branch_target, /* the node to which we might optionally branch * * (comparison ops) or unconditionally branch */ * next; /* next op in code, but not necessarily next to * * execute since we may branch over it. */ char *branch_label; /* f77 label to which this instruction branches */ int stack_depth; /* stack depth prior to execution of this opcode */ BOOL visited; /* for traversal - has this node been visited? */ } JVM_CODE_GRAPH_NODE; typedef struct _bc_exception_table_entry { struct _code_node * from, /* PC at which the try block begins */ * to, /* PC at which the try block ends */ * target; /* PC at which the exception handler begins */ int catch_type; /* exception class corresponding to this catch */ } JVM_EXCEPTION_TABLE_ENTRY; typedef struct _bc_line_number_table_entry { struct _code_node *op; /* idx to code where original src stmt begins */ u2 line_number; /* the corresponding original line number */ } JVM_LINE_NUMBER_TABLE_ENTRY; typedef struct _bc_local_variable_table_entry { struct _code_node *start, /* start idx of valid range for this variable */ *end; /* end index of valid range for this variable */ char *name; /* name of this variable */ u2 name_index; /* cp index to name of variable */ char *descriptor; /* descriptor for this variable */ u2 descriptor_index; /* cp index to descriptor for variable */ u2 index; /* this variable's index into local var table */ } JVM_LOCAL_VARIABLE_TABLE_ENTRY; /* * Enumeration of the JVM data types. */ typedef enum jvm_data_type { jvm_Byte = 0x0, jvm_Short, jvm_Int, jvm_Long, jvm_Char, jvm_Float, jvm_Double, jvm_Object } JVM_DATA_TYPE; /* * Structures representing the JVM class file. */ typedef enum _constant_tags { CONSTANT_Utf8 = 1, /* 1 */ /* note missing tag 2 */ CONSTANT_Integer = 3, /* 3 */ CONSTANT_Float, /* 4 */ CONSTANT_Long, /* 5 */ CONSTANT_Double, /* 6 */ CONSTANT_Class, /* 7 */ CONSTANT_String, /* 8 */ CONSTANT_Fieldref, /* 9 */ CONSTANT_Methodref, /* 10 */ CONSTANT_InterfaceMethodref, /* 11 */ CONSTANT_NameAndType /* 12 */ } JVM_CONSTANT; typedef struct _bc_class_file { u4 magic; /* class file magic number: 0xCAFEBABE */ u2 minor_version; /* minor version of the class file */ u2 major_version; /* major version of the class file */ u2 constant_pool_count; /* num entries in constant pool + 1 */ Dlist constant_pool; /* constant pool:constant_pool_count-1 entries */ u2 access_flags; /* access permissions for this class */ u2 this_class; /* cp index to entry representing this class */ u2 super_class; /* cp index to superclass or 0 for Object */ u2 interfaces_count; /* number of superinterfaces for this class */ Dlist interfaces; /* list of interfaces (each entry a cp index) */ u2 fields_count; /* num fields, both class vars & instance vars */ Dlist fields; /* list of fields declared in this class */ u2 methods_count; /* number of methods in this class */ Dlist methods; /* list of methods */ u2 attributes_count; /* number of attributes for this class */ Dlist attributes; /* only SourceFile & Deprecated allowed here */ } JVM_CLASS; struct CONSTANT_Class_info { u2 name_index; /* index into constant pool */ }; struct CONSTANT_Methodref_info { u2 class_index; /* cp index of class which declares this field */ u2 name_and_type_index; /* cp index of name & descriptor of this field */ }; struct CONSTANT_String_info { u2 string_index; /* cp index of Utf8 rep of this string */ }; struct CONSTANT_Integer_info { u4 bytes; /* the integer value */ }; struct CONSTANT_Float_info { u4 bytes; /* the float value */ }; struct CONSTANT_Long_info { u4 high_bytes; /* the high bytes of the long value */ u4 low_bytes; /* the low bytes of the long value */ }; struct CONSTANT_Double_info { u4 high_bytes; /* the high bytes of the double value */ u4 low_bytes; /* the low bytes of the double value */ }; struct CONSTANT_NameAndType_info { u2 name_index; /* cp index of name or stored as Utf8 */ u2 descriptor_index; /* cp index of valid field, method descriptor */ }; struct CONSTANT_Utf8_info { u2 length; /* # bytes, not necessarily string length */ u1 *bytes; /* byte array containing the Utf8 string */ }; typedef struct _cp_info { u1 tag; union { struct CONSTANT_Class_info Class; struct CONSTANT_Methodref_info Methodref; struct CONSTANT_String_info String; struct CONSTANT_Integer_info Integer; struct CONSTANT_Float_info Float; struct CONSTANT_Long_info Long; struct CONSTANT_Double_info Double; struct CONSTANT_NameAndType_info NameAndType; struct CONSTANT_Utf8_info Utf8; } cpnode; } CP_INFO; typedef struct _field_info { u2 access_flags; /* access flags mask, see table 4.4 in vm spec */ u2 name_index; /* cp index of field name, rep. as Utf8 string */ u2 descriptor_index; /* cp index of valid field descriptor */ u2 attributes_count; /* number of additional field attributes */ Dlist attributes; /* attributes of this field */ struct _bc_class_file *class; /* the class containing this field */ } JVM_FIELD; typedef struct _method_info { u2 access_flags; /* access flags mask, see table 4.5 in vm spec */ u2 name_index; /* cp index of methodname, , or */ u2 descriptor_index; /* cp index of valid method descriptor */ u2 attributes_count; /* number of additional method attributes */ Dlist attributes; /* attributes of this method */ BOOL gen_bytecode; /* set to FALSE to suspend bytecode generation */ /* The following fields are not really part of the method struct as * defined by the JVM spec, but they're here for convenience. */ Dlist exc_table; /* list of exception table entries */ Dlist label_list; /* list of statements with label numbers */ BOOL reCalcAddr; /* Do node's addrs need to be recalculated? */ struct _attribute_info *cur_code; /* code attribute */ Dlist line_table, /* list of line number table entries */ locals_table; /* list of local variable table entries */ JVM_OPCODE lastOp; /* the last opcode emitted */ int stacksize; /* size of stack for current unit */ unsigned int cur_local_number, /* current local variable number */ max_locals, /* number of locals needed for this method */ num_handlers, /* number of exception handlers in this method */ pc; /* current program counter */ char *name; /* name of this method */ char *file; /* name of the file containing this method */ struct _bc_class_file *class; /* the class containing this method */ } JVM_METHOD; struct ConstantValue_attribute { u2 constantvalue_index; /* cp index to the actual constant value */ }; struct ExceptionTable { u2 start_pc; /* index into code of start opcode (inclusive) */ u2 end_pc; /* index into code of end opcode (exclusive) */ u2 handler_pc; /* start of exception handler code */ u2 catch_type; /* cp index of exception class to catch */ }; struct Code_attribute { u2 max_stack; /* max depth of operand stack for this method */ u2 max_locals; /* max num of local variables including params */ u4 code_length; /* number of bytes in the code array */ Dlist code; /* list containing code for this method */ u2 exception_table_length; /* number of entries in the exception table */ struct ExceptionTable * exception_table; /* table of exception handlers */ u2 attributes_count; /* number of additional code attributes */ Dlist attributes; /* attributes of this code */ }; struct Exceptions_attribute { u2 number_of_exceptions; /* number of entries in exception_index_table */ Dlist exception_index_table;/* table of exceptions a method can throw */ }; struct SourceFile_attribute { u2 sourcefile_index; /* cp index to name of source file (in Utf8) */ }; struct LineNumberTable_attribute { u2 line_number_table_length; /* number of entries in line_number_table */ Dlist line_number_table; /* list of line number table entries */ }; struct LocalVariableTable_attribute { u2 local_variable_table_length; /* number of entries in line_number_table */ Dlist local_variable_table; /* list of line number table entries */ }; struct InnerClassEntry { u2 inner_class_info_index; /* cp index to the inner class */ u2 outer_class_info_index; /* cp index to the outer (enclosing) class */ u2 inner_name_index; /* cp index to simple name of inner class */ u2 inner_class_access_flags; /* access flags for the inner class */ }; struct InnerClasses_attribute { u2 number_of_classes; /* number of entries in the classes array */ Dlist classes; /* list of inner class references */ }; struct UserDefined_attribute { void *data; }; typedef struct _attribute_info { u2 attribute_name_index; /* cp index to name of attribute (in Utf8) */ u4 attribute_length; /* # bytes pointed to by the info field */ union { struct ConstantValue_attribute * ConstantValue; struct Code_attribute * Code; struct Exceptions_attribute * Exceptions; void * Synthetic; struct SourceFile_attribute * SourceFile; struct LineNumberTable_attribute * LineNumberTable; struct LocalVariableTable_attribute * LocalVariableTable; struct InnerClasses_attribute * InnerClasses; struct UserDefined_attribute * UserDefined; } attr; } JVM_ATTRIBUTE; /* * We build a linked list containing all the constant pool entries. * Each entry in the list has the following structure: */ typedef struct _constListNode { unsigned int index; unsigned int next_idx; CP_INFO * val; } CP_NODE; /***************************************************************************** * this structure holds information about a method reference, including the * * name of the class which contains the method, the name of the method, and * * the method descriptor. * *****************************************************************************/ typedef struct _methodref { char *classname, *methodname, *descriptor; } JVM_METHODREF; /***************************************************************************** * Definitions of opcodes related to code generation. * *****************************************************************************/ extern const int jvm_newarray_type[JVM_MAX_RETURNS+1]; extern const JVM_OPCODE jvm_iconst_op[7], jvm_array_load_op[JVM_MAX_RETURNS+1], jvm_load_op[JVM_MAX_RETURNS+1], jvm_store_op[JVM_MAX_RETURNS+1], jvm_array_store_op[JVM_MAX_RETURNS+1], jvm_short_store_op[JVM_MAX_RETURNS+1][4], jvm_short_load_op[JVM_MAX_RETURNS+1][4]; extern const JVM_OP_INFO jvm_opcode[]; extern const int cp_entry_width[], jvm_localvar_width[]; /***************************************************************************** ** Function prototypes ** *****************************************************************************/ int bc_write_class(JVM_CLASS *, char *), bc_get_code_length(JVM_METHOD *), bc_add_user_defined_class_attr(JVM_CLASS *, char *, int, void *), bc_set_class_deprecated(JVM_CLASS *), bc_set_class_version(JVM_CLASS *, int, int), bc_add_class_interface(JVM_CLASS *, char *), bc_set_constant_value_attr(JVM_FIELD *, JVM_CONSTANT, const void *), bc_set_field_deprecated(JVM_FIELD *), bc_set_field_synthetic(JVM_FIELD *), bc_set_method_deprecated(JVM_METHOD *), bc_set_method_synthetic(JVM_METHOD *), bc_add_method_exception(JVM_METHOD *, char *), bc_add_inner_classes_attr(JVM_CLASS *, char *, char *, char *, int), bc_set_local_var_start(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *), bc_set_local_var_end(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *), bc_set_stack_depth(JVM_CODE_GRAPH_NODE *, int), bc_set_line_number(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int), bc_add_exception_handler(JVM_METHOD *, JVM_EXCEPTION_TABLE_ENTRY *), bc_remove_method(JVM_METHOD *), bc_set_method_descriptor(JVM_METHOD *, char *), bc_release_local(JVM_METHOD *, JVM_DATA_TYPE), bc_set_cur_local_num(JVM_METHOD *, unsigned int), bc_set_gen_status(JVM_METHOD *, BOOL), bc_add_switch_case(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, int), bc_add_switch_default(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *), bc_associate_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, const char *), bc_associate_integer_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int), bc_set_branch_target(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *), bc_set_branch_label(JVM_CODE_GRAPH_NODE *, const char *), bc_set_integer_branch_label(JVM_CODE_GRAPH_NODE *, int), bc_get_next_local(JVM_METHOD *, JVM_DATA_TYPE), bc_add_source_file_attr(JVM_CLASS *, char *), bc_new_methodref(JVM_CLASS *, char *, char *, char *), bc_new_name_and_type(JVM_CLASS *, char *, char *), bc_new_fieldref(JVM_CLASS *, char *, char *, char *), bc_new_interface_methodref(JVM_CLASS *, char *, char *, char *); void bc_free_method(JVM_METHOD *), bc_free_class(JVM_CLASS *), bc_free_constant_pool(JVM_CLASS *), bc_free_interfaces(JVM_CLASS *), bc_free_fields(JVM_CLASS *), bc_free_methods(JVM_CLASS *), bc_free_attributes(JVM_CLASS *, Dlist), bc_free_fieldref(JVM_METHODREF *), bc_free_nameandtype(JVM_METHODREF *), bc_free_methodref(JVM_METHODREF *), bc_free_interfaceref(JVM_METHODREF *), bc_free_code_attribute(JVM_CLASS *, JVM_ATTRIBUTE *), bc_free_line_number_table(JVM_METHOD *), bc_free_locals_table(JVM_METHOD *), bc_free_label_list(JVM_METHOD *), bc_free_code(Dlist); JVM_LOCAL_VARIABLE_TABLE_ENTRY *bc_set_local_var_name(JVM_METHOD *, int, char *, char *); char *bc_next_desc_token(char *), *bc_get_full_classname(char *, char *); FILE *bc_fopen_fullpath(char *, char *, char *); JVM_CLASS *bc_new_class(char *, char *, char *, char *, u2); JVM_METHOD *bc_new_method(JVM_CLASS *, char *, char *, unsigned int), *bc_add_default_constructor(JVM_CLASS *, u2); JVM_ATTRIBUTE *bc_new_inner_classes_attr(JVM_CLASS *), *bc_new_line_number_table_attr(JVM_METHOD *), *bc_new_local_variable_table_attr(JVM_METHOD *), *bc_new_synthetic_attr(JVM_CLASS *), *bc_new_deprecated_attr(JVM_CLASS *), *bc_new_exceptions_attr(JVM_CLASS *); JVM_FIELD *bc_add_field(JVM_CLASS *, char *, char *, u2); JVM_CODE_GRAPH_NODE *bc_get_next_instr(JVM_CODE_GRAPH_NODE *), *bc_new_graph_node(JVM_METHOD *, JVM_OPCODE, u4), *bc_push_int_const(JVM_METHOD *, int), *bc_push_null_const(JVM_METHOD *), *bc_push_double_const(JVM_METHOD *, double), *bc_push_float_const(JVM_METHOD *, float), *bc_push_long_const(JVM_METHOD *, long long), *bc_push_string_const(JVM_METHOD *, char *), *bc_gen_iinc(JVM_METHOD *, unsigned int, int), *bc_gen_switch(JVM_METHOD *), *bc_new_multi_array(JVM_METHOD *, u4, char *), *bc_get_field(JVM_METHOD *, char *, char *, char *), *bc_put_field(JVM_METHOD *, char *, char *, char *), *bc_get_static(JVM_METHOD *, char *, char *, char *), *bc_put_static(JVM_METHOD *, char *, char *, char *), *bc_gen_instanceof(JVM_METHOD *, char *), *bc_gen_checkcast(JVM_METHOD *, char *), *bc_append(JVM_METHOD *, JVM_OPCODE, ...), *bc_node_at_pc(JVM_METHOD *, int), *bc_gen_new_object_array(JVM_METHOD *, int, char *), *bc_gen_new_array(JVM_METHOD *, int, JVM_DATA_TYPE), *bc_gen_array_load_op(JVM_METHOD *, JVM_DATA_TYPE), *bc_gen_array_store_op(JVM_METHOD *, JVM_DATA_TYPE), *bc_gen_return(JVM_METHOD *), *bc_gen_new_obj(JVM_METHOD *, char *), *bc_gen_new_obj_dup(JVM_METHOD *, char *), *bc_gen_obj_instance_default(JVM_METHOD *, char *), *bc_gen_store_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE), *bc_gen_load_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE); JVM_EXCEPTION_TABLE_ENTRY *bc_new_exception_table_entry(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, char *); JVM_METHODREF *bc_new_method_node(char *, char *, char *); JVM_OPCODE bc_get_last_opcode(JVM_METHOD *); u1 bc_op_width(JVM_OPCODE); CP_NODE *cp_entry_by_index(JVM_CLASS *, unsigned int); int cp_lookup(JVM_CLASS *, JVM_CONSTANT, const void *), cp_find_or_insert(JVM_CLASS *, JVM_CONSTANT, const void *), cp_manual_insert(JVM_CLASS *, JVM_CONSTANT, const void *); void cp_fields_dump(JVM_CLASS *), cp_dump(JVM_CLASS *), cp_quickdump(JVM_CLASS *); u4 cp_big_endian_u4(u4); u2 cp_big_endian_u2(u2); char *cp_null_term_utf8(CP_INFO *); #endif f2j-0.8.1/libbytecode/class.c0000600000077700002310000015441611031241063016013 0ustar seymourgraduate/** @file class.c * Routines for writing the class file to disk. */ #include "class.h" /** * Given a pointer to a classfile structure, this function writes the class * file to disk. * * @param class -- The class structure to be written. * @param output_dir -- The name of the output directory to which the class file * should be written. If NULL, the class file is written to the current * directory. * * @returns 0 on success, -1 on failure. */ int bc_write_class(JVM_CLASS *class, char *output_dir) { Dlist tmpPtr; FILE *cfp; if(!class) { BAD_ARG(); return -1; } dl_traverse(tmpPtr,class->methods) { if(finalizeMethod((JVM_METHOD *) tmpPtr->val)) return -1; } class->constant_pool_count = (u2) ((CP_NODE *)dl_val(dl_last(class->constant_pool)))->next_idx; cfp = open_output_classfile(class, output_dir); if(!cfp) return -1; clearerr(cfp); write_u4(class->magic, cfp); write_u2(class->minor_version, cfp); write_u2(class->major_version, cfp); write_u2(class->constant_pool_count, cfp); write_constant_pool(class, cfp); write_u2(class->access_flags, cfp); write_u2(class->this_class, cfp); write_u2(class->super_class, cfp); write_u2(class->interfaces_count, cfp); write_interfaces(class,cfp); write_u2(class->fields_count, cfp); write_fields(class,cfp); write_u2(class->methods_count, cfp); write_methods(class,cfp); write_u2(class->attributes_count, cfp); write_attributes(class, class->attributes, cfp); if(ferror(cfp)) { fclose(cfp); return -1; } fclose(cfp); return 0; } /***************************************************************************** ***************************************************************************** ** ** ** Functions after this point are not exposed as part of the API. ** ** ** ***************************************************************************** *****************************************************************************/ /** * This function writes the all the constants to disk. this could be more * efficient if we could assume that there was no padding in the structures. * then it would just be a matter of writing out however many bytes is * allocated. but i'm not really sure how different compilers might pad * structures, so i'm going to play it safe here and just write each item * individually. --kgs 4/25/00 * * @param class -- The class structure to be written. * @param out -- File pointer to which the data should be written. */ static void write_constant_pool(JVM_CLASS *class, FILE *out) { CP_NODE * tmpconst; Dlist tmpPtr; if(!class || !out) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->constant_pool) { tmpconst = (CP_NODE *) tmpPtr->val; debug_msg("write_constant_pool() - tag = %d\n",tmpconst->val->tag); write_u1(tmpconst->val->tag, out); switch(tmpconst->val->tag) { case CONSTANT_Utf8: write_u2(tmpconst->val->cpnode.Utf8.length,out); fwrite(tmpconst->val->cpnode.Utf8.bytes, tmpconst->val->cpnode.Utf8.length,1,out); break; case CONSTANT_Integer: fwrite(&(tmpconst->val->cpnode.Integer.bytes), sizeof(tmpconst->val->cpnode.Integer.bytes),1,out); break; case CONSTANT_Float: fwrite(&(tmpconst->val->cpnode.Float.bytes), sizeof(tmpconst->val->cpnode.Float.bytes),1,out); break; case CONSTANT_Long: fwrite(&(tmpconst->val->cpnode.Long.high_bytes), sizeof(tmpconst->val->cpnode.Long.high_bytes),1,out); fwrite(&(tmpconst->val->cpnode.Long.low_bytes), sizeof(tmpconst->val->cpnode.Long.low_bytes),1,out); break; case CONSTANT_Double: fwrite(&(tmpconst->val->cpnode.Double.high_bytes), sizeof(tmpconst->val->cpnode.Double.high_bytes),1,out); fwrite(&(tmpconst->val->cpnode.Double.low_bytes), sizeof(tmpconst->val->cpnode.Double.low_bytes),1,out); break; case CONSTANT_Class: write_u2(tmpconst->val->cpnode.Class.name_index,out); break; case CONSTANT_String: write_u2(tmpconst->val->cpnode.String.string_index, out); break; case CONSTANT_Fieldref: case CONSTANT_Methodref: case CONSTANT_InterfaceMethodref: write_u2(tmpconst->val->cpnode.Methodref.class_index,out); write_u2(tmpconst->val->cpnode.Methodref.name_and_type_index,out); break; case CONSTANT_NameAndType: write_u2(tmpconst->val->cpnode.NameAndType.name_index,out); write_u2(tmpconst->val->cpnode.NameAndType.descriptor_index,out); break; default: debug_err("WARNING: unknown tag in write_constant_pool()\n"); break; /* ANSI requirement */ } } } /** * This function writes the all the interfaces to disk. * * @param class -- The class structure to be written. * @param out -- File pointer to which the data should be written. */ static void write_interfaces(JVM_CLASS *class, FILE *out) { int i=0, ival; Dlist tmpPtr; if(!class || !out) { BAD_ARG(); return; } debug_msg("in write_interfaces %p %p\n", (void*)class, (void*)out); dl_traverse(tmpPtr,class->interfaces) { ival = *((int *) tmpPtr->val); write_u2((u2)ival,out); i++; } if(i != class->interfaces_count) debug_err("Warning: expected to write %d interfaces, but wrote %d.\n", class->interfaces_count, i); } /** * This function writes the all the fields to disk. * * @param class -- The class structure to be written. * @param out -- File pointer to which the data should be written. */ static void write_fields(JVM_CLASS *class, FILE *out) { JVM_FIELD *tmpfield; Dlist tmpPtr; int cnt; if(!class || !out) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->fields) { tmpfield = (JVM_FIELD *) tmpPtr->val; debug_msg("write_fields() %d, %d, %d\n", tmpfield->access_flags, tmpfield->name_index, tmpfield->descriptor_index); write_u2(tmpfield->access_flags,out); write_u2(tmpfield->name_index,out); write_u2(tmpfield->descriptor_index,out); write_u2(tmpfield->attributes_count,out); cnt = write_attributes(class, tmpfield->attributes, out); if(tmpfield->attributes_count != cnt) { debug_err("WARNING: expected to write %d attributes,", tmpfield->attributes_count); debug_err("but actually wrote %d attributes.", cnt); } } } /** * This function writes the all the methods to disk. * * @param class -- The class structure to be written. * @param out -- File pointer to which the data should be written. */ static void write_methods(JVM_CLASS *class, FILE *out) { JVM_METHOD *tmpmeth; Dlist tmpPtr; int cnt; if(!class || !out) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->methods) { tmpmeth = (JVM_METHOD *) tmpPtr->val; write_u2(tmpmeth->access_flags,out); write_u2(tmpmeth->name_index,out); write_u2(tmpmeth->descriptor_index,out); write_u2(tmpmeth->attributes_count,out); cnt = write_attributes(class, tmpmeth->attributes, out); if(tmpmeth->attributes_count != cnt) { debug_err("WARNING: expected to write %d attributes,", tmpmeth->attributes_count); debug_err("but actually wrote %d attributes.", cnt); } } } /** * This function writes the all the attributes in the given list * to disk. Even though the first argument is a class structure, this * function can be used to write attributes of a class, method, or field. * In any case the class structure is needed for access to its constant * pool. * * @param class -- The class structure to be written. * @param attr_list -- The list of attributes to be written. It should * be a Dlist of JVM_ATTRIBUTE pointers. * @param out -- File pointer to which the data should be written. * * @returns Number of attributes written or -1 on failure. */ static int write_attributes(JVM_CLASS *class, Dlist attr_list, FILE *out) { JVM_ATTRIBUTE *tmpattr; char *attr_name; Dlist tmpPtr, tmpPtr2; CP_NODE *c; int cnt = 0; if(!attr_list || !class || !out) { BAD_ARG(); return cnt; } dl_traverse(tmpPtr,attr_list) { tmpattr = (JVM_ATTRIBUTE *) tmpPtr->val; c = cp_entry_by_index(class, tmpattr->attribute_name_index); if(c==NULL) { debug_err("WARNING: write_attributes() can't find attribute name\n"); continue; } attr_name = cp_null_term_utf8(c->val); if(!attr_name) return -1; debug_msg("attribute name = '%s'\n", attr_name); write_u2(tmpattr->attribute_name_index,out); write_u4(tmpattr->attribute_length,out); debug_msg("write_attributes() - attribute length: %d, idx: %d\n", tmpattr->attribute_length, tmpattr->attribute_name_index); if(!strcmp(attr_name,"SourceFile")) { write_u2(tmpattr->attr.SourceFile->sourcefile_index,out); } else if(!strcmp(attr_name,"ConstantValue")) { write_u2(tmpattr->attr.ConstantValue->constantvalue_index,out); } else if(!strcmp(attr_name,"Deprecated")) { /* The Deprecated attribute has length 0, so there is nothing to write */ } else if(!strcmp(attr_name,"Synthetic")) { /* The Synthetic attribute has length 0, so there is nothing to write */ } else if(!strcmp(attr_name,"Code")) { write_u2(tmpattr->attr.Code->max_stack,out); write_u2(tmpattr->attr.Code->max_locals,out); write_u4(tmpattr->attr.Code->code_length,out); write_code(tmpattr->attr.Code->code, out); write_u2(tmpattr->attr.Code->exception_table_length,out); if(tmpattr->attr.Code->exception_table_length > 0) { write_exception_table(tmpattr->attr.Code->exception_table, tmpattr->attr.Code->exception_table_length, out); } debug_msg("code attributes count = %d\n", tmpattr->attr.Code->attributes_count); write_u2(tmpattr->attr.Code->attributes_count,out); if(tmpattr->attr.Code->attributes_count > 0) { write_attributes(class, tmpattr->attr.Code->attributes, out); } } else if(!strcmp(attr_name,"Exceptions")) { int *idx; write_u2(tmpattr->attr.Exceptions->number_of_exceptions, out); dl_traverse(tmpPtr2, tmpattr->attr.Exceptions->exception_index_table) { idx = (int *) tmpPtr2->val; write_u2(*idx, out); } } else if(!strcmp(attr_name,"LineNumberTable")) { JVM_LINE_NUMBER_TABLE_ENTRY *entry; write_u2(tmpattr->attr.LineNumberTable->line_number_table_length, out); dl_traverse(tmpPtr2, tmpattr->attr.LineNumberTable->line_number_table) { entry = (JVM_LINE_NUMBER_TABLE_ENTRY *) tmpPtr2->val; write_u2(entry->op->pc, out); write_u2(entry->line_number, out); } } else if(!strcmp(attr_name,"LocalVariableTable")) { JVM_LOCAL_VARIABLE_TABLE_ENTRY *entry; int len; write_u2(tmpattr->attr.LocalVariableTable->local_variable_table_length, out); dl_traverse(tmpPtr2, tmpattr->attr.LocalVariableTable->local_variable_table) { entry = (JVM_LOCAL_VARIABLE_TABLE_ENTRY *) tmpPtr2->val; len = (entry->end->pc - entry->start->pc) + entry->end->width; write_u2(entry->start->pc, out); write_u2(len, out); write_u2(entry->name_index, out); write_u2(entry->descriptor_index, out); write_u2(entry->index, out); } } else if(!strcmp(attr_name,"InnerClasses")) { struct InnerClassEntry *entry; write_u2(tmpattr->attr.InnerClasses->number_of_classes, out); dl_traverse(tmpPtr2, tmpattr->attr.InnerClasses->classes) { entry = (struct InnerClassEntry *)tmpPtr2->val; write_u2(entry->inner_class_info_index, out); write_u2(entry->outer_class_info_index, out); write_u2(entry->inner_name_index, out); write_u2(entry->inner_class_access_flags, out); } } else { /* Don't recognize this attribute, so it must be user-defined. */ fwrite(tmpattr->attr.UserDefined->data,1,tmpattr->attribute_length,out); } free(attr_name); cnt++; } return cnt; } /** * This function writes the exception table to disk. * * @param et -- Array of exception table structures to be written. * @param len -- The number of exception table entries in the array. * @param out -- File pointer to which the data should be written. */ static void write_exception_table(struct ExceptionTable *et, int len, FILE *out) { int i; if(!et || !out) { BAD_ARG(); return; } for(i=0;iop; write_u1(op,out); switch(node->width) { case 1: /* if the width is 1, then there is no operand */ break; case 2: op1 = (u1) node->operand; write_u1(op1,out); break; case 3: op2 = (u2) node->operand; write_u2(op2,out); break; case 4: op4 = (u4) node->operand; write_u3(op4,out); break; case 5: op4 = (u4) node->operand; write_u4(op4,out); break; default: if(op == jvm_tableswitch) write_tableswitch(node, out); else if(op == jvm_lookupswitch) write_lookupswitch(node, out); else debug_err( "write_code(): hit default unexpectedly\n"); break; } } } /** * This function opens the file to which we write the bytecode. * We derive the name of the class by looking at the "this_class" entry * in the class file's constant pool. * * @param class -- The class structure to be written. * @param output_dir -- The name of the output directory to which the class file * should be written. If NULL, the class file is written to the current * directory. * * @returns Pointer to the opened file. Returns NULL on error. */ static FILE * open_output_classfile(JVM_CLASS *class, char *output_dir) { char *filename; FILE *newfp; CP_NODE *c; if(!class) { BAD_ARG(); return NULL; } c = cp_entry_by_index(class, class->this_class); if(!c) return NULL; c = cp_entry_by_index(class, c->val->cpnode.Class.name_index); if(!c) return NULL; /* malloc enough characters in the filename for: * - the class name * - plus 6 chars for ".class" * - plus 1 char for the null terminator */ filename = (char *)malloc(c->val->cpnode.Utf8.length + 7); if(!filename) return NULL; strncpy(filename, (char *)c->val->cpnode.Utf8.bytes, c->val->cpnode.Utf8.length); filename[c->val->cpnode.Utf8.length] = '\0'; strcat(filename,".class"); debug_msg("going to write class file: '%s'\n", filename); newfp = bc_fopen_fullpath(filename,"wb", output_dir); free(filename); return newfp; } /** * Finishes initialization of the method structure. Before writing, the * method requires some preparation. This involves: * -# Setting up the Line Number Table, Local Variable Table, and * Exception table. * -# Computing the code attribute length. * -# Inserting the cur_code list as an attribute of this method. * * @param meth -- The method to be finalized. * * @returns 0 on success, -1 on failure. */ static int finalizeMethod(JVM_METHOD *meth) { JVM_EXCEPTION_TABLE_ENTRY *et_entry; Dlist tmp; int idx, code_attr_len; if(!meth) { BAD_ARG(); return -1; } /* at the end of the method, the stacksize should always be zero. * if not, we're gonna have verification problems at the very least. * at this point, there's not much we can do about it, but issue a * warning. */ if(meth->stacksize != 0) debug_err("WARNING: ending method with stacksize = %d\n", meth->stacksize); if(traverse_code(meth) < 0) { debug_err("Error: failure finalizing method\n"); return -1; } meth->cur_code->attr.Code->exception_table_length = meth->num_handlers; if(meth->num_handlers > 0) { meth->cur_code->attr.Code->exception_table = (struct ExceptionTable *) malloc(sizeof(struct ExceptionTable) * meth->num_handlers); if(!meth->cur_code->attr.Code->exception_table) return -1; debug_msg("Code set exception_table_length = %d\n",meth->num_handlers); idx = 0; dl_traverse(tmp, meth->exc_table) { et_entry = (JVM_EXCEPTION_TABLE_ENTRY *) tmp->val; meth->cur_code->attr.Code->exception_table[idx].start_pc = et_entry->from->pc; meth->cur_code->attr.Code->exception_table[idx].end_pc = et_entry->to->pc; meth->cur_code->attr.Code->exception_table[idx].handler_pc = et_entry->target->pc; meth->cur_code->attr.Code->exception_table[idx].catch_type = et_entry->catch_type; idx++; free(et_entry); } } dl_delete_list(meth->exc_table); meth->exc_table = NULL; /* check if there were any line number table entries created. * if so, create the LineNumberTable attribute. */ if(!dl_empty(meth->line_table)) { JVM_ATTRIBUTE *lnt = bc_new_line_number_table_attr(meth); if(!lnt) return -1; dl_insert_b(meth->cur_code->attr.Code->attributes, lnt); meth->cur_code->attr.Code->attributes_count++; } /* check if there were any local variable table entries created. * if so, create the LocalVariableTable attribute. */ if(!dl_empty(meth->locals_table)) { JVM_ATTRIBUTE *lvt = bc_new_local_variable_table_attr(meth); if(!lvt) return -1; dl_insert_b(meth->cur_code->attr.Code->attributes, lvt); meth->cur_code->attr.Code->attributes_count++; } /* calculate the size of the code attribute's attributes */ code_attr_len = 0; dl_traverse(tmp, meth->cur_code->attr.Code->attributes) { JVM_ATTRIBUTE *attr = (JVM_ATTRIBUTE *) tmp->val; code_attr_len += attr->attribute_length + 6; } /* attribute_length is calculated as follows: * max_stack = 2 bytes * max_locals = 2 bytes * code_length = 4 bytes * code = pc bytes * exception_table_length = 2 bytes * exception_table = exc_table_len * sizeof(exc table) bytes * attributes_count = 2 bytes * attributes = code_attr_len bytes * --------------------------------- * total (in bytes) = 12 + exc_table_length * sizeof(exc table) + code_attr_len */ meth->cur_code->attribute_length = meth->pc + 12 + meth->num_handlers * sizeof(struct ExceptionTable) + code_attr_len; meth->cur_code->attr.Code->max_locals = (u2)meth->max_locals; meth->cur_code->attr.Code->code_length = meth->pc; debug_msg("Code: set code_length = %d\n",meth->pc); /* * If the method was declared abstract or native, then it should not * have a Code attribute. */ if((meth->access_flags & JVM_ACC_ABSTRACT) || (meth->access_flags & JVM_ACC_NATIVE)) { if(meth->cur_code->attr.Code->code_length > 0) { debug_err("Warning: code_length > 0 for abstract method '%s'.\n", meth->name); } } else { meth->attributes_count++; dl_insert_b(meth->attributes, meth->cur_code); } return 0; } /** * Writes an unsigned byte to the specified file pointer. there are no * issues with endianness here, but this function is included for * consistency. * * @param num -- The unsigned byte to be written. * @param out -- File pointer to which the data should be written. */ static void write_u1(u1 num, FILE *out) { if(!out) { BAD_ARG(); return; } fwrite(&num, sizeof(num), 1, out); } /** * Writes an unsigned short to the specified file pointer, changing * endianness if necessary. * * @param num -- The unsigned short to be written. * @param out -- File pointer to which the data should be written. */ static void write_u2(u2 num, FILE *out) { if(!out) { BAD_ARG(); return; } num = cp_big_endian_u2(num); fwrite(&num, sizeof(num), 1, out); } /** * Writes an unsigned short and then an unsigned byte to the * specified file pointer, changing endianness if necessary. * * @param num -- The short/byte pair to be written. The parameter holds * four bytes, but only the low-order three bytes are used. First the two * low-order bytes of (num>>8) are written (endianness adjusted as * necessary) followed by the low-order byte of num. * * @param out -- File pointer to which the data should be written. */ static void write_u3(u4 num, FILE *out){ u2 u2tmp; u1 u1tmp; if(!out) { BAD_ARG(); return; } u1tmp = u2tmp = (u2)(num>>8); u2tmp = cp_big_endian_u2(u2tmp); fwrite(&u2tmp, sizeof(u2tmp), 1, out); u1tmp = (u1)(num - (u1tmp<<8)); fwrite(&u1tmp, sizeof(u1tmp), 1, out); } /** * Writes an unsigned int to the specified file pointer, changing endianness * if necessary. * * @param num -- The unsigned int to be written. * @param out -- File pointer to which the data should be written. */ static void write_u4(u4 num, FILE *out) { if(!out) { BAD_ARG(); return; } num = cp_big_endian_u4(num); fwrite(&num, sizeof(num), 1, out); } /** * Writes a tableswitch instruction. First writes any necessary padding * followed by the variable-length instruction. * * @param node -- The instruction node to be written. * @param out -- File pointer to which the data should be written. */ static void write_tableswitch(JVM_CODE_GRAPH_NODE *node, FILE *out) { int i, n, zero = 0; if(!node || !out) { BAD_ARG(); return; } fwrite(&zero, 1, node->switch_info->cell_padding, out); if(node->switch_info->default_case) write_u4(node->switch_info->default_case->pc - node->pc, out); else debug_err("warning, unspecified default not implemented yet.\n"); write_u4(node->switch_info->low, out); write_u4(node->switch_info->high, out); n = node->switch_info->high - node->switch_info->low + 1; for(i = 0; i < n; i++) write_u4(node->switch_info->sorted_entries[i]->instr->pc - node->pc, out); } /** * Writes a lookupswitch instruction. First writes any necessary padding * followed by the variable-length instruction. * * @param node -- The instruction node to be written. * @param out -- File pointer to which the data should be written. */ static void write_lookupswitch(JVM_CODE_GRAPH_NODE *node, FILE *out){ int i, zero = 0; if(!node || !out) { BAD_ARG(); return; } fwrite(&zero, 1, node->switch_info->cell_padding, out); if(node->switch_info->default_case) write_u4(node->switch_info->default_case->pc - node->pc, out); else debug_err("warning, unspecified default not implemented yet.\n"); write_u4(node->switch_info->num_entries, out); for(i = 0; i < node->switch_info->num_entries; i++) { write_u4(node->switch_info->sorted_entries[i]->case_num, out); write_u4(node->switch_info->sorted_entries[i]->instr->pc - node->pc, out); } } /** * This function traverses the code graph, determines the maximum stack size, * and assigns branch target offsets to each instruction node. Also handles * recalculating all branch target offsets in case the addresses shift (due to * changing a goto to goto_w for example). Address shift also requires * recomputing the cell padding for switch instructions. * * @param meth -- The method to be traversed. * * @returns 0 on success, -1 on failure. */ static int traverse_code(JVM_METHOD *meth) { JVM_EXCEPTION_TABLE_ENTRY *et_entry; JVM_CODE_GRAPH_NODE *val; Dlist tmp, cgraph; if(!meth) { BAD_ARG(); return -1; } cgraph = meth->cur_code->attr.Code->code; if(dl_empty(cgraph)) return 0; /* set initial stack depth to zero */ val = (JVM_CODE_GRAPH_NODE *) dl_val(dl_first(cgraph)); val->stack_depth = 0; meth->reCalcAddr = FALSE; /* traverse the whole graph calculating branch target offsets. */ calc_offsets(meth, val); /* now traverse paths originating from exception handlers */ meth->num_handlers = 0; dl_traverse(tmp, meth->exc_table) { /* count number of handlers.. we'll use this info later */ meth->num_handlers++; et_entry = (JVM_EXCEPTION_TABLE_ENTRY *) tmp->val; /* * set stack depth for the beginning of the exception handler to * the depth of the stack at the beginning of the 'try' block plus 1 * (to account for the reference to the exception which is sitting on * the stack now). */ et_entry->target->stack_depth = et_entry->from->stack_depth + 1; calc_offsets(meth, et_entry->target); } /* * if there was a branch offset that exceeds the JVM instruction's * limit (signed 16-bit value), then the width of that instruction * must change (e.g. from goto to goto_w), thus altering the * addresses of all instructions following that one. here we are * recalculating the PCs and all branch target offsets (only if * necessary though). there are only a few instances in the LAPACK * code where the branch exceeds the limits, so this shouldn't * increase the compilation time very much. */ if(meth->reCalcAddr) { int tmpPC = 0; dl_traverse(tmp,cgraph) { val = (JVM_CODE_GRAPH_NODE *) tmp->val; val->pc = tmpPC; /* if this is a switch, then the cell padding and op width need * to be recalculated based on the pc of this instruction. */ if(val->op == jvm_tableswitch) { val->switch_info->cell_padding = 3-(val->pc%4); val->width = 1 + val->switch_info->cell_padding + 12 + (val->switch_info->high - val->switch_info->low + 1) * 4; } else if(val->op == jvm_lookupswitch) { val->switch_info->cell_padding = 3-(val->pc%4); val->width = 1 + val->switch_info->cell_padding + 8 + val->switch_info->num_entries * 8; } tmpPC += val->width; } /* now that all the instruction addresses are correct, recalculate * the branch target offsets. */ meth->reCalcAddr = FALSE; dl_traverse(tmp,cgraph) { val = (JVM_CODE_GRAPH_NODE *) tmp->val; if ( val->branch_target != NULL) { meth->reCalcAddr = check_distance(val->op, val->branch_target->pc, val->pc); val->operand = val->branch_target->pc - val->pc; } } if(meth->reCalcAddr) { debug_err("BAD NEWS - things are still screwed.\n"); return -1; } meth->pc = tmpPC; } if(meth->pc > JVM_MAX_CODE_LEN) debug_err("WARNING: code length (%d) exceeds max of %d\n", meth->pc, JVM_MAX_CODE_LEN); /* print the instructions if debugging is enabled */ #ifdef BC_DEBUG dl_traverse(tmp,cgraph) { char *warn; val = (JVM_CODE_GRAPH_NODE *) tmp->val; if(!val->visited) warn = "(UNVISITED!!)"; else warn = ""; if(bc_op_width(val->op) > 1) debug_msg("%d: %s %d %s\n", val->pc, jvm_opcode[val->op].op, val->operand, warn); else debug_msg("%d: %s %s\n", val->pc, jvm_opcode[val->op].op, warn); } #endif return 0; } /** * This function calculates the branch target offsets for instructions that * branch (gotos, compares, etc). Also set the stack depth for the * instruction(s) following this one. Also perform sanity checks on the * stack values to make sure that we aren't hitting some instruction from * different places with different stack depths. * * @param meth -- The method to be traversed. * @param val -- The node in the code graph to start traversing from. */ static void calc_offsets(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *val) { JVM_CODE_GRAPH_NODE *label_node; Dlist cgraph; int temp_pc, stack_inc, stack_dec; if(!meth || !val) { BAD_ARG(); return; } cgraph = meth->cur_code->attr.Code->code; debug_msg("in calc_offsets, before op %d : %s, stack_Depth = %d\n", val->pc, jvm_opcode[val->op].op,val->stack_depth); if(val->next == NULL) debug_msg("next is NULL\n"); else debug_msg("next is %s\n", jvm_opcode[val->next->op].op); if(val->visited) return; val->visited = TRUE; meth->stacksize = val->stack_depth; stack_dec = get_stack_decrement(meth, val->op, val->operand); stack_inc = get_stack_increment(meth, val->op, val->operand); if((stack_dec < 0) || (stack_inc < 0)) { debug_err("Could not determine stack inc/dec\n"); stack_dec = 0; stack_inc = 0; } dec_stack(meth, stack_dec); if(meth->stacksize < 0) debug_msg("\tpc = %d\n", val->pc); inc_stack(meth, stack_inc); if((val->op == jvm_tableswitch) || (val->op == jvm_lookupswitch)) { int i=0; meth->reCalcAddr = TRUE; if(num_empty_switch_cases(val) > JVM_SWITCH_FILL_THRESH) i = setup_lookupswitch(val); else i = setup_tableswitch(val); if(i < 0) { debug_err("Error setting up switch\n"); return; } /* now visit the code for each case in this switch */ for(i = 0; i < val->switch_info->num_entries; i++) { JVM_SWITCH_ENTRY *entry = val->switch_info->sorted_entries[i]; if(entry->instr->stack_depth == -1) entry->instr->stack_depth = meth->stacksize; calc_offsets(meth, entry->instr); } calc_offsets(meth, val->switch_info->default_case); return; }else if((val->op == jvm_goto) || (val->op == jvm_goto_w) || (val->op == jvm_jsr) || (val->op == jvm_jsr_w)) { if(val->branch_target == NULL) { debug_msg("looking at GOTO %s\n", val->branch_label); if( (temp_pc = find_label(meth->label_list, val->branch_label)) != -1) { label_node = bc_node_at_pc(meth, temp_pc); if(label_node != NULL) { debug_msg(" **found** target pc is %d\n", label_node->pc); if(label_node->stack_depth == -1) label_node->stack_depth = meth->stacksize; else if(label_node->stack_depth != meth->stacksize) debug_err("WARNING: hit pc %d with diff stack sizes (%s)\n", label_node->pc, meth->name); if(check_distance(val->op, label_node->pc, val->pc)) { meth->reCalcAddr = TRUE; if(val->op == jvm_goto) { val->op = jvm_goto_w; val->width = bc_op_width(jvm_goto_w); } else if(val->op == jvm_jsr) { val->op = jvm_jsr_w; val->width = bc_op_width(jvm_jsr_w); } else debug_err("did not expect to be here\n"); } val->operand = label_node->pc - val->pc; val->branch_target = label_node; calc_offsets(meth, label_node); } else debug_err("WARNING: cannot find node for pc %d\n", temp_pc); } else debug_err("WARNING: cannot find label %s\n", val->branch_label); } else { debug_msg("goto branching to pc %d\n", val->branch_target->pc); if(val->branch_target->stack_depth == -1) val->branch_target->stack_depth = meth->stacksize; else if (val->branch_target->stack_depth != meth->stacksize) debug_err("WARNING: hit pc %d with diff stack sizes (%s).\n", val->branch_target->pc, meth->name); if(check_distance(val->op, val->branch_target->pc, val->pc)) { meth->reCalcAddr = TRUE; if(val->op == jvm_goto) { val->op = jvm_goto_w; val->width = bc_op_width(jvm_goto_w); } else if(val->op == jvm_jsr) { val->op = jvm_jsr_w; val->width = bc_op_width(jvm_jsr_w); } else debug_err("did not expect to be here\n"); } val->operand = val->branch_target->pc - val->pc; calc_offsets(meth, val->branch_target); } /* if this is a jsr, then the subroutine will return back to the * instruction following the jsr, so continue visiting those nodes now. */ if((val->op == jvm_jsr) || (val->op == jvm_jsr_w)) { if(val->next != NULL) { val->next->stack_depth = meth->stacksize; calc_offsets(meth, val->next); } } } else if ( val->branch_target != NULL) { if(val->next != NULL) val->next->stack_depth = meth->stacksize; if(check_distance(val->op, val->branch_target->pc, val->pc)) { JVM_CODE_GRAPH_NODE *gotoNode, *wideGotoNode; Dlist listNode; meth->reCalcAddr = TRUE; val->branch_target->stack_depth = meth->stacksize; val->operand = val->branch_target->pc - val->pc; gotoNode = bc_new_graph_node(meth, jvm_goto, 0); wideGotoNode = bc_new_graph_node(meth, jvm_goto_w, 0); if(!gotoNode || !wideGotoNode) return; gotoNode->visited = TRUE; wideGotoNode->visited = TRUE; gotoNode->branch_target = val->next; wideGotoNode->next = val->next; gotoNode->next = wideGotoNode; val->next = gotoNode; wideGotoNode->branch_target = val->branch_target; val->branch_target = wideGotoNode; listNode = get_list_node(cgraph, val); dl_insert_a(listNode, gotoNode); listNode = dl_next(listNode); dl_insert_a(listNode, wideGotoNode); if(gotoNode->branch_target != NULL){ calc_offsets(meth, gotoNode->branch_target); } calc_offsets(meth, wideGotoNode->branch_target); } else { val->branch_target->stack_depth = meth->stacksize; val->operand = val->branch_target->pc - val->pc; if(val->next != NULL){ calc_offsets(meth, val->next); } calc_offsets(meth, val->branch_target); } } else { if(val->next != NULL) { if((val->op != jvm_return) && (val->op != jvm_areturn) && (val->op != jvm_dreturn) && (val->op != jvm_freturn) && (val->op != jvm_ireturn) && (val->op != jvm_areturn) && (val->op != jvm_ret)) { val->next->stack_depth = meth->stacksize; calc_offsets(meth, val->next); } } /* if this is a return statement, then reset the opcode to * the one matching the method descriptor. */ if((val->op == jvm_return) || (val->op == jvm_areturn) || (val->op == jvm_dreturn) || (val->op == jvm_freturn) || (val->op == jvm_ireturn) || (val->op == jvm_areturn)) { if(meth->descriptor_index != 0) { CP_NODE *c; char *desc; c = cp_entry_by_index(meth->class, meth->descriptor_index); if(c) { desc = cp_null_term_utf8(c->val); if(desc) val->op = get_method_return_op(desc); free(desc); } } else debug_err("warning: method descriptor still unspecified!!\n"); } } return; } /** * Calculates the number of empty cases in a switch instruction. * This information is used to determine whether to use the * tableswitch or lookupswitch instruction. If there are a lot * of empty cases, then the lookupswitch is preferred. * * @param switch_instr -- The switch instruction to examine. * * @returns The number of empty switch cases. */ static int num_empty_switch_cases(JVM_CODE_GRAPH_NODE *switch_instr) { Dlist tmp; int n, cnt=0; if(!switch_instr) { BAD_ARG(); return 0; } n = switch_instr->switch_info->high - switch_instr->switch_info->low + 1; dl_traverse(tmp, switch_instr->switch_info->offsets) { cnt++; } return n-cnt; } /** * Determines the number of bytes that this instruction removes from the * stack prior to execution. This depends on the instruction and on the * data types involved. e.g. a method invoke instruction will remove one or * two entries per argument, depending on the data type. * * @param meth -- The method in which this instruction is located. * @param op -- The instruction opcode. * @param index -- The operand to the instruction. * * @returns The number of bytes removed from the stack before execution. */ static int get_stack_decrement(JVM_METHOD *meth, JVM_OPCODE op, u4 index) { int stack_decrement; Dlist const_table; if(!meth) { BAD_ARG(); return 0; } const_table = meth->class->constant_pool; switch(op) { case jvm_multianewarray: stack_decrement = index-((index>>8) * 256); break; case jvm_invokespecial: case jvm_invokevirtual: case jvm_invokestatic: case jvm_invokeinterface: stack_decrement = get_stack_dec_invocation(meth->class, op, index); break; case jvm_putstatic: case jvm_getstatic: case jvm_putfield: case jvm_getfield: stack_decrement = get_stack_dec_field_acc(meth->class, op, index); break; default: /* else we can determine the stack decrement from a table. */ stack_decrement = jvm_opcode[op].stack_pre; } return stack_decrement; } /** * Determines the number of bytes that this field access instruction * (getfield, putfield, getstatic, putstatic) removes from the * stack prior to execution. * * @param class -- The class containing the constant pool relevant to * this instruction (i.e. the class containing the method containing the * instruction). * @param op -- The instruction opcode. * @param index -- The operand to the instruction. * * @returns The number of bytes removed from the stack before execution. */ static int get_stack_dec_field_acc(JVM_CLASS *class, JVM_OPCODE op, u4 index) { int stack_decrement; char *this_desc; int tmpsize; CP_NODE *c; if(!class) { BAD_ARG(); return 0; } c = cp_entry_by_index(class, index); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index); if(!c) return -1; this_desc = cp_null_term_utf8(c->val); if(!this_desc) return -1; if((this_desc[0] == 'D') || (this_desc[0] == 'J')) tmpsize = 2; else tmpsize = 1; switch(op) { case jvm_getstatic: stack_decrement = 0; break; case jvm_putstatic: stack_decrement = tmpsize; break; case jvm_getfield: stack_decrement = 1; break; case jvm_putfield: stack_decrement = tmpsize + 1; break; default: debug_err("get_stack_decrement(): unexpected op type\n"); free(this_desc); return -1; } free(this_desc); return stack_decrement; } /** * Determines the number of bytes that this method invocation instruction * (invokespecial, invokevirtual, invokestatic, invokeinterface) removes * from the stack prior to execution. * * @param class -- The class containing the constant pool relevant to * this instruction (i.e. the class containing the method containing the * instruction). * @param op -- The instruction opcode. * @param index -- The operand to the instruction. * * @returns The number of bytes removed from the stack before execution. */ static int get_stack_dec_invocation(JVM_CLASS *class, JVM_OPCODE op, u4 index) { JVM_STACK_INFO *stackinf; int stack_decrement; char *this_desc; int int_idx; CP_NODE *c; if(!class) { BAD_ARG(); return 0; } int_idx = (int)index; if(op == jvm_invokeinterface) int_idx >>= 16; /* now we need to determine how many parameters are sitting on the stack */ c = cp_entry_by_index(class, int_idx); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index); if(!c) return -1; this_desc = cp_null_term_utf8(c->val); if(!this_desc) return -1; stackinf = calc_stack(this_desc); if(!stackinf) { free(this_desc); return -1; } /* if the opcode is invokespecial or invokevirtual, then there is one * object reference + parameters on the stack. if this is an invokestatic * instruction, then there's just parameters. */ if(op == jvm_invokestatic) stack_decrement = stackinf->arg_len; else stack_decrement = stackinf->arg_len + 1; free(stackinf); free(this_desc); return stack_decrement; } /** * Determines the number of bytes that this instruction leaves on the stack * after execution. this depends on the instruction and on the data types. * e.g. for a method invoke instruction, the number of bytes depends on the * return type of the method (double/long = 2 stack entries). * * @param meth -- The method in which this instruction is located. * @param op -- The instruction opcode. * @param index -- The operand to the instruction. * * @returns The number of bytes added to the stack after execution. */ static int get_stack_increment(JVM_METHOD *meth, JVM_OPCODE op, u4 index) { int stack_increment; Dlist const_table; if(!meth) { BAD_ARG(); return 0; } const_table = meth->class->constant_pool; switch(op) { case jvm_invokespecial: case jvm_invokevirtual: case jvm_invokestatic: case jvm_invokeinterface: stack_increment = get_stack_inc_invocation(meth->class, op, index); break; case jvm_putstatic: case jvm_getstatic: case jvm_putfield: case jvm_getfield: stack_increment = get_stack_inc_field_acc(meth->class, op, index); break; default: /* else we can determine the stack increment from a table. */ stack_increment = jvm_opcode[op].stack_post; } return stack_increment; } /** * Determines the number of bytes that this method invocation instruction * (invokespecial, invokevirtual, invokestatic, invokeinterface) leaves * on the stack after execution. * * @param class -- The class containing the constant pool relevant to * this instruction (i.e. the class containing the method containing the * instruction). * @param op -- The instruction opcode. * @param index -- The operand to the instruction. * * @returns The number of bytes left on the stack after execution. */ static int get_stack_inc_invocation(JVM_CLASS *class, JVM_OPCODE op, u4 index) { JVM_STACK_INFO *stackinf; int stack_increment; char *this_desc; CP_NODE *c; int int_idx; if(!class) { BAD_ARG(); return 0; } int_idx = index; if(op == jvm_invokeinterface) int_idx >>= 16; /* now we need to determine how many parameters are sitting on the stack */ c = cp_entry_by_index(class, int_idx); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index); if(!c) return -1; this_desc = cp_null_term_utf8(c->val); if(!this_desc) return -1; stackinf = calc_stack(this_desc); if(!stackinf) { free(this_desc); return -1; } /* if the opcode is invokespecial, invokevirtual, or invokeinterface then * there is one object reference + parameters on the stack. if this is an * invokestatic instruction, then there's just parameters. */ stack_increment = stackinf->ret_len; free(stackinf); free(this_desc); return stack_increment; } /** * Determines the number of bytes that this field access instruction * (getfield, putfield, getstatic, putstatic) leaves on the stack * after execution. * * @param class -- The class containing the constant pool relevant to * this instruction (i.e. the class containing the method containing the * instruction). * @param op -- The instruction opcode. * @param index -- The operand to the instruction. * * @returns The number of bytes left on the stack after execution. */ static int get_stack_inc_field_acc(JVM_CLASS *class, JVM_OPCODE op, u4 index) { int stack_increment; char *this_desc; CP_NODE *c; int tmpsize; if(!class) { BAD_ARG(); return 0; } c = cp_entry_by_index(class, index); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.Methodref.name_and_type_index); if(!c) return -1; c = cp_entry_by_index(class, c->val->cpnode.NameAndType.descriptor_index); if(!c) return -1; this_desc = cp_null_term_utf8(c->val); if(!this_desc) return -1; if((this_desc[0] == 'D') || (this_desc[0] == 'J')) tmpsize = 2; else tmpsize = 1; switch(op) { case jvm_getstatic: stack_increment = tmpsize; break; case jvm_putstatic: stack_increment = 0; break; case jvm_getfield: stack_increment = tmpsize; break; case jvm_putfield: stack_increment = 0; break; default: debug_err("get_stack_increment(): unexpected op type\n"); free(this_desc); return -1; } free(this_desc); return stack_increment; } /** * Given a method descriptor, this function returns the number of arguments * it takes (actually the number returned may differ from the number of args * because doubles and longs take two stack entries per argument). This value * is used to determine how much to decrement the stack after a method * invocation. * * @param d -- The method descriptor to analyze. * * @returns The number of stack entries used for the arguments of the method * with the given descriptor. */ static JVM_STACK_INFO * calc_stack(char *d) { JVM_STACK_INFO *tmp; int len = strlen(d); char *ptr, *tstr; if(!d) { BAD_ARG(); return NULL; } debug_msg("in calc_stack, the desc = '%s'\n", d); tmp = (JVM_STACK_INFO *)malloc(sizeof(JVM_STACK_INFO)); if(!tmp) return NULL; tmp->arg_len = 1; tmp->ret_len = 1; /* the shortest possible method descriptor should be 3 characters: ()V * thus, if the given string is < 3 characters, it must be in error. */ if(len < 3) { debug_err("WARNING: invalid descriptor '%s' (len < 3).\n", d); return tmp; } if(d[0] != '(') { debug_err("WARNING: invalid descriptor '%s' (bad 1st char).\n", d); return tmp; } ptr = d; /* start at -1 because the opening paren will contribute 1 to * the count. */ tmp->arg_len = -1; while((ptr = bc_next_desc_token(ptr)) != NULL) { tmp->arg_len++; /* check if this is a double or long type. if so, increment * again because these data types take up two stack entries. */ if( (*ptr == 'D') || (*ptr == 'J') ) tmp->arg_len++; } tstr = strdup(d); if(!tstr) { debug_err("WARNING: could not dup descriptor.\n"); return tmp; } strtok(tstr,")"); ptr = strtok(NULL,")"); if( (*ptr == 'D') || (*ptr == 'J') ) tmp->ret_len = 2; else if(*ptr == 'V') tmp->ret_len = 0; else tmp->ret_len = 1; free(tstr); debug_msg("calc_stack arg_len = %d, ret_len = %d\n", tmp->arg_len, tmp->ret_len); return tmp; } /** * Increment the stacksize by the specified amount. If this is the highest * stack value encountered, set max_stack to the current stacksize. * * @param meth -- The method whose stack should be increased. * @param inc -- The amount to increase the stack. */ static void inc_stack(JVM_METHOD *meth, int inc) { if(!meth) { BAD_ARG(); return; } meth->stacksize += inc; if(meth->stacksize > meth->cur_code->attr.Code->max_stack) meth->cur_code->attr.Code->max_stack = (u2)meth->stacksize; } /** * Decrement the stacksize by the specified amount. * * * @param meth -- The method whose stack should be decreased. * @param dec -- The amount to decrease the stack. */ static void dec_stack(JVM_METHOD *meth, int dec) { if(!meth) { BAD_ARG(); return; } meth->stacksize -= dec; if(meth->stacksize < 0) debug_err("WARNING: negative stack! (%s)\n", meth->name); } /** * Prepares a tableswitch instruction to be written out. This involves: * -# Calculating the cell padding. * -# Setting up the array of cases. * -# Sorting the switch cases. * -# Filling in missing cases with default information. * * @param val -- The tableswitch instruction node. * * @returns 0 on success, -1 on failure. */ static int setup_tableswitch(JVM_CODE_GRAPH_NODE *val) { Dlist tmp; int i, n; if(!val) { BAD_ARG(); return -1; } val->op = jvm_tableswitch; n = val->switch_info->high - val->switch_info->low + 1; val->switch_info->sorted_entries = (JVM_SWITCH_ENTRY **)malloc(sizeof(JVM_SWITCH_ENTRY *) * n); if(!val->switch_info->sorted_entries) return -1; val->switch_info->num_entries = n; for(i = 0; i < n; i++) val->switch_info->sorted_entries[i] = NULL; /* set up the array of branch targets to be sorted */ dl_traverse(tmp, val->switch_info->offsets) { JVM_SWITCH_ENTRY *entry = (JVM_SWITCH_ENTRY *) tmp->val; int idx; idx = entry->case_num - val->switch_info->low; val->switch_info->sorted_entries[idx] = entry; i++; } /* fill in any missing cases with the default branch target */ for(i = 0; i < n; i++) { if(!val->switch_info->sorted_entries[i]) { JVM_SWITCH_ENTRY *new_entry = (JVM_SWITCH_ENTRY *)malloc(sizeof(JVM_SWITCH_ENTRY)); if(!new_entry) return -1; new_entry->instr = val->switch_info->default_case; new_entry->case_num = val->switch_info->low + i; val->switch_info->sorted_entries[i] = new_entry; } } /* sort the switch cases */ qsort(val->switch_info->sorted_entries, n, sizeof(JVM_SWITCH_ENTRY *), switch_entry_compare); /* need to calculate instruction width */ val->switch_info->cell_padding = 3-(val->pc%4); val->width = 1 + val->switch_info->cell_padding + 12 + n * 4; return 0; } /** * Prepares a lookupswitch instruction to be written out. This involves: * -# Calculating the cell padding. * -# Sorting the switch cases. * * @param val -- The tableswitch instruction node. * * @returns 0 on success, -1 on failure. */ static int setup_lookupswitch(JVM_CODE_GRAPH_NODE *val) { Dlist tmp; int i, n; if(!val) { BAD_ARG(); return -1; } val->op = jvm_lookupswitch; n = val->switch_info->num_entries; val->switch_info->sorted_entries = (JVM_SWITCH_ENTRY **)malloc(sizeof(JVM_SWITCH_ENTRY *) * n); if(!val->switch_info->sorted_entries) return -1; i = 0; /* set up the array of branch targets to be sorted */ dl_traverse(tmp, val->switch_info->offsets) { val->switch_info->sorted_entries[i] = (JVM_SWITCH_ENTRY *) tmp->val; i++; } /* sort the switch cases */ qsort(val->switch_info->sorted_entries, n, sizeof(JVM_SWITCH_ENTRY *), switch_entry_compare); /* need to calculate instruction width */ val->switch_info->cell_padding = 3-(val->pc%4); val->width = 1 + val->switch_info->cell_padding + 8 + n * 8; return 0; } /** * Compares two switch entries. This is used as an argument to qsort * when sorting the array of switch cases. * * @param e1 -- Switch entry. * @param e2 -- Switch entry. * * @returns * -# if e1 < e2, return -1 * -# if e1 == e2, return 0 * -# if e1 > e2, return 1 */ static int switch_entry_compare(const void *e1, const void *e2) { JVM_SWITCH_ENTRY *s1, *s2; if(!e1 || !e2) { BAD_ARG(); return 0; } s1 = *((JVM_SWITCH_ENTRY **)e1); s2 = *((JVM_SWITCH_ENTRY **)e2); if(s1->case_num < s2->case_num) return -1; if(s1->case_num == s2->case_num) return 0; return 1; } /** * Given a list and a graph node, this function returns the list node which * contains the graph node. * * @param cgraph -- The code graph (list). * @param n -- The node to find. * * @returns The list node containing the given instruction node. */ static Dlist get_list_node(Dlist cgraph, JVM_CODE_GRAPH_NODE *n) { Dlist tmp; if(!cgraph || !n) { BAD_ARG(); return NULL; } dl_traverse(tmp,cgraph) { if((JVM_CODE_GRAPH_NODE *) tmp->val == n) return tmp; } return NULL; } /** * Checks whether a branch is too far. currently the branch target offset * is a signed 16-bit integer, so the maximum branch is -2^15..2^15-1. * * @param op -- The branching opcode to be checked. * @param dest -- The branch destination address. * @param src -- The current address (i.e. the source of the branch). * * @returns TRUE if the branch is too far away, FALSE otherwise. */ static BOOL check_distance(JVM_OPCODE op, int dest, int src) { int distance; /* if it's a wide goto, then it'll always be ok.. otherwise check */ if((op == jvm_goto_w) || (op == jvm_jsr_w)) return FALSE; distance = dest - src; if((distance > ((int)math_pow( 2.0, 15.0 ) - 1)) || (distance < ((int)-math_pow( 2.0, 15.0 )))) return TRUE; else return FALSE; } /** * Simple double-precision power function. Just writing this here so that we * dont have to link in the math library. * * @param x -- The base. * @param y -- The exponent. * * @returns x raised to the power of y. */ static double math_pow(double x, double y) { double result; int i; if(y < 0) { debug_err("Warning: got negative exponent in math_pow!\n"); return 0.0; } if(y == 0) return 1.0; if(y == 1) return x; result = x; for(i=0;ival; if(!strcmp(bp->label, val)) return bp->instr->pc; } return -1; } f2j-0.8.1/libbytecode/class.h0000600000077700002310000000320011031241063016000 0ustar seymourgraduate#ifndef _CLASS_H #define _CLASS_H #include #include "bytecode.h" static BOOL check_distance(JVM_OPCODE, int, int); static void write_constant_pool(JVM_CLASS *, FILE *), write_interfaces(JVM_CLASS *, FILE *), write_fields(JVM_CLASS *, FILE *), write_methods(JVM_CLASS *, FILE *), write_code(Dlist, FILE *), write_exception_table(struct ExceptionTable *, int, FILE *), write_u1(u1, FILE *), write_u2(u2, FILE *), write_u3(u4, FILE *), write_u4(u4, FILE *), write_tableswitch(JVM_CODE_GRAPH_NODE *, FILE *), write_lookupswitch(JVM_CODE_GRAPH_NODE *, FILE *), dec_stack(JVM_METHOD *, int), inc_stack(JVM_METHOD *, int), calc_offsets(JVM_METHOD *meth, JVM_CODE_GRAPH_NODE *); static int find_label(Dlist, const char *), write_attributes(JVM_CLASS *, Dlist, FILE *), num_empty_switch_cases(JVM_CODE_GRAPH_NODE *), switch_entry_compare(const void *, const void *), setup_tableswitch(JVM_CODE_GRAPH_NODE *), setup_lookupswitch(JVM_CODE_GRAPH_NODE *), finalizeMethod(JVM_METHOD *), get_stack_increment(JVM_METHOD *, JVM_OPCODE, u4), get_stack_decrement(JVM_METHOD *, JVM_OPCODE, u4), get_stack_dec_field_acc(JVM_CLASS *, JVM_OPCODE, u4), get_stack_dec_invocation(JVM_CLASS *, JVM_OPCODE, u4), get_stack_inc_field_acc(JVM_CLASS *, JVM_OPCODE, u4), get_stack_inc_invocation(JVM_CLASS *, JVM_OPCODE, u4), traverse_code(JVM_METHOD *); static JVM_STACK_INFO *calc_stack(char *); static Dlist get_list_node(Dlist, JVM_CODE_GRAPH_NODE *); static double math_pow(double, double); static JVM_OPCODE get_method_return_op(char *); static FILE *open_output_classfile(JVM_CLASS *, char *); #endif f2j-0.8.1/libbytecode/constant_pool.c0000600000077700002310000012163611031241063017566 0ustar seymourgraduate/** @file constant_pool.c * This file contains routines for manipulating the constant pool list. */ #include "constant_pool.h" /** * Searches for the given node in the specified constant pool list. * * @param class -- The class containing the constant pool to be searched. * @param tag -- The type of constant contained in the 'value' argument. * @param value -- The constant value to be searched for. * * @returns If the node is found, return its constant pool index. * Return -1 otherwise. **/ int cp_lookup(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) { int retval; if(!class || !value) { BAD_ARG(); return -1; } switch(tag) { case CONSTANT_Utf8: retval = cp_lookup_utf8(class, value); break; case CONSTANT_Integer: retval = cp_lookup_int(class, value); break; case CONSTANT_Float: retval = cp_lookup_float(class, value); break; case CONSTANT_Long: retval = cp_lookup_long(class, value); break; case CONSTANT_Double: retval = cp_lookup_double(class, value); break; case CONSTANT_Class: retval = cp_lookup_class(class, value); break; case CONSTANT_Fieldref: case CONSTANT_InterfaceMethodref: case CONSTANT_Methodref: retval = cp_lookup_ref(class, tag, value); break; case CONSTANT_NameAndType: retval = cp_lookup_nameandtype(class, value); break; case CONSTANT_String: retval = cp_lookup_string(class, value); break; default: debug_err("cp_lookup: WARNING - hit default case!\n"); retval = -1; } return retval; } /** * Find the constant pool index for the given constant if it exists in * the constant pool. If not, create a new entry and return its index. * This function will not insert constant values for which there exist * shorthand instructions for pushing those values onto the stack. For * example floating point values 0.0, 1.0, and 2.0 can be pushed using * shorthand instructions fconst_0, fconst_1, and fconst_2 respectively. * Similar instructions exist for integer, long, and double. Therefore * these values usually do not need to be inserted into the constant pool. * If you need one of these values inserted, use the cp_manual_insert() * function. * * @param class -- The class containing the constant pool to be searched. * @param tag -- The type of constant contained in the 'value' argument. * @param value -- The constant value to be searched for. * * @returns The constant pool index for the given constant value. * If the value was not inserted because it was a special value * as mentioned above or if an error occurred then -1 is returned. **/ int cp_find_or_insert(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) { int temp; if(!class || !value) { BAD_ARG(); return -1; } temp = cp_find_function_body(class, tag, value, FALSE); if(temp < 0) CP_CHECK_NONZERO("cp_find_or_insert", temp); return temp; } /** * Identical to cp_find_or_insert(), except that integer and double precision * constants that would normally be excluded are inserted. * * @param class -- The class containing the constant pool to be searched. * @param tag -- The type of constant contained in the 'value' argument. * @param value -- The constant value to be inserted. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ int cp_manual_insert(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) { int temp; if(!class || !value) { BAD_ARG(); return -1; } temp = cp_find_function_body(class, tag, value, TRUE); if(temp < 0) CP_CHECK_NONZERO("cp_manual_insert", temp); return temp; } /** * Given an index into the constant pool, return a pointer to * the CP_NODE at that index. * * @param class -- The class containing the constant pool to be searched. * @param idx -- The constant pool index to be returned. * * @returns The CP_NODE at the given index. Returns NULL if the * specified index is not found in the constant pool. **/ CP_NODE * cp_entry_by_index(JVM_CLASS *class, unsigned int idx) { Dlist temp; if(!class) { BAD_ARG(); return NULL; } dl_traverse(temp,class->constant_pool) { if( ((CP_NODE*)temp->val)->index == idx ) return temp->val; } debug_err("cp_entry_by_index() WARNING: looking for non-existent cp index!\n"); return NULL; } /** * Dumps a list of the class variables to stdout. * * @param class -- The class containing the constant pool to be printed. **/ void cp_fields_dump(JVM_CLASS *class) { JVM_FIELD *tmpfield; CP_NODE * tmpfield2; Dlist tmpPtr; int count=1; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->fields) { tmpfield = (JVM_FIELD *) tmpPtr->val; printf("Field #%d\n", count++); printf("\taccess flags: %d\n",tmpfield->access_flags); tmpfield2 = cp_entry_by_index(class, tmpfield->name_index); printf("\tname idx: %d (%s)\n", tmpfield->name_index, cp_null_term_utf8(tmpfield2->val)); tmpfield2 = cp_entry_by_index(class, tmpfield->descriptor_index); printf("\tdesc idx: %d (%s)\n", tmpfield->descriptor_index, cp_null_term_utf8(tmpfield2->val)); } } /** * Less verbose version of cp_dump(). This function just prints the constant * pool index and the tag. * * @param class -- The class containing the constant pool to be printed. **/ void cp_quickdump(JVM_CLASS *class) { CP_NODE * tmpconst; Dlist tmpPtr; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->constant_pool) { tmpconst = (CP_NODE *) tmpPtr->val; printf("Constant pool entry %d, ", tmpconst->index); printf("tag: %s\n", jvm_constant_tags[tmpconst->val->tag]); } } /** * Prints the contents of the constant pool to stdout. * * @param class -- The class containing the constant pool to be printed. **/ void cp_dump(JVM_CLASS *class) { CP_NODE * tmpconst, * tmpconst2; Dlist tmpPtr; double x; float f; u8 l; char *tmp_str; if(!class) { BAD_ARG(); return; } dl_traverse(tmpPtr,class->constant_pool) { tmpconst = (CP_NODE *) tmpPtr->val; printf("Constant pool entry %d:\n", tmpconst->index); printf("\ttag: %s\n", jvm_constant_tags[tmpconst->val->tag]); switch(tmpconst->val->tag) { case CONSTANT_Utf8: tmp_str = cp_null_term_utf8(tmpconst->val); printf("\tstring: %s\n",tmp_str); free(tmp_str); break; case CONSTANT_Integer: if(isBigEndian()) printf("\tint: %d\n",tmpconst->val->cpnode.Integer.bytes); else printf("\tint: %d (conv. to little endian)\n", cp_big_endian_u4(tmpconst->val->cpnode.Integer.bytes)); break; case CONSTANT_Float: if(isBigEndian()) printf("\tfloat: %f\n",(float)tmpconst->val->cpnode.Float.bytes); else { u4 tmp; tmp = cp_big_endian_u4(tmpconst->val->cpnode.Float.bytes); memcpy(&f, &tmp, sizeof(u4)); printf("\tfloat: %f (conv. to little endian)\n", f); } break; case CONSTANT_Long: if(isBigEndian()) { memcpy(&l,&tmpconst->val->cpnode.Long.high_bytes,sizeof(u4)); memcpy((char*)&l+4,&tmpconst->val->cpnode.Long.low_bytes,sizeof(u4)); printf("\tlong: %ld (high: %d, low: %d)\n", (long) l, (int)tmpconst->val->cpnode.Long.high_bytes, (int)tmpconst->val->cpnode.Long.low_bytes); } else { u4 t1,t2; t1 = cp_big_endian_u4(tmpconst->val->cpnode.Long.high_bytes); t2 = cp_big_endian_u4(tmpconst->val->cpnode.Long.low_bytes); memcpy(&l, &t2, sizeof(u4)); memcpy((char*)&l+4, &t1, sizeof(u4)); printf("\tlong: %ld (high: %d, low: %d) (conv to little endian)\n",(long)l, cp_big_endian_u4(tmpconst->val->cpnode.Long.high_bytes), cp_big_endian_u4(tmpconst->val->cpnode.Long.low_bytes)); } break; case CONSTANT_Double: if(isBigEndian()) { memcpy(&x,&tmpconst->val->cpnode.Double.high_bytes,sizeof(u4)); memcpy((char*)&x+4,&tmpconst->val->cpnode.Double.low_bytes,sizeof(u4)); printf("\tdouble: %f (high: %d, low: %d)\n",x, tmpconst->val->cpnode.Double.high_bytes, tmpconst->val->cpnode.Double.low_bytes); } else { u4 t1,t2; t1 = cp_big_endian_u4(tmpconst->val->cpnode.Double.high_bytes); t2 = cp_big_endian_u4(tmpconst->val->cpnode.Double.low_bytes); memcpy(&x, &t2, sizeof(u4)); memcpy((char*)&x+4, &t1, sizeof(u4)); printf("\tdouble: %f (high: %d, low: %d) (conv to little endian)\n",x, cp_big_endian_u4(tmpconst->val->cpnode.Double.high_bytes), cp_big_endian_u4(tmpconst->val->cpnode.Double.low_bytes)); } break; case CONSTANT_Class: tmpconst2 = cp_entry_by_index(class,tmpconst->val->cpnode.Class.name_index); tmp_str = cp_null_term_utf8(tmpconst2->val); printf("\tclass index: %d -> %s\n",tmpconst->val->cpnode.Class.name_index, tmp_str); free(tmp_str); break; case CONSTANT_String: printf("\tstring index: %d\n",tmpconst->val->cpnode.String.string_index); break; case CONSTANT_Fieldref: printf("\tclass index(declaring this field): %d\n", tmpconst->val->cpnode.Methodref.class_index); printf("\tname and type index(of this field): %d\n", tmpconst->val->cpnode.Methodref.name_and_type_index); break; case CONSTANT_Methodref: printf("\tclass index(declaring this method): %d\n", tmpconst->val->cpnode.Methodref.class_index); printf("\tname and type index(of this method): %d\n", tmpconst->val->cpnode.Methodref.name_and_type_index); break; case CONSTANT_InterfaceMethodref: printf("\tclass index(declaring this interface): %d\n", tmpconst->val->cpnode.Methodref.class_index); printf("\tname and type index(of this interface): %d\n", tmpconst->val->cpnode.Methodref.name_and_type_index); break; case CONSTANT_NameAndType: printf("\tname index: %d\n",tmpconst->val->cpnode.NameAndType.name_index); printf("\tdescriptor index: %d\n", tmpconst->val->cpnode.NameAndType.descriptor_index); break; default: debug_err("cp_dump(): Unknown tag!\n"); break; /* unnecessary break for ANSI compliance */ } } } /** * Creates a null-terminated version of the given utf8 constant pool entry. * * @param val -- The utf8 entry. * * @returns A null-terminated string. On error returns NULL. **/ char * cp_null_term_utf8(CP_INFO *val) { char * temp; if(!val) { BAD_ARG(); return NULL; } temp = (char *)malloc(val->cpnode.Utf8.length + 1); if(!temp) return NULL; strncpy(temp,(char *)val->cpnode.Utf8.bytes,val->cpnode.Utf8.length); temp[val->cpnode.Utf8.length] = '\0'; return temp; } /** * This function converts a u2 (unsigned short) to big endian format. if the * machine is big endian already, we do nothing. otherwise, we reverse the * byte order and return the reversed number. * * @param num -- The unsigned short to be converted. * * @returns Big endian version of the specified number. **/ u2 cp_big_endian_u2(u2 num) { if(isBigEndian()) return num; else return (num>>8)+((num&0xFF)<<8); } /** * This function converts a u4 (unsigned int) to big endian format. if the * machine is big endian already, we do nothing. otherwise, we reverse the * byte order and return the reversed number. * * @param num -- The unsigned int to be converted. * * @returns Big endian version of the specified number. **/ u4 cp_big_endian_u4(u4 num) { if(isBigEndian()) return num; else return ((num & 0xFF)<<24) + ((num >> 8 & 0xFF)<<16) + ((num >> 16 & 0xFF)<<8) + (num >> 24); } /***************************************************************************** ***************************************************************************** ** ** ** Functions after this point are not exposed as part of the API. ** ** ** ***************************************************************************** *****************************************************************************/ /** * Inserts the given CP_INFO node into the constant pool list. * * @param class -- The class containing the constant pool into which the * node will be inserted. * @param node -- The node to be inserted. * * @returns The constant pool index of the node after insertion. * Returns -1 on error. **/ static int cp_insert(JVM_CLASS *class, CP_INFO *node) { CP_NODE * n; Dlist cp; if(!class || !node) { BAD_ARG(); return -1; } cp = class->constant_pool; debug_msg("&& in cp_insert, inserting node w/tag = %s\n", jvm_constant_tags[node->tag]); n = (CP_NODE *)malloc(sizeof(CP_NODE)); if(!n) return -1; n->val = node; n->index = dl_empty(cp) ? 1 : ((CP_NODE *) dl_last(cp)->val)->next_idx; n->next_idx = n->index + cp_entry_width[node->tag]; dl_insert_b(cp, n); return n->index; } /** * This function inserts a Constant into the constants_table. We're keeping * track of constants in order to build the constant pool for bytecode * generation. * * @param class -- The class containing the constant pool to be searched. * @param tok -- The type of constant contained in the 'val' argument. * @param val -- The constant value to be inserted. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index of the value after insertion. * Returns -1 on error. **/ static int insert_constant(JVM_CLASS *class, int tok, const void *val, BOOL force_insert) { if(!class || !val) { BAD_ARG(); return -1; } switch(tok) { case CP_INTEGER_CONST: return insert_int_constant(class, val, force_insert); case CP_FLOAT_CONST: return insert_float_constant(class, val, force_insert); case CP_LONG_CONST: return insert_long_constant(class, val, force_insert); case CP_EXPONENTIAL_CONST: case CP_DOUBLE_CONST: return insert_double_constant(class, val, force_insert); case CP_TRUE_CONST: case CP_FALSE_CONST: /* boolean literals do not need constant pool entries because * we can use the iconst_1 opcode for TRUE and iconst_0 for FALSE. */ return -1; case CP_STRING_CONST: return insert_string_constant(class, val, force_insert); } return -1; } /** * This function returns the endianness of the machine we're running on. * Such information is used during bytecode generation since the numerical * constants are always stored in big endian format. * * @returns TRUE if this machine is big endian, FALSE otherwise. **/ static BOOL isBigEndian() { #ifdef WORDS_BIGENDIAN return TRUE; #else return FALSE; #endif } /** * Searches the constant pool for a UTF8 string. * * @param class -- The class containing the constant pool to be searched. * @param value -- The UTF8 constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_utf8(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&&hit utf8 constant\n"); debug_msg("&&value = %s\n",(char *)value); dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if(ctemp->tag == CONSTANT_Utf8) { if(strlen((char*)value) == (unsigned int)ctemp->cpnode.Utf8.length) if(!strncmp((char*)ctemp->cpnode.Utf8.bytes, (char*)value, ctemp->cpnode.Utf8.length) ) return ((CP_NODE *)(temp->val))->index; } } return -1; } /** * Searches the constant pool for an integer constant. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_int(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; if(!class || !value) { BAD_ARG(); return -1; } dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if( ctemp->tag == CONSTANT_Integer) { u4 ival = cp_big_endian_u4( *((u4*)value) ); if(!memcmp((void *)&ival, (void*)&ctemp->cpnode.Integer.bytes, sizeof(u4))) return ((CP_NODE *)(temp->val))->index; } } return -1; } /** * Searches the constant pool for a float constant. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_float(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; if(!class || !value) { BAD_ARG(); return -1; } dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if( ctemp->tag == CONSTANT_Float) { u4 fval = cp_big_endian_u4( *((u4*)value) ); if(!memcmp((void *)&fval, (void*)&ctemp->cpnode.Float.bytes, sizeof(u4))) return ((CP_NODE *)(temp->val))->index; } } return -1; } /** * Searches the constant pool for a long constant. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_long(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; if(!class || !value) { BAD_ARG(); return -1; } dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if( ctemp->tag == CONSTANT_Long) { u4 hi_bytes, lo_bytes; memcpy(&hi_bytes,value,sizeof(u4)); memcpy(&lo_bytes,(char*)value+4,sizeof(u4)); /* convert byte order if necessary, then compare, and return */ if(!isBigEndian()) { u4 bytetemp = hi_bytes; hi_bytes = cp_big_endian_u4(lo_bytes); lo_bytes = cp_big_endian_u4(bytetemp); } if( !memcmp(&hi_bytes, (void *)&ctemp->cpnode.Long.high_bytes, sizeof(u4)) && !memcmp(&lo_bytes, (void *)&ctemp->cpnode.Long.low_bytes, sizeof(u4))) return ((CP_NODE *)(temp->val))->index; } } return -1; } /** * Searches the constant pool for a double precision constant. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_double(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; if(!class || !value) { BAD_ARG(); return -1; } dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if( ctemp->tag == CONSTANT_Double) { u4 hi_bytes, lo_bytes; memcpy(&hi_bytes,value,sizeof(u4)); memcpy(&lo_bytes,(char*)value+4,sizeof(u4)); /* convert byte order if necessary, then compare, and return */ if(!isBigEndian()) { u4 bytetemp = hi_bytes; hi_bytes = cp_big_endian_u4(lo_bytes); lo_bytes = cp_big_endian_u4(bytetemp); } if( !memcmp(&hi_bytes, (void *)&ctemp->cpnode.Double.high_bytes, sizeof(u4)) && !memcmp(&lo_bytes, (void *)&ctemp->cpnode.Double.low_bytes, sizeof(u4))) return ((CP_NODE *)(temp->val))->index; } } return -1; } /** * Searches the constant pool for a class constant. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_class(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; int this_len; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&&hit class constant\n"); debug_msg("&&value = %s\n",(char *)value); dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if(ctemp->tag == CONSTANT_Class) { this_len = cp_entry_by_index(class, ctemp->cpnode.Class.name_index)->val->cpnode.Utf8.length; if(!this_len) continue; if((unsigned int)this_len == strlen((char*) value)) { CP_NODE *e = cp_entry_by_index(class, ctemp->cpnode.Class.name_index); if(!e) continue; if(!strncmp( (char *) (e->val->cpnode.Utf8.bytes), (char *)value, strlen((char*)value))) return ((CP_NODE *)(temp->val))->index; } } } return -1; } /** * Searches the constant pool for a method/field reference. * * @param class -- The class containing the constant pool to be searched. * @param tag -- The type of constant contained in the 'value' argument. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_ref(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) { Dlist temp; CP_INFO * ctemp; JVM_METHODREF *mref = (JVM_METHODREF *)value; CP_NODE *nameref; if(!class || !value) { BAD_ARG(); return -1; } #define err_lookup() \ if(tmpC) free(tmpC); \ if(tmpM) free(tmpM); \ if(tmpM) free(tmpD); debug_msg("&&looking up Method/field ref\n"); debug_msg("&& mref->classname = '%s'\n",mref->classname); debug_msg("&& mref->methodname = '%s'\n",mref->methodname); debug_msg("&& mref->descriptor = '%s'\n",mref->descriptor); /* for the methodref to match, we need to check that the class, method, * and descriptor strings all match. */ dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if(ctemp->tag == tag) { char *tmpC, *tmpM, *tmpD; tmpC = tmpM = tmpD = NULL; nameref = cp_entry_by_index(class,ctemp->cpnode.Methodref.class_index); if(!nameref) continue; nameref = cp_entry_by_index(class,nameref->val->cpnode.Class.name_index); if(!nameref) continue; tmpC = cp_null_term_utf8(nameref->val); if(!tmpC) continue; debug_msg("&& name_nad_type_index = %d\n", ctemp->cpnode.Methodref.name_and_type_index); nameref = cp_entry_by_index(class, ctemp->cpnode.Methodref.name_and_type_index); if(!nameref) { err_lookup(); continue; } debug_msg("&& name index = %d\n", nameref->val->cpnode.NameAndType.name_index); nameref = cp_entry_by_index(class, nameref->val->cpnode.NameAndType.name_index); if(!nameref) { err_lookup(); continue; } debug_msg("&& ok, nodetype of nameref is %s\n", jvm_constant_tags[nameref->val->tag]); debug_msg("&& name[0] = %c\n",nameref->val->cpnode.Utf8.bytes[0]); tmpM = cp_null_term_utf8(nameref->val); if(!tmpM) { err_lookup(); continue; } nameref = cp_entry_by_index(class, ctemp->cpnode.Methodref.name_and_type_index); if(!nameref) { err_lookup(); continue; } nameref = cp_entry_by_index(class, nameref->val->cpnode.NameAndType.descriptor_index); if(!nameref) { err_lookup(); continue; } tmpD = cp_null_term_utf8(nameref->val); if(!tmpD) { err_lookup(); continue; } if( !strcmp(tmpC, mref->classname) && !strcmp(tmpM, mref->methodname) && !strcmp(tmpD, mref->descriptor) ) { err_lookup(); return ((CP_NODE *)(temp->val))->index; } else { err_lookup(); } } } #undef err_lookup return -1; } /** * Searches the constant pool for a name and type reference. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_nameandtype(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; JVM_METHODREF *mref = (JVM_METHODREF *)value; CP_NODE *nref, *dref; char *tmpM, *tmpD; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&& up NameAndType\n"); debug_msg("&& mref->classname = '%s'\n",mref->classname); debug_msg("&& mref->methodname = '%s'\n",mref->methodname); debug_msg("&& mref->descriptor = '%s'\n",mref->descriptor); dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if(ctemp->tag == CONSTANT_NameAndType) { nref = cp_entry_by_index(class,ctemp->cpnode.NameAndType.name_index); if(!nref) continue; dref = cp_entry_by_index(class,ctemp->cpnode.NameAndType.descriptor_index); if(!dref) continue; tmpM = cp_null_term_utf8(nref->val); if(!tmpM) continue; tmpD = cp_null_term_utf8(dref->val); if(!tmpD) { free(tmpM); continue; } if( !strcmp(tmpM, mref->methodname) && !strcmp(tmpD, mref->descriptor)) { free(tmpM); free(tmpD); return ((CP_NODE *)(temp->val))->index; } else { free(tmpM); free(tmpD); } } } return -1; } /** * Searches the constant pool for a String constant. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be searched for. * * @returns If the value is found, return its constant pool index. * Return -1 otherwise. **/ static int cp_lookup_string(JVM_CLASS *class, const void *value) { Dlist temp; CP_INFO * ctemp; CP_NODE *sref; char *tmpS; if(!class || !value) { BAD_ARG(); return -1; } dl_traverse(temp,class->constant_pool) { ctemp = ((CP_NODE *)(temp->val))->val; if(ctemp->tag == CONSTANT_String) { sref = cp_entry_by_index(class,ctemp->cpnode.String.string_index); if(!sref) continue; tmpS = cp_null_term_utf8(sref->val); if(!tmpS) continue; if(!strcmp(tmpS,(char *)value)) { free(tmpS); return ((CP_NODE *)(temp->val))->index; } else free(tmpS); } } return -1; } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be inserted. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_class(JVM_CLASS *class, const void *value) { CP_INFO *newnode; int temp; char *t; int i; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&& find/insert Class %s...\n",(char*)value); t = strdup((char *)value); if(!t) return -1; for(i=0;itag = CONSTANT_Class; newnode->cpnode.Class.name_index = temp; /* now return the CP_NODE pointer created by cp_insert */ return cp_insert(class,newnode); } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param tag -- The type of constant contained in the 'value' argument. * @param value -- The constant value to be inserted. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_ref(JVM_CLASS *class, JVM_CONSTANT tag, const void *value) { JVM_METHODREF *mref = (JVM_METHODREF *)value; CP_INFO *newnode; int temp; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&& ok.. going to find/insert a method reference...\n"); newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = (u1) tag; debug_msg("&& first find/insert %s...\n",mref->classname); temp = cp_find_or_insert(class,CONSTANT_Class,mref->classname); if(temp < 0) { free(newnode); return -1; } newnode->cpnode.Methodref.class_index = temp; debug_msg("&& then find/insert the name_and_type...\n"); temp = cp_find_or_insert(class,CONSTANT_NameAndType,mref); if(temp < 0) { free(newnode); return -1; } newnode->cpnode.Methodref.name_and_type_index = temp; return cp_insert(class,newnode); } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be inserted. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_nameandtype(JVM_CLASS *class, const void *value) { JVM_METHODREF *mref = (JVM_METHODREF *)value; CP_INFO *newnode; int temp; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&& find/insert NameAndType...\n"); newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_NameAndType; temp = cp_find_or_insert(class,CONSTANT_Utf8,mref->methodname); if(temp < 0) { free(newnode); return -1; } newnode->cpnode.NameAndType.name_index = temp; temp = cp_find_or_insert(class,CONSTANT_Utf8,mref->descriptor); if(temp < 0) { free(newnode); return -1; } newnode->cpnode.NameAndType.descriptor_index = temp; return cp_insert(class,newnode); } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param value -- The constant value to be inserted. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_utf8(JVM_CLASS *class, const void *value) { CP_INFO *newnode; if(!class || !value) { BAD_ARG(); return -1; } newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_Utf8; newnode->cpnode.Utf8.length = strlen(value); newnode->cpnode.Utf8.bytes = (u1 *) malloc(newnode->cpnode.Utf8.length); if(!newnode->cpnode.Utf8.bytes) { free(newnode); return -1; } strncpy((char*)newnode->cpnode.Utf8.bytes,value,newnode->cpnode.Utf8.length); return cp_insert(class, newnode); } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param val -- The constant value to be inserted. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_int_constant(JVM_CLASS *class, const void *val, BOOL force_insert) { CP_INFO * newnode; int intVal; if(!class || !val) { BAD_ARG(); return -1; } intVal = *((int*)val); /* if integer value is between JVM_SHORT_MIN and JVM_SHORT_MAX, * then we do not need to use the ldc opcode. Thus, there's no * need to create a constant pool entry. */ if(( (cp_lookup(class, CONSTANT_Integer, (void *)&intVal) < 0) && (intVal < JVM_SHORT_MIN || intVal > JVM_SHORT_MAX) ) || force_insert) { newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_Integer; newnode->cpnode.Integer.bytes = cp_big_endian_u4((u4)intVal); return cp_insert(class, newnode); } return -1; } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param val -- The constant value to be inserted. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_float_constant(JVM_CLASS *class, const void *val, BOOL force_insert) { CP_INFO * newnode; float floatVal; if(!class || !val) { BAD_ARG(); return -1; } floatVal = *((float *)val); /* if float value is 0.0, 1.0, or 2.0 then we can use * the fconst_ opcode. Thus, there's no * need to create a constant pool entry. */ if(( (cp_lookup(class, CONSTANT_Float, (void *)&floatVal) < 0) && ( floatVal != 0.0 && floatVal != 1.0 && floatVal != 2.0) ) || force_insert) { u4 tmp; memcpy(&tmp,&floatVal,sizeof(tmp)); newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_Float; newnode->cpnode.Float.bytes = cp_big_endian_u4(tmp); return cp_insert(class, newnode); } return -1; } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param val -- The constant value to be inserted. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_long_constant(JVM_CLASS *class, const void *val, BOOL force_insert) { CP_INFO * newnode; u4 tmp1, tmp2; u8 longVal; if(!class || !val) { BAD_ARG(); return -1; } longVal = *((u8 *)val); /* if long value is 0 or 1, then we can use * the lconst_ opcode. Thus, there's no * need to create a constant pool entry. */ if(( (cp_lookup(class, CONSTANT_Long, (void *)&longVal) < 0) && ( longVal != 0 && longVal != 1 ) ) || force_insert) { newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_Long; memcpy(&tmp1,&longVal,sizeof(tmp1)); memcpy(&tmp2,(char*)&longVal+4,sizeof(tmp2)); if(isBigEndian()) { newnode->cpnode.Long.high_bytes = tmp1; newnode->cpnode.Long.low_bytes = tmp2; } else { newnode->cpnode.Long.high_bytes = cp_big_endian_u4(tmp2); newnode->cpnode.Long.low_bytes = cp_big_endian_u4(tmp1); } return cp_insert(class, newnode); } return -1; } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param val -- The constant value to be inserted. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_double_constant(JVM_CLASS *class, const void *val, BOOL force_insert) { unsigned int tmp1, tmp2; CP_INFO * newnode; double doubleVal; if(!class || !val) { BAD_ARG(); return -1; } doubleVal = *((double *)val); /* if double value is 0.0 or 1.0, then we can use * the dconst_ opcode. Thus, there's no * need to create a constant pool entry. */ if(( (cp_lookup(class, CONSTANT_Double, (void *)&doubleVal) < 0) && ( doubleVal != 0.0 && doubleVal != 1.0 ) ) || force_insert) { newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_Double; memcpy(&tmp1,&doubleVal,sizeof(tmp1)); memcpy(&tmp2,(char*)&doubleVal+4,sizeof(tmp2)); if(isBigEndian()) { newnode->cpnode.Double.high_bytes = tmp1; newnode->cpnode.Double.low_bytes = tmp2; } else { newnode->cpnode.Double.high_bytes = cp_big_endian_u4(tmp2); newnode->cpnode.Double.low_bytes = cp_big_endian_u4(tmp1); } return cp_insert(class, newnode); } return -1; } /** * Inserts a class constant into the constant pool. * * @param class -- The class containing the constant pool to be searched. * @param val -- The constant value to be inserted. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index for the given constant value. * On error, returns -1. **/ static int insert_string_constant(JVM_CLASS *class, const void *val, BOOL force_insert) { CP_INFO * newnode; int idx; if(!class || !val) { BAD_ARG(); return -1; } /* unique string literals always go into the constant pool. * first, we have to create a CONSTANT_Utf8 entry for the * string itself. then we create a CONSTANT_String entry * whose string_index points to the Utf8 string. * * Note that we only malloc enough for the string itself * since the Utf8 string should not be null-terminated. */ debug_msg("inserting a string... '%s'\n",(char *)val); idx = cp_lookup(class, CONSTANT_Utf8, val); if(idx < 0) { debug_msg("&& in insert_constant, inserting '%s'\n",(char *)val); newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_Utf8; newnode->cpnode.Utf8.length = strlen(val); newnode->cpnode.Utf8.bytes = (u1 *) malloc(newnode->cpnode.Utf8.length); if(!newnode->cpnode.Utf8.bytes) { free(newnode); return -1; } strncpy((char *)newnode->cpnode.Utf8.bytes, val, newnode->cpnode.Utf8.length); idx = cp_insert(class, newnode); } else if(idx == 0) { debug_err("WARNING insert_constant(): idx is 0\n"); } newnode = (CP_INFO *)malloc(sizeof(CP_INFO)); if(!newnode) return -1; newnode->tag = CONSTANT_String; newnode->cpnode.String.string_index = (u2)idx; return cp_insert(class, newnode); } /** * Find the constant pool index for the given constant if it exists in * the constant pool. If not, create a new entry and return its index. * See cp_find_or_insert(). * * @param class -- The class containing the constant pool to be searched. * @param tag -- The type of constant contained in the 'value' argument. * @param value -- The constant value to be searched for. * @param force_insert -- If FALSE, certain constants will be excluded * depending on the data type/value (see cp_find_or_insert()). If TRUE, * the constant will be inserted regardless of its value. * * @returns The constant pool index for the given constant value. * If the value was not inserted because it was a special value * as mentioned above or if an error occurred then -1 is returned. **/ static int cp_find_function_body(JVM_CLASS *class, JVM_CONSTANT tag, const void *value, BOOL force_insert) { int temp; if(!class || !value) { BAD_ARG(); return -1; } debug_msg("&& cp_find_or_insert\n"); /* First, check to see if it's already in the list. */ if( (temp = cp_lookup(class,tag,value)) >= 0 ) { debug_msg("&& found entry, returning\n"); return temp; } debug_msg("&& entry not found, continuing...\n"); /* It's not in the list, so we insert it and return a pointer to * the new node */ switch(tag) { case CONSTANT_Class: return insert_class(class, value); case CONSTANT_Fieldref: case CONSTANT_InterfaceMethodref: case CONSTANT_Methodref: return insert_ref(class, tag, value); case CONSTANT_NameAndType: return insert_nameandtype(class, value); case CONSTANT_Utf8: return insert_utf8(class, value); case CONSTANT_Integer: return insert_constant(class, CP_INTEGER_CONST, value, force_insert); case CONSTANT_Float: return insert_constant(class, CP_FLOAT_CONST, value, force_insert); case CONSTANT_Long: return insert_constant(class, CP_LONG_CONST, value, force_insert); case CONSTANT_Double: return insert_constant(class, CP_DOUBLE_CONST, value, force_insert); case CONSTANT_String: return insert_constant(class, CP_STRING_CONST, value, force_insert); default: debug_err("cp_find_or_insert: WARNING - tag not yet implemented!\n"); return -1; } /* should never hit this return stmt once this function is fully-implemented. * still might return NULL from elsewhere if insert_constant returns NULL, * though (e.g. if trying to insert integer 0, etc). */ return -1; } f2j-0.8.1/libbytecode/constant_pool.h0000600000077700002310000000301511031241063017561 0ustar seymourgraduate#ifndef _CONSTANT_POOL_H #define _CONSTANT_POOL_H #include #include "bytecode.h" static int cp_find_function_body(JVM_CLASS *, JVM_CONSTANT, const void *, BOOL), cp_lookup_utf8(JVM_CLASS *, const void *), cp_lookup_int(JVM_CLASS *, const void *), cp_lookup_float(JVM_CLASS *, const void *), cp_lookup_long(JVM_CLASS *, const void *), cp_lookup_double(JVM_CLASS *, const void *), cp_lookup_class(JVM_CLASS *, const void *), cp_lookup_ref(JVM_CLASS *, JVM_CONSTANT, const void *), cp_lookup_nameandtype(JVM_CLASS *, const void *), cp_lookup_string(JVM_CLASS *, const void *), cp_insert(JVM_CLASS *, CP_INFO *), insert_class(JVM_CLASS *, const void *), insert_ref(JVM_CLASS *, JVM_CONSTANT, const void *), insert_nameandtype(JVM_CLASS *, const void *), insert_utf8(JVM_CLASS *, const void *), insert_int_constant(JVM_CLASS *, const void *, BOOL), insert_float_constant(JVM_CLASS *, const void *, BOOL), insert_long_constant(JVM_CLASS *, const void *, BOOL), insert_double_constant(JVM_CLASS *, const void *, BOOL), insert_string_constant(JVM_CLASS *, const void *, BOOL), insert_constant(JVM_CLASS *, int, const void *, BOOL); static BOOL isBigEndian(); const char * jvm_constant_tags[] = { "Unknown CONSTANT", "CONSTANT_Utf8", "Unknown CONSTANT", "CONSTANT_Integer", "CONSTANT_Float", "CONSTANT_Long", "CONSTANT_Double", "CONSTANT_Class", "CONSTANT_String", "CONSTANT_Fieldref", "CONSTANT_Methodref", "CONSTANT_InterfaceMethodref", "CONSTANT_NameAndType" }; #endif f2j-0.8.1/libbytecode/dlist.c0000600000077700002310000000371011031241063016013 0ustar seymourgraduate/* Jim Plank's dlist routines. Contact plank@cs.utk.edu */ #include /* Basic includes and definitions */ #include #include "dlist.h" /*---------------------------------------------------------------------* * PROCEDURES FOR MANIPULATING DOUBLY LINKED LISTS * Each list contains a sentinal node, so that * the first item in list l is l->flink. If l is * empty, then l->flink = l->blink = l. *---------------------------------------------------------------------*/ Dlist make_dl() { Dlist d; d = (Dlist) malloc (sizeof(struct dlist)); if(!d) return NULL; d->flink = d; d->blink = d; d->val = (void *) 0; return d; } void dl_insert_b(node, val) /* Inserts to the end of a list */ Dlist node; void *val; { Dlist last_node, new; new = (Dlist) malloc (sizeof(struct dlist)); new->val = val; last_node = node->blink; node->blink = new; last_node->flink = new; new->blink = last_node; new->flink = node; } void dl_insert_list_b(Dlist node, Dlist list_to_insert) { Dlist last_node, f, l; if (dl_empty(list_to_insert)) { free(list_to_insert); return; } f = list_to_insert->flink; l = list_to_insert->blink; last_node = node->blink; node->blink = l; last_node->flink = f; f->blink = last_node; l->flink = node; free(list_to_insert); } void dl_delete_node(item) /* Deletes an arbitrary iterm */ Dlist item; { item->flink->blink = item->blink; item->blink->flink = item->flink; free(item); } void dl_delete_list(l) Dlist l; { Dlist d, next_node; if(l == NULL) return; d = l->flink; while(d != l) { next_node = d->flink; free(d); d = next_node; } free(d); } void * dl_val(l) Dlist l; { return l->val; } void* dl_pop(li) Dlist li; { Dlist item = dl_last(li); void *tmp; if(item == NULL) return NULL; item->flink->blink = item->blink; item->blink->flink = item->flink; tmp = dl_val(item); free(item); return tmp; } f2j-0.8.1/libbytecode/dlist.h0000600000077700002310000000306111031241063016017 0ustar seymourgraduate/* Jim Plank's dlist routines. Contact plank@cs.utk.edu */ #ifndef _DLIST_H #define _DLIST_H typedef struct dlist { struct dlist *flink; struct dlist *blink; void *val; } *Dlist; /* Nil, first, next, and prev are macro expansions for list traversal * primitives. */ #define dl_nil(l) (l) #define dl_first(l) (l->flink) #define dl_last(l) (l->blink) #define dl_next(n) (n->flink) #define dl_prev(n) (n->blink) /* These are the routines for manipluating lists */ extern Dlist make_dl(void); extern void dl_insert_b(Dlist, void *); /* Makes a new node, and inserts it before the given node -- if that node is the head of the list, the new node is inserted at the end of the list */ #define dl_insert_a(n, val) dl_insert_b(n->flink, val) extern void dl_delete_node(Dlist); /* Deletes and free's a node */ extern void dl_delete_list(Dlist); /* Deletes the entire list from existance */ extern void *dl_val(Dlist); /* Returns node->val (used to shut lint up) */ extern void *dl_pop(Dlist); /* returns the first node and removes it from the list */ extern void dl_insert_list_b(Dlist, Dlist); #define dl_traverse(ptr, list) \ for (ptr = dl_first(list); ptr != dl_nil(list); ptr = dl_next(ptr)) #define dl_traverse_b(ptr, list) \ for (ptr = dl_last(list); ptr != dl_nil(list); ptr = dl_prev(ptr)) #define dl_empty(list) (list->flink == list) #endif f2j-0.8.1/libbytecode/globals.c0000600000077700002310000003071611031241063016325 0ustar seymourgraduate/** @file globals.c * Contains global variables for the library. */ #include "bytecode.h" /** * This table stores the number of constant pool entries required * by each of the constant pool data types. */ const int cp_entry_width[] = { 1, /* no tag 0 */ 1, /* CONSTANT_Utf8 */ 1, /* tag 2 intentionally missing */ 1, /* CONSTANT_Integer */ 1, /* CONSTANT_Float, */ 2, /* CONSTANT_Long, */ 2, /* CONSTANT_Double, */ 1, /* CONSTANT_Class, */ 1, /* CONSTANT_String, */ 1, /* CONSTANT_Fieldref, */ 1, /* CONSTANT_Methodref, */ 1, /* CONSTANT_InterfaceMethodref, */ 1, /* CONSTANT_NameAndType */ }; /** * This table stores the number of local variable entries * required by each of the JVM data types. */ const int jvm_localvar_width[] = { 1, /* jvm_Byte */ 1, /* jvm_Short */ 1, /* jvm_Int */ 2, /* jvm_Long */ 1, /* jvm_Char */ 1, /* jvm_Float */ 2, /* jvm_Double */ 1 /* jvm_Object */ }; /** * This table stores the operands for the newarray instruction. */ const int jvm_newarray_type[] = { JVM_T_BYTE, /* jvm_Byte */ JVM_T_SHORT, /* jvm_Short */ JVM_T_INT, /* jvm_Int */ JVM_T_LONG, /* jvm_Long */ JVM_T_CHAR, /* jvm_Char */ JVM_T_FLOAT, /* jvm_Float */ JVM_T_DOUBLE, /* jvm_Double */ JVM_T_UNUSED /* jvm_Object */ }; /** * Shorthand opcodes for loading integer constants -1 through 5. */ const JVM_OPCODE jvm_iconst_op[7] = { jvm_iconst_m1, jvm_iconst_0, jvm_iconst_1, jvm_iconst_2, jvm_iconst_3, jvm_iconst_4, jvm_iconst_5 }; /** * Opcodes to load local variables. */ const JVM_OPCODE jvm_load_op[JVM_MAX_RETURNS+1] = { jvm_iload, jvm_iload, jvm_iload, jvm_lload, jvm_iload, jvm_fload, jvm_dload, jvm_aload }; /** * Opcodes to load from arrays. */ const JVM_OPCODE jvm_array_load_op[JVM_MAX_RETURNS+1] = { jvm_baload, jvm_saload, jvm_iaload, jvm_laload, jvm_caload, jvm_faload, jvm_daload, jvm_aaload }; /** * Opcodes to store local variables. */ const JVM_OPCODE jvm_store_op[JVM_MAX_RETURNS+1] = { jvm_istore, jvm_istore, jvm_istore, jvm_lstore, jvm_istore, jvm_fstore, jvm_dstore, jvm_astore }; /** * Opcodes to store into arrays. */ const JVM_OPCODE jvm_array_store_op[JVM_MAX_RETURNS+1] = { jvm_bastore, jvm_sastore, jvm_iastore, jvm_lastore, jvm_castore, jvm_fastore, jvm_dastore, jvm_aastore }; /** * Shorthand opcodes for storing local variables 0 through 3. */ const JVM_OPCODE jvm_short_store_op[JVM_MAX_RETURNS+1][4] = { {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3}, {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3}, {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3}, {jvm_lstore_0, jvm_lstore_1, jvm_lstore_2, jvm_lstore_3}, {jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3}, {jvm_fstore_0, jvm_fstore_1, jvm_fstore_2, jvm_fstore_3}, {jvm_dstore_0, jvm_dstore_1, jvm_dstore_2, jvm_dstore_3}, {jvm_astore_0, jvm_astore_1, jvm_astore_2, jvm_astore_3} }; /** * Shorthand opcodes for loading local variables 0 through 3. */ const JVM_OPCODE jvm_short_load_op[JVM_MAX_RETURNS+1][4] = { {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3}, {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3}, {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3}, {jvm_lload_0, jvm_lload_1, jvm_lload_2, jvm_lload_3}, {jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3}, {jvm_fload_0, jvm_fload_1, jvm_fload_2, jvm_fload_3}, {jvm_dload_0, jvm_dload_1, jvm_dload_2, jvm_dload_3}, {jvm_aload_0, jvm_aload_1, jvm_aload_2, jvm_aload_3} }; /** * This table stores information about all the JVM instructions. * Each entry has four parts: * * -# opcode - string representation of the opcode * -# width - total width of the instruction plus operands * -# pre-stack - number of stack items popped before issuing the instruction * -# post-stack - number of stack items pushed after issuing the instruction */ const JVM_OP_INFO jvm_opcode[] = { {"nop", 1, 0, 0}, {"aconst_null", 1, 0, 1}, {"iconst_m1", 1, 0, 1}, {"iconst_0", 1, 0, 1}, {"iconst_1", 1, 0, 1}, {"iconst_2", 1, 0, 1}, {"iconst_3", 1, 0, 1}, {"iconst_4", 1, 0, 1}, {"iconst_5", 1, 0, 1}, {"lconst_0", 1, 0, 2}, {"lconst_1", 1, 0, 2}, {"fconst_0", 1, 0, 1}, {"fconst_1", 1, 0, 1}, {"fconst_2", 1, 0, 1}, {"dconst_0", 1, 0, 2}, {"dconst_1", 1, 0, 2}, {"bipush", 2, 0, 1}, {"sipush", 3, 0, 1}, {"ldc", 2, 0, 1}, {"ldc_w", 3, 0, 1}, {"ldc2_w", 3, 0, 2}, {"iload", 2, 0, 1}, {"lload", 2, 0, 2}, {"fload", 2, 0, 1}, {"dload", 2, 0, 2}, {"aload", 2, 0, 1}, {"iload_0", 1, 0, 1}, {"iload_1", 1, 0, 1}, {"iload_2", 1, 0, 1}, {"iload_3", 1, 0, 1}, {"lload_0", 1, 0, 2}, {"lload_1", 1, 0, 2}, {"lload_2", 1, 0, 2}, {"lload_3", 1, 0, 2}, {"fload_0", 1, 0, 1}, {"fload_1", 1, 0, 1}, {"fload_2", 1, 0, 1}, {"fload_3", 1, 0, 1}, {"dload_0", 1, 0, 2}, {"dload_1", 1, 0, 2}, {"dload_2", 1, 0, 2}, {"dload_3", 1, 0, 2}, {"aload_0", 1, 0, 1}, {"aload_1", 1, 0, 1}, {"aload_2", 1, 0, 1}, {"aload_3", 1, 0, 1}, {"iaload", 1, 2, 1}, {"laload", 1, 2, 2}, {"faload", 1, 2, 1}, {"daload", 1, 2, 2}, {"aaload", 1, 2, 1}, {"baload", 1, 2, 1}, {"caload", 1, 2, 1}, {"saload", 1, 2, 1}, {"istore", 2, 1, 0}, {"lstore", 2, 2, 0}, {"fstore", 2, 1, 0}, {"dstore", 2, 2, 0}, {"astore", 2, 1, 0}, {"istore_0", 1, 1, 0}, {"istore_1", 1, 1, 0}, {"istore_2", 1, 1, 0}, {"istore_3", 1, 1, 0}, {"lstore_0", 1, 2, 0}, {"lstore_1", 1, 2, 0}, {"lstore_2", 1, 2, 0}, {"lstore_3", 1, 2, 0}, {"fstore_0", 1, 1, 0}, {"fstore_1", 1, 1, 0}, {"fstore_2", 1, 1, 0}, {"fstore_3", 1, 1, 0}, {"dstore_0", 1, 2, 0}, {"dstore_1", 1, 2, 0}, {"dstore_2", 1, 2, 0}, {"dstore_3", 1, 2, 0}, {"astore_0", 1, 1, 0}, {"astore_1", 1, 1, 0}, {"astore_2", 1, 1, 0}, {"astore_3", 1, 1, 0}, {"iastore", 1, 3, 0}, {"lastore", 1, 4, 0}, {"fastore", 1, 3, 0}, {"dastore", 1, 4, 0}, {"aastore", 1, 3, 0}, {"bastore", 1, 3, 0}, {"castore", 1, 3, 0}, {"sastore", 1, 3, 0}, {"pop", 1, 1, 0}, {"pop2", 1, 2, 0}, {"dup", 1, 1, 2}, {"dup_x1", 1, 2, 3}, {"dup_x2", 1, 3, 4}, {"dup2", 1, 2, 4}, {"dup2_x1", 1, 3, 5}, {"dup2_x2", 1, 4, 6}, {"swap", 1, 2, 2}, {"iadd", 1, 2, 1}, {"ladd", 1, 4, 2}, {"fadd", 1, 2, 1}, {"dadd", 1, 4, 2}, {"isub", 1, 2, 1}, {"lsub", 1, 4, 2}, {"fsub", 1, 2, 1}, {"dsub", 1, 4, 2}, {"imul", 1, 2, 1}, {"lmul", 1, 4, 2}, {"fmul", 1, 2, 1}, {"dmul", 1, 4, 2}, {"idiv", 1, 2, 1}, {"ldiv", 1, 4, 2}, {"fdiv", 1, 2, 1}, {"ddiv", 1, 4, 2}, {"irem", 1, 2, 1}, {"lrem", 1, 4, 2}, {"frem", 1, 2, 1}, {"drem", 1, 4, 2}, {"ineg", 1, 1, 1}, {"lneg", 1, 2, 2}, {"fneg", 1, 1, 1}, {"dneg", 1, 2, 2}, {"ishl", 1, 2, 1}, {"lshl", 1, 3, 2}, {"ishr", 1, 2, 1}, {"lshr", 1, 3, 2}, {"iushr", 1, 2, 1}, {"lushr", 1, 3, 2}, {"iand", 1, 2, 1}, {"land", 1, 4, 2}, {"ior", 1, 2, 1}, {"lor", 1, 4, 2}, {"ixor", 1, 2, 1}, {"lxor", 1, 4, 2}, {"iinc", 3, 0, 0}, {"i2l", 1, 1, 2}, {"i2f", 1, 1, 1}, {"i2d", 1, 1, 2}, {"l2i", 1, 2, 1}, {"l2f", 1, 2, 1}, {"l2d", 1, 2, 2}, {"f2i", 1, 1, 1}, {"f2l", 1, 1, 2}, {"f2d", 1, 1, 2}, {"d2i", 1, 2, 1}, {"d2l", 1, 2, 2}, {"d2f", 1, 2, 1}, {"i2b", 1, 1, 1}, {"i2c", 1, 1, 1}, {"i2s", 1, 1, 1}, {"lcmp", 1, 4, 1}, {"fcmpl", 1, 2, 1}, {"fcmpg", 1, 2, 1}, {"dcmpl", 1, 4, 1}, {"dcmpg", 1, 4, 1}, {"ifeq", 3, 1, 0}, {"ifne", 3, 1, 0}, {"iflt", 3, 1, 0}, {"ifge", 3, 1, 0}, {"ifgt", 3, 1, 0}, {"ifle", 3, 1, 0}, {"if_icmpeq", 3, 2, 0}, {"if_icmpne", 3, 2, 0}, {"if_icmplt", 3, 2, 0}, {"if_icmpge", 3, 2, 0}, {"if_icmpgt", 3, 2, 0}, {"if_icmple", 3, 2, 0}, {"if_acmpeq", 3, 2, 0}, {"if_acmpne", 3, 2, 0}, {"goto", 3, 0, 0}, {"jsr", 3, 0, 1}, {"ret", 2, 0, 0}, {"tableswitch", 13, 1, 0}, {"lookupswitch", 9, 1, 0}, {"ireturn", 1, 1, 0}, {"lreturn", 1, 2, 0}, {"freturn", 1, 1, 0}, {"dreturn", 1, 2, 0}, {"areturn", 1, 1, 0}, {"return", 1, 0, 0}, {"getstatic", 3, 0, 1}, {"putstatic", 3, 1, 0}, {"getfield", 3, 1, 9}, {"putfield", 3, 9, 0}, {"invokevirtual", 3, 9, 0}, {"invokespecial", 3, 9, 0}, {"invokestatic", 3, 9, 0}, {"invokeinterface",5, 9, 0}, {"UNUSED", 1, 0, 0}, {"new", 3, 0, 1}, {"newarray", 2, 1, 1}, {"anewarray", 3, 1, 1}, {"arraylength", 1, 1, 1}, {"athrow", 1, 1, 0}, {"checkcast", 3, 1, 1}, {"instanceof", 3, 1, 1}, {"monitorenter", 1, 1, 0}, {"monitorexit", 1, 1, 0}, {"wide", 1, 0, 0}, {"multianewarray", 4, 9, 1}, {"ifnull", 3, 1, 0}, {"ifnonnull", 3, 1, 0}, {"goto_w", 5, 0, 0}, {"jsr_w", 5, 0, 1}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0}, {"UNUSED", 1, 0, 0} }; f2j-0.8.1/libbytecode/Makefile.in0000600000077700002310000000133011031241063016571 0ustar seymourgraduateinclude make.def default: libbytecode.a install: libbytecode.a install -d -m 755 $(F2J_LIBDIR) install -m 644 libbytecode.a $(F2J_LIBDIR) libbytecode.a: globals.o constant_pool.o api.o class.o dlist.o $(AR) -r libbytecode.a dlist.o constant_pool.o \ api.o class.o globals.o api.o: api.h bytecode.h globals.c api.c class.o: bytecode.h class.h class.c constant_pool.o: dlist.o bytecode.h constant_pool.c globals.o: globals.c dlist.o: dlist.h dlist.c test: cd testing; $(MAKE) test docs: $(DOXYGEN) configclean: clean /bin/rm -rf autom4te.cache configure Makefile config.cache config.log \ config.status make.def testing/Makefile bytecode.h clean: /bin/rm -rf *.o *.a latex html cd testing; $(MAKE) clean f2j-0.8.1/libbytecode/bytecode.h.in0000600000077700002310000007120211031241063017105 0ustar seymourgraduate/** @file */ /***************************************************************************** * bytecode.h * * * * Main include file for the bytecode library. Users of the library can * * just include this single header file in their code. * * * *****************************************************************************/ #ifndef _BYTECODE_H #define _BYTECODE_H #include #include #include #include"dlist.h" /* Define if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel and VAX). */ #undef WORDS_BIGENDIAN #define JVM_MAX_RETURNS 7 #define TRUE 1 #define FALSE 0 /***************************************************************************** * CPIDX_MAX is the largest index that can be used with the ldc instruction * * since it has a 1 byte operand. For values larger than CPIDX_MAX, we must * * generate ldc_w. * *****************************************************************************/ #define CP_IDX_MAX 255 /* MAX_CODE_LEN: Currently a method can only have 64k of code. */ #define JVM_MAX_CODE_LEN 65535 /* * If there are more than JVM_SWITCH_FILL_THRESH empty cases in a switch, then * use lookupswitch instead of tableswitch. */ #define JVM_SWITCH_FILL_THRESH 10 /* * Definitions of class/field/method modifiers: */ #define JVM_ACC_PUBLIC 0x0001 #define JVM_ACC_PRIVATE 0x0002 #define JVM_ACC_PROTECTED 0x0004 #define JVM_ACC_STATIC 0x0008 #define JVM_ACC_FINAL 0x0010 #define JVM_ACC_SYNCHRONIZED 0x0020 #define JVM_ACC_SUPER 0x0020 #define JVM_ACC_VOLATILE 0x0040 #define JVM_ACC_TRANSIENT 0x0080 #define JVM_ACC_NATIVE 0x0100 #define JVM_ACC_INTERFACE 0x0200 #define JVM_ACC_ABSTRACT 0x0400 #define JVM_ACC_STRICT 0x0800 /* * array data types for newarray opcode. */ #define JVM_T_UNUSED 0 #define JVM_T_BOOLEAN 4 #define JVM_T_CHAR 5 #define JVM_T_FLOAT 6 #define JVM_T_DOUBLE 7 #define JVM_T_BYTE 8 #define JVM_T_SHORT 9 #define JVM_T_INT 10 #define JVM_T_LONG 11 #define JVM_MAGIC 0xCAFEBABEu #define JVM_MINOR_VER 3 #define JVM_MAJOR_VER 45 /***************************************************************************** * * * Following are some constants that help determine which integer load * * instruction to use. * * * * if intval < JVM_SHORT_MIN or intval > JVM_SHORT_MAX, use ldc * * else if intval < JVM_BYTE_MIN or intval > JVM_BYTE_MAX, use sipush * * else if intval < JVM_ICONST_MIN or intval > JVM_ICONST_MAX, use bipush * * else use iconst_ * * * *****************************************************************************/ #define JVM_SHORT_MIN (-32768) #define JVM_SHORT_MAX 32767 #define JVM_BYTE_MIN (-128) #define JVM_BYTE_MAX 127 #define JVM_ICONST_MIN -1 #define JVM_ICONST_MAX 5 #define CP_INTEGER_CONST 277 #define CP_FLOAT_CONST 279 #define CP_DOUBLE_CONST 276 #define CP_LONG_CONST 282 #define CP_EXPONENTIAL_CONST 278 #define CP_TRUE_CONST 280 #define CP_FALSE_CONST 281 #define CP_STRING_CONST 304 #define CP_CHECK_NONZERO(str,val)\ if((val) == 0)\ fprintf(stderr,"Not expecting zero value (%s)\n", (str)) #define BAD_ARG() fprintf(stderr,"%s:%d -- bad arg.\n", __FILE__, __LINE__); #ifdef BC_DEBUG #define debug_msg(...) fprintf(stderr, __VA_ARGS__) #else #define debug_msg(...) /* nop */ #endif #ifdef BC_VIEW #define debug_err(...) fprintf(stderr, __VA_ARGS__) #else #define debug_err(...) /* nop */ #endif typedef int BOOL; typedef unsigned char u1; typedef unsigned short u2; typedef unsigned int u4; typedef unsigned long long u8; /* the following structure represents a single JVM instruction: */ typedef struct _jvm_op_info { char *op; /* character representation of opcode */ u1 width; /* width in bytes of the opcode + operands */ u1 stack_pre; /* stack before the operation */ u1 stack_post; /* stack after the operation */ } JVM_OP_INFO; /***************************************************************************** * Enumeration of all the JVM instruction opcodes. * *****************************************************************************/ typedef enum _opcode { jvm_nop = 0x0, jvm_aconst_null, jvm_iconst_m1, jvm_iconst_0, jvm_iconst_1, jvm_iconst_2, jvm_iconst_3, jvm_iconst_4, jvm_iconst_5, jvm_lconst_0, jvm_lconst_1, jvm_fconst_0, jvm_fconst_1, jvm_fconst_2, jvm_dconst_0, jvm_dconst_1, jvm_bipush, jvm_sipush, jvm_ldc, jvm_ldc_w, jvm_ldc2_w, jvm_iload, jvm_lload, jvm_fload, jvm_dload, jvm_aload, jvm_iload_0, jvm_iload_1, jvm_iload_2, jvm_iload_3, jvm_lload_0, jvm_lload_1, jvm_lload_2, jvm_lload_3, jvm_fload_0, jvm_fload_1, jvm_fload_2, jvm_fload_3, jvm_dload_0, jvm_dload_1, jvm_dload_2, jvm_dload_3, jvm_aload_0, jvm_aload_1, jvm_aload_2, jvm_aload_3, jvm_iaload, jvm_laload, jvm_faload, jvm_daload, jvm_aaload, jvm_baload, jvm_caload, jvm_saload, jvm_istore, jvm_lstore, jvm_fstore, jvm_dstore, jvm_astore, jvm_istore_0, jvm_istore_1, jvm_istore_2, jvm_istore_3, jvm_lstore_0, jvm_lstore_1, jvm_lstore_2, jvm_lstore_3, jvm_fstore_0, jvm_fstore_1, jvm_fstore_2, jvm_fstore_3, jvm_dstore_0, jvm_dstore_1, jvm_dstore_2, jvm_dstore_3, jvm_astore_0, jvm_astore_1, jvm_astore_2, jvm_astore_3, jvm_iastore, jvm_lastore, jvm_fastore, jvm_dastore, jvm_aastore, jvm_bastore, jvm_castore, jvm_sastore, jvm_pop, jvm_pop2, jvm_dup, jvm_dup_x1, jvm_dup_x2, jvm_dup2, jvm_dup2_x1, jvm_dup2_x2, jvm_swap, jvm_iadd, jvm_ladd, jvm_fadd, jvm_dadd, jvm_isub, jvm_lsub, jvm_fsub, jvm_dsub, jvm_imul, jvm_lmul, jvm_fmul, jvm_dmul, jvm_idiv, jvm_ldiv, jvm_fdiv, jvm_ddiv, jvm_irem, jvm_lrem, jvm_frem, jvm_drem, jvm_ineg, jvm_lneg, jvm_fneg, jvm_dneg, jvm_ishl, jvm_lshl, jvm_ishr, jvm_lshr, jvm_iushr, jvm_lushr, jvm_iand, jvm_land, jvm_ior, jvm_lor, jvm_ixor, jvm_lxor, jvm_iinc, jvm_i2l, jvm_i2f, jvm_i2d, jvm_l2i, jvm_l2f, jvm_l2d, jvm_f2i, jvm_f2l, jvm_f2d, jvm_d2i, jvm_d2l, jvm_d2f, jvm_i2b, jvm_i2c, jvm_i2s, jvm_lcmp, jvm_fcmpl, jvm_fcmpg, jvm_dcmpl, jvm_dcmpg, jvm_ifeq, jvm_ifne, jvm_iflt, jvm_ifge, jvm_ifgt, jvm_ifle, jvm_if_icmpeq, jvm_if_icmpne, jvm_if_icmplt, jvm_if_icmpge, jvm_if_icmpgt, jvm_if_icmple, jvm_if_acmpeq, jvm_if_acmpne, jvm_goto, jvm_jsr, jvm_ret, jvm_tableswitch, jvm_lookupswitch, jvm_ireturn, jvm_lreturn, jvm_freturn, jvm_dreturn, jvm_areturn, jvm_return, jvm_getstatic, jvm_putstatic, jvm_getfield, jvm_putfield, jvm_invokevirtual, jvm_invokespecial, jvm_invokestatic, jvm_invokeinterface, jvm_xxxunusedxxx, /* opcode 186 not used */ jvm_new, jvm_newarray, jvm_anewarray, jvm_arraylength, jvm_athrow, jvm_checkcast, jvm_instanceof, jvm_monitorenter, jvm_monitorexit, jvm_wide, jvm_multianewarray, jvm_ifnull, jvm_ifnonnull, jvm_goto_w, jvm_jsr_w, jvm_breakpoint, /* skip 203 - 253 */ jvm_impdep1 = 254, jvm_impdep2 } JVM_OPCODE; /***************************************************************************** * this structure holds information about the state of the stack before and * * after a method call. to correctly calculate the maximum stack depth, we * * need to know how many arguments an invoke[static,virtual,etc] instruction * * will pop off the stack. even though there is only one return value, it * * can occupy zero, one, or two stack entries depending on the return type * * of the method. * *****************************************************************************/ typedef struct _bc_stack_info { int arg_len, /* depth of stack when this method is invoked */ ret_len; /* depth of stack when this method returns */ } JVM_STACK_INFO; /**************************************************************************** * this structure is stored in the dlist label_list in a method info * * struct and is used by calc_offsets. * ****************************************************************************/ typedef struct _bc_branch_pc { struct _code_node *instr; /* instruction with this label */ char *label; /* the label number */ } JVM_BRANCH_PC; typedef struct _bc_switch_entry { struct _code_node *instr; int case_num; } JVM_SWITCH_ENTRY; typedef struct _bc_switch_info { int cell_padding; int low; int high; Dlist offsets; struct _code_node *default_case; int num_entries; struct _bc_switch_entry **sorted_entries; } JVM_SWITCH_INFO; typedef struct _code_node { JVM_OPCODE op; /* the opcode for this instruction */ u4 pc; /* the address in bytecode of this instruction */ u4 operand; /* this opcode's operand (may be u1, u2, u4) */ u1 width; /* width of this op (may vary with wide modifier)*/ struct _bc_switch_info * switch_info; /* parameters for tableswitch if appropriate */ struct _code_node * branch_target, /* the node to which we might optionally branch * * (comparison ops) or unconditionally branch */ * next; /* next op in code, but not necessarily next to * * execute since we may branch over it. */ char *branch_label; /* f77 label to which this instruction branches */ int stack_depth; /* stack depth prior to execution of this opcode */ BOOL visited; /* for traversal - has this node been visited? */ } JVM_CODE_GRAPH_NODE; typedef struct _bc_exception_table_entry { struct _code_node * from, /* PC at which the try block begins */ * to, /* PC at which the try block ends */ * target; /* PC at which the exception handler begins */ int catch_type; /* exception class corresponding to this catch */ } JVM_EXCEPTION_TABLE_ENTRY; typedef struct _bc_line_number_table_entry { struct _code_node *op; /* idx to code where original src stmt begins */ u2 line_number; /* the corresponding original line number */ } JVM_LINE_NUMBER_TABLE_ENTRY; typedef struct _bc_local_variable_table_entry { struct _code_node *start, /* start idx of valid range for this variable */ *end; /* end index of valid range for this variable */ char *name; /* name of this variable */ u2 name_index; /* cp index to name of variable */ char *descriptor; /* descriptor for this variable */ u2 descriptor_index; /* cp index to descriptor for variable */ u2 index; /* this variable's index into local var table */ } JVM_LOCAL_VARIABLE_TABLE_ENTRY; /* * Enumeration of the JVM data types. */ typedef enum jvm_data_type { jvm_Byte = 0x0, jvm_Short, jvm_Int, jvm_Long, jvm_Char, jvm_Float, jvm_Double, jvm_Object } JVM_DATA_TYPE; /* * Structures representing the JVM class file. */ typedef enum _constant_tags { CONSTANT_Utf8 = 1, /* 1 */ /* note missing tag 2 */ CONSTANT_Integer = 3, /* 3 */ CONSTANT_Float, /* 4 */ CONSTANT_Long, /* 5 */ CONSTANT_Double, /* 6 */ CONSTANT_Class, /* 7 */ CONSTANT_String, /* 8 */ CONSTANT_Fieldref, /* 9 */ CONSTANT_Methodref, /* 10 */ CONSTANT_InterfaceMethodref, /* 11 */ CONSTANT_NameAndType /* 12 */ } JVM_CONSTANT; typedef struct _bc_class_file { u4 magic; /* class file magic number: 0xCAFEBABE */ u2 minor_version; /* minor version of the class file */ u2 major_version; /* major version of the class file */ u2 constant_pool_count; /* num entries in constant pool + 1 */ Dlist constant_pool; /* constant pool:constant_pool_count-1 entries */ u2 access_flags; /* access permissions for this class */ u2 this_class; /* cp index to entry representing this class */ u2 super_class; /* cp index to superclass or 0 for Object */ u2 interfaces_count; /* number of superinterfaces for this class */ Dlist interfaces; /* list of interfaces (each entry a cp index) */ u2 fields_count; /* num fields, both class vars & instance vars */ Dlist fields; /* list of fields declared in this class */ u2 methods_count; /* number of methods in this class */ Dlist methods; /* list of methods */ u2 attributes_count; /* number of attributes for this class */ Dlist attributes; /* only SourceFile & Deprecated allowed here */ } JVM_CLASS; struct CONSTANT_Class_info { u2 name_index; /* index into constant pool */ }; struct CONSTANT_Methodref_info { u2 class_index; /* cp index of class which declares this field */ u2 name_and_type_index; /* cp index of name & descriptor of this field */ }; struct CONSTANT_String_info { u2 string_index; /* cp index of Utf8 rep of this string */ }; struct CONSTANT_Integer_info { u4 bytes; /* the integer value */ }; struct CONSTANT_Float_info { u4 bytes; /* the float value */ }; struct CONSTANT_Long_info { u4 high_bytes; /* the high bytes of the long value */ u4 low_bytes; /* the low bytes of the long value */ }; struct CONSTANT_Double_info { u4 high_bytes; /* the high bytes of the double value */ u4 low_bytes; /* the low bytes of the double value */ }; struct CONSTANT_NameAndType_info { u2 name_index; /* cp index of name or stored as Utf8 */ u2 descriptor_index; /* cp index of valid field, method descriptor */ }; struct CONSTANT_Utf8_info { u2 length; /* # bytes, not necessarily string length */ u1 *bytes; /* byte array containing the Utf8 string */ }; typedef struct _cp_info { u1 tag; union { struct CONSTANT_Class_info Class; struct CONSTANT_Methodref_info Methodref; struct CONSTANT_String_info String; struct CONSTANT_Integer_info Integer; struct CONSTANT_Float_info Float; struct CONSTANT_Long_info Long; struct CONSTANT_Double_info Double; struct CONSTANT_NameAndType_info NameAndType; struct CONSTANT_Utf8_info Utf8; } cpnode; } CP_INFO; typedef struct _field_info { u2 access_flags; /* access flags mask, see table 4.4 in vm spec */ u2 name_index; /* cp index of field name, rep. as Utf8 string */ u2 descriptor_index; /* cp index of valid field descriptor */ u2 attributes_count; /* number of additional field attributes */ Dlist attributes; /* attributes of this field */ struct _bc_class_file *class; /* the class containing this field */ } JVM_FIELD; typedef struct _method_info { u2 access_flags; /* access flags mask, see table 4.5 in vm spec */ u2 name_index; /* cp index of methodname, , or */ u2 descriptor_index; /* cp index of valid method descriptor */ u2 attributes_count; /* number of additional method attributes */ Dlist attributes; /* attributes of this method */ BOOL gen_bytecode; /* set to FALSE to suspend bytecode generation */ /* The following fields are not really part of the method struct as * defined by the JVM spec, but they're here for convenience. */ Dlist exc_table; /* list of exception table entries */ Dlist label_list; /* list of statements with label numbers */ BOOL reCalcAddr; /* Do node's addrs need to be recalculated? */ struct _attribute_info *cur_code; /* code attribute */ Dlist line_table, /* list of line number table entries */ locals_table; /* list of local variable table entries */ JVM_OPCODE lastOp; /* the last opcode emitted */ int stacksize; /* size of stack for current unit */ unsigned int cur_local_number, /* current local variable number */ max_locals, /* number of locals needed for this method */ num_handlers, /* number of exception handlers in this method */ pc; /* current program counter */ char *name; /* name of this method */ char *file; /* name of the file containing this method */ struct _bc_class_file *class; /* the class containing this method */ } JVM_METHOD; struct ConstantValue_attribute { u2 constantvalue_index; /* cp index to the actual constant value */ }; struct ExceptionTable { u2 start_pc; /* index into code of start opcode (inclusive) */ u2 end_pc; /* index into code of end opcode (exclusive) */ u2 handler_pc; /* start of exception handler code */ u2 catch_type; /* cp index of exception class to catch */ }; struct Code_attribute { u2 max_stack; /* max depth of operand stack for this method */ u2 max_locals; /* max num of local variables including params */ u4 code_length; /* number of bytes in the code array */ Dlist code; /* list containing code for this method */ u2 exception_table_length; /* number of entries in the exception table */ struct ExceptionTable * exception_table; /* table of exception handlers */ u2 attributes_count; /* number of additional code attributes */ Dlist attributes; /* attributes of this code */ }; struct Exceptions_attribute { u2 number_of_exceptions; /* number of entries in exception_index_table */ Dlist exception_index_table;/* table of exceptions a method can throw */ }; struct SourceFile_attribute { u2 sourcefile_index; /* cp index to name of source file (in Utf8) */ }; struct LineNumberTable_attribute { u2 line_number_table_length; /* number of entries in line_number_table */ Dlist line_number_table; /* list of line number table entries */ }; struct LocalVariableTable_attribute { u2 local_variable_table_length; /* number of entries in line_number_table */ Dlist local_variable_table; /* list of line number table entries */ }; struct InnerClassEntry { u2 inner_class_info_index; /* cp index to the inner class */ u2 outer_class_info_index; /* cp index to the outer (enclosing) class */ u2 inner_name_index; /* cp index to simple name of inner class */ u2 inner_class_access_flags; /* access flags for the inner class */ }; struct InnerClasses_attribute { u2 number_of_classes; /* number of entries in the classes array */ Dlist classes; /* list of inner class references */ }; struct UserDefined_attribute { void *data; }; typedef struct _attribute_info { u2 attribute_name_index; /* cp index to name of attribute (in Utf8) */ u4 attribute_length; /* # bytes pointed to by the info field */ union { struct ConstantValue_attribute * ConstantValue; struct Code_attribute * Code; struct Exceptions_attribute * Exceptions; void * Synthetic; struct SourceFile_attribute * SourceFile; struct LineNumberTable_attribute * LineNumberTable; struct LocalVariableTable_attribute * LocalVariableTable; struct InnerClasses_attribute * InnerClasses; struct UserDefined_attribute * UserDefined; } attr; } JVM_ATTRIBUTE; /* * We build a linked list containing all the constant pool entries. * Each entry in the list has the following structure: */ typedef struct _constListNode { unsigned int index; unsigned int next_idx; CP_INFO * val; } CP_NODE; /***************************************************************************** * this structure holds information about a method reference, including the * * name of the class which contains the method, the name of the method, and * * the method descriptor. * *****************************************************************************/ typedef struct _methodref { char *classname, *methodname, *descriptor; } JVM_METHODREF; /***************************************************************************** * Definitions of opcodes related to code generation. * *****************************************************************************/ extern const int jvm_newarray_type[JVM_MAX_RETURNS+1]; extern const JVM_OPCODE jvm_iconst_op[7], jvm_array_load_op[JVM_MAX_RETURNS+1], jvm_load_op[JVM_MAX_RETURNS+1], jvm_store_op[JVM_MAX_RETURNS+1], jvm_array_store_op[JVM_MAX_RETURNS+1], jvm_short_store_op[JVM_MAX_RETURNS+1][4], jvm_short_load_op[JVM_MAX_RETURNS+1][4]; extern const JVM_OP_INFO jvm_opcode[]; extern const int cp_entry_width[], jvm_localvar_width[]; /***************************************************************************** ** Function prototypes ** *****************************************************************************/ int bc_write_class(JVM_CLASS *, char *), bc_get_code_length(JVM_METHOD *), bc_add_user_defined_class_attr(JVM_CLASS *, char *, int, void *), bc_set_class_deprecated(JVM_CLASS *), bc_set_class_version(JVM_CLASS *, int, int), bc_add_class_interface(JVM_CLASS *, char *), bc_set_constant_value_attr(JVM_FIELD *, JVM_CONSTANT, const void *), bc_set_field_deprecated(JVM_FIELD *), bc_set_field_synthetic(JVM_FIELD *), bc_set_method_deprecated(JVM_METHOD *), bc_set_method_synthetic(JVM_METHOD *), bc_add_method_exception(JVM_METHOD *, char *), bc_add_inner_classes_attr(JVM_CLASS *, char *, char *, char *, int), bc_set_local_var_start(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *), bc_set_local_var_end(JVM_LOCAL_VARIABLE_TABLE_ENTRY *, JVM_CODE_GRAPH_NODE *), bc_set_stack_depth(JVM_CODE_GRAPH_NODE *, int), bc_set_line_number(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int), bc_add_exception_handler(JVM_METHOD *, JVM_EXCEPTION_TABLE_ENTRY *), bc_remove_method(JVM_METHOD *), bc_set_method_descriptor(JVM_METHOD *, char *), bc_release_local(JVM_METHOD *, JVM_DATA_TYPE), bc_set_cur_local_num(JVM_METHOD *, unsigned int), bc_set_gen_status(JVM_METHOD *, BOOL), bc_add_switch_case(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, int), bc_add_switch_default(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *), bc_associate_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, const char *), bc_associate_integer_branch_label(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, int), bc_set_branch_target(JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *), bc_set_branch_label(JVM_CODE_GRAPH_NODE *, const char *), bc_set_integer_branch_label(JVM_CODE_GRAPH_NODE *, int), bc_get_next_local(JVM_METHOD *, JVM_DATA_TYPE), bc_add_source_file_attr(JVM_CLASS *, char *), bc_new_methodref(JVM_CLASS *, char *, char *, char *), bc_new_name_and_type(JVM_CLASS *, char *, char *), bc_new_fieldref(JVM_CLASS *, char *, char *, char *), bc_new_interface_methodref(JVM_CLASS *, char *, char *, char *); void bc_free_method(JVM_METHOD *), bc_free_class(JVM_CLASS *), bc_free_constant_pool(JVM_CLASS *), bc_free_interfaces(JVM_CLASS *), bc_free_fields(JVM_CLASS *), bc_free_methods(JVM_CLASS *), bc_free_attributes(JVM_CLASS *, Dlist), bc_free_fieldref(JVM_METHODREF *), bc_free_nameandtype(JVM_METHODREF *), bc_free_methodref(JVM_METHODREF *), bc_free_interfaceref(JVM_METHODREF *), bc_free_code_attribute(JVM_CLASS *, JVM_ATTRIBUTE *), bc_free_line_number_table(JVM_METHOD *), bc_free_locals_table(JVM_METHOD *), bc_free_label_list(JVM_METHOD *), bc_free_code(Dlist); JVM_LOCAL_VARIABLE_TABLE_ENTRY *bc_set_local_var_name(JVM_METHOD *, int, char *, char *); char *bc_next_desc_token(char *), *bc_get_full_classname(char *, char *); FILE *bc_fopen_fullpath(char *, char *, char *); JVM_CLASS *bc_new_class(char *, char *, char *, char *, u2); JVM_METHOD *bc_new_method(JVM_CLASS *, char *, char *, unsigned int), *bc_add_default_constructor(JVM_CLASS *, u2); JVM_ATTRIBUTE *bc_new_inner_classes_attr(JVM_CLASS *), *bc_new_line_number_table_attr(JVM_METHOD *), *bc_new_local_variable_table_attr(JVM_METHOD *), *bc_new_synthetic_attr(JVM_CLASS *), *bc_new_deprecated_attr(JVM_CLASS *), *bc_new_exceptions_attr(JVM_CLASS *); JVM_FIELD *bc_add_field(JVM_CLASS *, char *, char *, u2); JVM_CODE_GRAPH_NODE *bc_get_next_instr(JVM_CODE_GRAPH_NODE *), *bc_new_graph_node(JVM_METHOD *, JVM_OPCODE, u4), *bc_push_int_const(JVM_METHOD *, int), *bc_push_null_const(JVM_METHOD *), *bc_push_double_const(JVM_METHOD *, double), *bc_push_float_const(JVM_METHOD *, float), *bc_push_long_const(JVM_METHOD *, long long), *bc_push_string_const(JVM_METHOD *, char *), *bc_gen_iinc(JVM_METHOD *, unsigned int, int), *bc_gen_switch(JVM_METHOD *), *bc_new_multi_array(JVM_METHOD *, u4, char *), *bc_get_field(JVM_METHOD *, char *, char *, char *), *bc_put_field(JVM_METHOD *, char *, char *, char *), *bc_get_static(JVM_METHOD *, char *, char *, char *), *bc_put_static(JVM_METHOD *, char *, char *, char *), *bc_gen_instanceof(JVM_METHOD *, char *), *bc_gen_checkcast(JVM_METHOD *, char *), *bc_append(JVM_METHOD *, JVM_OPCODE, ...), *bc_node_at_pc(JVM_METHOD *, int), *bc_gen_new_object_array(JVM_METHOD *, int, char *), *bc_gen_new_array(JVM_METHOD *, int, JVM_DATA_TYPE), *bc_gen_array_load_op(JVM_METHOD *, JVM_DATA_TYPE), *bc_gen_array_store_op(JVM_METHOD *, JVM_DATA_TYPE), *bc_gen_return(JVM_METHOD *), *bc_gen_new_obj(JVM_METHOD *, char *), *bc_gen_new_obj_dup(JVM_METHOD *, char *), *bc_gen_obj_instance_default(JVM_METHOD *, char *), *bc_gen_store_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE), *bc_gen_load_op(JVM_METHOD *, unsigned int, JVM_DATA_TYPE); JVM_EXCEPTION_TABLE_ENTRY *bc_new_exception_table_entry(JVM_METHOD *, JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, JVM_CODE_GRAPH_NODE *, char *); JVM_METHODREF *bc_new_method_node(char *, char *, char *); JVM_OPCODE bc_get_last_opcode(JVM_METHOD *); u1 bc_op_width(JVM_OPCODE); CP_NODE *cp_entry_by_index(JVM_CLASS *, unsigned int); int cp_lookup(JVM_CLASS *, JVM_CONSTANT, const void *), cp_find_or_insert(JVM_CLASS *, JVM_CONSTANT, const void *), cp_manual_insert(JVM_CLASS *, JVM_CONSTANT, const void *); void cp_fields_dump(JVM_CLASS *), cp_dump(JVM_CLASS *), cp_quickdump(JVM_CLASS *); u4 cp_big_endian_u4(u4); u2 cp_big_endian_u2(u2); char *cp_null_term_utf8(CP_INFO *); #endif f2j-0.8.1/libbytecode/configure.in0000600000077700002310000000177511031241063017052 0ustar seymourgraduateAC_INIT(libbytecode, 0.8.1, [f2j@cs.utk.edu]) AC_REVISION([$Revision: 1.6 $]) AC_CONFIG_SRCDIR(api.c) AC_PROG_CC(gcc cc ecc xlc) AC_C_BIGENDIAN AC_PROG_MAKE_SET AC_PROG_RANLIB AC_PATH_PROG(AR, ar) AC_SUBST(AR) AC_PATH_PROG(JAVAC, javac) AC_SUBST(JAVAC) AC_PATH_PROG(JAVA, java) AC_SUBST(JAVA) if test "x$prefix" != xNONE; then F2J_INSTALL_PREFIX=${prefix} else F2J_INSTALL_PREFIX=`pwd` fi AC_SUBST(F2J_INSTALL_PREFIX) AC_ARG_WITH(doxygen, [ --with-doxygen=DOXYGEN doxygen binary name], [DOXYGEN="$with_doxygen"], [DOXYGEN="doxygen"]) AC_ARG_WITH(debuglevel, [ --with-debuglevel=num 0=none, 1=only errors [default], 2=all debugging output], [DEBUGLEVEL="$with_debuglevel"], [DEBUGLEVEL="1"]) if test "$DEBUGLEVEL" = "1"; then CFLAGS="$CFLAGS -DBC_VIEW" fi if test "$DEBUGLEVEL" = "2"; then CFLAGS="$CFLAGS -DBC_VIEW -DBC_DEBUG" fi AC_SUBST(CFLAGS) AC_SUBST(DOXYGEN) AC_CONFIG_HEADER(bytecode.h) AC_OUTPUT(Makefile make.def) f2j-0.8.1/libbytecode/make.def.in0000600000077700002310000000017211031241063016531 0ustar seymourgraduateCC=@CC@ CFLAGS=-g -Wall @CFLAGS@ AR=@AR@ DOXYGEN=@DOXYGEN@ JAVA=@JAVA@ JAVAC=@JAVAC@ F2J_LIBDIR=@F2J_INSTALL_PREFIX@/lib f2j-0.8.1/libbytecode/configure0000700000077700002310000032253411031241063016445 0ustar seymourgraduate#! /bin/sh # From configure.in Revision: 1.4 . # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.59 for libbytecode 0.8. # # Report bugs to . # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='libbytecode' PACKAGE_TARNAME='libbytecode' PACKAGE_VERSION='0.8' PACKAGE_STRING='libbytecode 0.8' PACKAGE_BUGREPORT='f2j@cs.utk.edu' ac_unique_file="api.c" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT SET_MAKE RANLIB ac_ct_RANLIB AR JAVAC JAVA F2J_INSTALL_PREFIX DOXYGEN LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures libbytecode 0.8 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of libbytecode 0.8:";; esac cat <<\_ACEOF Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-doxygen=DOXYGEN doxygen binary name --with-debuglevel=num 0=none, 1=only errors default, 2=all debugging output Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF libbytecode configure 0.8 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by libbytecode $as_me 0.8, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in gcc cc ecc xlc do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in gcc cc ecc xlc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 if test "${ac_cv_c_bigendian+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # See if sys/param.h defines the BYTE_ORDER macro. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN bogus endian macros #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # It does; now see whether it defined to BIG_ENDIAN or not. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if BYTE_ORDER != BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_bigendian=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # It does not; compile a test program. if test "$cross_compiling" = yes; then # try to guess the endianness by grepping values into an object file ac_cv_c_bigendian=unknown cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } int main () { _ascii (); _ebcdic (); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes fi if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else # finding both strings is unlikely to happen, but who knows? ac_cv_c_bigendian=unknown fi fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* Are we little or big endian? From Harbison&Steele. */ union { long l; char c[sizeof (long)]; } u; u.l = 1; exit (u.c[sizeof (long) - 1] == 1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_bigendian=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 echo "${ECHO_T}$ac_cv_c_bigendian" >&6 case $ac_cv_c_bigendian in yes) cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN 1 _ACEOF ;; no) ;; *) { { echo "$as_me:$LINENO: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&5 echo "$as_me: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} { (exit 1); exit 1; }; } ;; esac echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF all: @echo 'ac_maketemp="$(MAKE)"' _ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi rm -f conftest.make fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 SET_MAKE= else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $AR in [\\/]* | ?:[\\/]*) ac_cv_path_AR="$AR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_AR="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi AR=$ac_cv_path_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Extract the first word of "javac", so it can be a program name with args. set dummy javac; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_JAVAC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $JAVAC in [\\/]* | ?:[\\/]*) ac_cv_path_JAVAC="$JAVAC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_JAVAC="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi JAVAC=$ac_cv_path_JAVAC if test -n "$JAVAC"; then echo "$as_me:$LINENO: result: $JAVAC" >&5 echo "${ECHO_T}$JAVAC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Extract the first word of "java", so it can be a program name with args. set dummy java; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_JAVA+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $JAVA in [\\/]* | ?:[\\/]*) ac_cv_path_JAVA="$JAVA" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_JAVA="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi JAVA=$ac_cv_path_JAVA if test -n "$JAVA"; then echo "$as_me:$LINENO: result: $JAVA" >&5 echo "${ECHO_T}$JAVA" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi if test "x$prefix" != xNONE; then F2J_INSTALL_PREFIX=${prefix} else F2J_INSTALL_PREFIX=`pwd` fi # Check whether --with-doxygen or --without-doxygen was given. if test "${with_doxygen+set}" = set; then withval="$with_doxygen" DOXYGEN="$with_doxygen" else DOXYGEN="doxygen" fi; # Check whether --with-debuglevel or --without-debuglevel was given. if test "${with_debuglevel+set}" = set; then withval="$with_debuglevel" DEBUGLEVEL="$with_debuglevel" else DEBUGLEVEL="1" fi; if test "$DEBUGLEVEL" = "1"; then CFLAGS="$CFLAGS -DBC_VIEW" fi if test "$DEBUGLEVEL" = "2"; then CFLAGS="$CFLAGS -DBC_VIEW -DBC_DEBUG" fi ac_config_headers="$ac_config_headers bytecode.h" ac_config_files="$ac_config_files Makefile make.def" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi DEFS=-DHAVE_CONFIG_H ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by libbytecode $as_me 0.8, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE --header=FILE[:TEMPLATE] instantiate the configuration header FILE Configuration files: $config_files Configuration headers: $config_headers Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ libbytecode config.status 0.8 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "make.def" ) CONFIG_FILES="$CONFIG_FILES make.def" ;; "bytecode.h" ) CONFIG_HEADERS="$CONFIG_HEADERS bytecode.h" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@SET_MAKE@,$SET_MAKE,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t s,@JAVAC@,$JAVAC,;t t s,@JAVA@,$JAVA,;t t s,@F2J_INSTALL_PREFIX@,$F2J_INSTALL_PREFIX,;t t s,@DOXYGEN@,$DOXYGEN,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # # CONFIG_HEADER section. # # These sed commands are passed to sed as "A NAME B NAME C VALUE D", where # NAME is the cpp macro being defined and VALUE is the value it is being given. # # ac_d sets the value in "#define NAME VALUE" lines. ac_dA='s,^\([ ]*\)#\([ ]*define[ ][ ]*\)' ac_dB='[ ].*$,\1#\2' ac_dC=' ' ac_dD=',;t' # ac_u turns "#undef NAME" without trailing blanks into "#define NAME VALUE". ac_uA='s,^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)' ac_uB='$,\1#\2define\3' ac_uC=' ' ac_uD=',;t' for ac_file in : $CONFIG_HEADERS; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac test x"$ac_file" != x- && { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } # Do quote $f, to prevent DOS paths from being IFS'd. echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } # Remove the trailing spaces. sed 's/[ ]*$//' $ac_file_inputs >$tmp/in _ACEOF # Transform confdefs.h into two sed scripts, `conftest.defines' and # `conftest.undefs', that substitutes the proper values into # config.h.in to produce config.h. The first handles `#define' # templates, and the second `#undef' templates. # And first: Protect against being on the right side of a sed subst in # config.status. Protect against being in an unquoted here document # in config.status. rm -f conftest.defines conftest.undefs # Using a here document instead of a string reduces the quoting nightmare. # Putting comments in sed scripts is not portable. # # `end' is used to avoid that the second main sed command (meant for # 0-ary CPP macros) applies to n-ary macro definitions. # See the Autoconf documentation for `clear'. cat >confdef2sed.sed <<\_ACEOF s/[\\&,]/\\&/g s,[\\$`],\\&,g t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*\)\(([^)]*)\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1\2${ac_dC}\3${ac_dD},gp t end s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)$,${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD},gp : end _ACEOF # If some macros were called several times there might be several times # the same #defines, which is useless. Nevertheless, we may not want to # sort them, since we want the *last* AC-DEFINE to be honored. uniq confdefs.h | sed -n -f confdef2sed.sed >conftest.defines sed 's/ac_d/ac_u/g' conftest.defines >conftest.undefs rm -f confdef2sed.sed # This sed command replaces #undef with comments. This is necessary, for # example, in the case of _POSIX_SOURCE, which is predefined and required # on some systems where configure will not decide to define it. cat >>conftest.undefs <<\_ACEOF s,^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*,/* & */, _ACEOF # Break up conftest.defines because some shells have a limit on the size # of here documents, and old seds have small limits too (100 cmds). echo ' # Handle all the #define templates only if necessary.' >>$CONFIG_STATUS echo ' if grep "^[ ]*#[ ]*define" $tmp/in >/dev/null; then' >>$CONFIG_STATUS echo ' # If there are no defines, we may have an empty if/fi' >>$CONFIG_STATUS echo ' :' >>$CONFIG_STATUS rm -f conftest.tail while grep . conftest.defines >/dev/null do # Write a limited-size here document to $tmp/defines.sed. echo ' cat >$tmp/defines.sed <>$CONFIG_STATUS # Speed up: don't consider the non `#define' lines. echo '/^[ ]*#[ ]*define/!b' >>$CONFIG_STATUS # Work around the forget-to-reset-the-flag bug. echo 't clr' >>$CONFIG_STATUS echo ': clr' >>$CONFIG_STATUS sed ${ac_max_here_lines}q conftest.defines >>$CONFIG_STATUS echo 'CEOF sed -f $tmp/defines.sed $tmp/in >$tmp/out rm -f $tmp/in mv $tmp/out $tmp/in ' >>$CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.defines >conftest.tail rm -f conftest.defines mv conftest.tail conftest.defines done rm -f conftest.defines echo ' fi # grep' >>$CONFIG_STATUS echo >>$CONFIG_STATUS # Break up conftest.undefs because some shells have a limit on the size # of here documents, and old seds have small limits too (100 cmds). echo ' # Handle all the #undef templates' >>$CONFIG_STATUS rm -f conftest.tail while grep . conftest.undefs >/dev/null do # Write a limited-size here document to $tmp/undefs.sed. echo ' cat >$tmp/undefs.sed <>$CONFIG_STATUS # Speed up: don't consider the non `#undef' echo '/^[ ]*#[ ]*undef/!b' >>$CONFIG_STATUS # Work around the forget-to-reset-the-flag bug. echo 't clr' >>$CONFIG_STATUS echo ': clr' >>$CONFIG_STATUS sed ${ac_max_here_lines}q conftest.undefs >>$CONFIG_STATUS echo 'CEOF sed -f $tmp/undefs.sed $tmp/in >$tmp/out rm -f $tmp/in mv $tmp/out $tmp/in ' >>$CONFIG_STATUS sed 1,${ac_max_here_lines}d conftest.undefs >conftest.tail rm -f conftest.undefs mv conftest.tail conftest.undefs done rm -f conftest.undefs cat >>$CONFIG_STATUS <<\_ACEOF # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then echo "/* Generated by configure. */" >$tmp/config.h else echo "/* $ac_file. Generated by configure. */" >$tmp/config.h fi cat $tmp/in >>$tmp/config.h rm -f $tmp/in if test x"$ac_file" != x-; then if diff $ac_file $tmp/config.h >/dev/null 2>&1; then { echo "$as_me:$LINENO: $ac_file is unchanged" >&5 echo "$as_me: $ac_file is unchanged" >&6;} else ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } rm -f $ac_file mv $tmp/config.h $ac_file fi else cat $tmp/config.h rm -f $tmp/config.h fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi f2j-0.8.1/util/0000700000077700002310000000000011031241064013216 5ustar seymourgraduatef2j-0.8.1/util/org/0000700000077700002310000000000011031241064014005 5ustar seymourgraduatef2j-0.8.1/util/org/netlib/0000700000077700002310000000000011031241064015262 5ustar seymourgraduatef2j-0.8.1/util/org/netlib/util/0000700000077700002310000000000011031241064016237 5ustar seymourgraduatef2j-0.8.1/util/org/netlib/util/CVS/0000700000077700002310000000000011031241064016672 5ustar seymourgraduatef2j-0.8.1/util/org/netlib/util/CVS/Root0000600000077700002310000000006711031241064017545 0ustar seymourgraduate:ext:keithseymour@f2j.cvs.sourceforge.net:/cvsroot/f2j f2j-0.8.1/util/org/netlib/util/CVS/Repository0000600000077700002310000000003111031241064020770 0ustar seymourgraduatef2j/util/org/netlib/util f2j-0.8.1/util/org/netlib/util/CVS/Entries0000600000077700002310000000110511031241064020225 0ustar seymourgraduate/Dummy.java/1.4/Thu Jan 25 21:31:37 2007// /Etime.java/1.4/Thu Jan 25 21:32:16 2007// /MatConv.java/1.4/Thu Jan 25 21:33:14 2007// /Second.java/1.4/Thu Jan 25 21:33:33 2007// /StrictUtil.java/1.3/Thu Jan 25 21:34:13 2007// /StringW.java/1.4/Thu Jan 25 21:34:35 2007// /booleanW.java/1.4/Thu Jan 25 21:35:36 2007// /doubleW.java/1.4/Thu Jan 25 21:36:23 2007// /floatW.java/1.4/Thu Jan 25 21:36:27 2007// /intW.java/1.4/Thu Jan 25 21:36:16 2007// /EasyIn.java/1.6/Tue May 1 18:48:08 2007// /Util.java/1.10/Thu Jul 19 18:37:36 2007// /ArraySpec.java/1.4/Fri Dec 14 20:49:10 2007// D f2j-0.8.1/util/org/netlib/util/EasyIn.java0000600000077700002310000003161711031241064020304 0ustar seymourgraduatepackage org.netlib.util; import java.io.*; /** * Simple input from the keyboard for all primitive types. ver 1.0 *

* Copyright (c) Peter van der Linden, May 5 1997. * corrected error message 11/21/97 *

* The creator of this software hereby gives you permission to: *

    *
  1. copy the work without changing it *
  2. modify the work providing you send me a copy which I can * use in any way I want, including incorporating into this work. *
  3. distribute copies of the work to the public by sale, lease, * rental, or lending *
  4. perform the work *
  5. display the work *
  6. fold the work into a funny hat and wear it on your head. *
*

* This is not thread safe, not high performance, and doesn't tell EOF. * It's intended for low-volume easy keyboard input. * An example of use is: *

* * EasyIn easy = new EasyIn();
* int i = easy.readInt(); // reads an int from System.in
* float f = easy.readFloat(); // reads a float from System.in
*
*

* 2/25/98 - modified by Keith Seymour to be useful with the f2j * translator. *

* @author Peter van der Linden */ public class EasyIn { static String line = null; static int idx, len; static String blank_string = " "; /* not oringinally part of EasyIn.. I added this to make it possible * to interleave calls to EasyIn with another input method, which * didn't work with the previous static buffered reader. */ public static String myCrappyReadLine() throws java.io.IOException { StringBuffer sb = new StringBuffer(); int c = 0; while(c >= 0) { c = System.in.read(); if(c < 0) return null; if((char)c == '\n') break; sb.append((char) c); } return sb.toString(); } /** * Reset the tokenizer. * * @throws IOException if an input or output exception occurred. */ private void initTokenizer() throws IOException { do { line = EasyIn.myCrappyReadLine(); if(line == null) throw new IOException("EOF"); idx = 0; len = line.length(); } while(!hasTokens(line)); } /** * Checks if the string contains any tokens. * * @param str string to check * * @return true if there are tokens, false otherwise. */ private boolean hasTokens(String str) { int i, str_len; str_len = str.length(); for(i=0;i < str_len;i++) if(! isDelim(str.charAt(i))) return true; return false; } /** * Checks if this character is a delimiter. * * @param c character to check * * @return true if this character is a delimiter, false otherwise. */ private boolean isDelim(char c) { return ( (c == ' ') || (c == '\t') || (c == '\r') || (c == '\n')); } /** * Checks if there are more tokens. * * @return true if there are more tokens, false otherwise. */ private boolean moreTokens() { return ( idx < len ); } /** * Gets the next token. * * @throws IOException if an input or output exception occurred. * * @return the token */ private String getToken() throws IOException { int begin,end; if( (line == null) || !moreTokens() ) initTokenizer(); while( (idx < len) && isDelim(line.charAt(idx)) ) idx++; if(idx == len) { initTokenizer(); while( (idx < len) && isDelim(line.charAt(idx)) ) idx++; } begin = idx; while( (idx < len) && !isDelim(line.charAt(idx)) ) idx++; end = idx; return line.substring(begin,end); } /** * Reads the specified number of characters and returns a new String * containing them. * * @param num_chars the number of characters to read * * @throws IOException if an input or output exception occurred. * * @return the String containing the characters read. */ public String readchars(int num_chars) throws IOException { int cp_idx; if( (line == null) || !moreTokens() ) initTokenizer(); cp_idx = idx; if(cp_idx + num_chars < len) { idx += num_chars; return( line.substring(cp_idx,cp_idx+num_chars) ); } else { idx = len; return(line.substring(cp_idx,len) + blank_string.substring(0,num_chars-(len-cp_idx))); } } /** * Reads the specified number of characters and returns a new String * containing them. Unlike readchars(), does not throw IOException. * * @param num_chars the number of characters to read * * @return the String containing the characters read. */ public String readChars(int num_chars) { try{ return readchars(num_chars); }catch (IOException e) { System.err.println("IO Exception in EasyIn.readChars"); return null; } } /** * Skips any tokens remaining on this line. */ public void skipRemaining() { line = null; //may not be needed idx = len; } /** * Gets a boolean value from the next token. * * @return the boolean value * * @throws IOException if an input or output exception occurred. */ public boolean readboolean() throws IOException { char ch = getToken().charAt(0); if((ch == 't') || (ch == 'T')) return true; else return false; } /** * Gets a boolean value from the next token. * Same as readboolean() except it does not throw IOException. * * @return the boolean value */ public boolean readBoolean() { try { char ch = getToken().charAt(0); if((ch == 't') || (ch == 'T')) return true; else return false; } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readBoolean"); return false; } } /** * Gets a byte value from the next token. * * @return the byte value * * @throws IOException if an input or output exception occurred. */ public byte readbyte() throws IOException { return Byte.parseByte(getToken()); } /** * Gets a byte value from the next token. * Same as readbyte() except it does not throw IOException. * * @return the byte value */ public byte readByte() { try { return Byte.parseByte(getToken()); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readByte"); return 0; } } /** * Gets a short value from the next token. * * @return the short value * * @throws IOException if an input or output exception occurred. */ public short readshort() throws IOException { return Short.parseShort(getToken()); } /** * Gets a short value from the next token. * Same as readshort() except it does not throw IOException. * * @return the short value */ public short readShort() { try { return Short.parseShort(getToken()); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readShort"); return 0; } } /** * Gets an integer value from the next token. * * @return the integer value * * @throws IOException if an input or output exception occurred. */ public int readint() throws IOException { return Integer.parseInt(getToken()); } /** * Gets an integer value from the next token. * Same as readint() except it does not throw IOException. * * @return the integer value */ public int readInt() { try { return Integer.parseInt(getToken()); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readInt"); return 0; } } /** * Gets a long integer value from the next token. * * @return the long integer value * * @throws IOException if an input or output exception occurred. */ public long readlong() throws IOException { return Long.parseLong(getToken()); } /** * Gets a long integer value from the next token. * Same as readlong() except it does not throw IOException. * * @return the long integer value */ public long readLong() { try { return Long.parseLong(getToken()); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readLong"); return 0L; } } /** * Gets a float value from the next token. * * @return the float value * * @throws IOException if an input or output exception occurred. */ public float readfloat() throws IOException { return new Float(getToken()).floatValue(); } /** * Gets a float value from the next token. * Same as readfloat() except it does not throw IOException. * * @return the float value */ public float readFloat() { try { return new Float(getToken()).floatValue(); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readFloat"); return 0.0F; } } /** * Gets a double value from the next token. * * @return the double value * * @throws IOException if an input or output exception occurred. */ public double readdouble() throws IOException { String tok = getToken(); tok = tok.replace('D', 'E'); tok = tok.replace('d', 'e'); return new Double(tok).doubleValue(); } /** * Gets a double value from the next token. * Same as readdouble() except it does not throw IOException. * * @return the double value */ public double readDouble() { try { String tok = getToken(); tok = tok.replace('D', 'E'); tok = tok.replace('d', 'e'); return new Double(tok).doubleValue(); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readDouble"); return 0.0; } } /** * Gets a character value from the next token. * * @return the character value * * @throws IOException if an input or output exception occurred. */ public char readchar() throws IOException { return getToken().charAt(0); } /** * Gets a character value from the next token. * Same as readchar() except it does not throw IOException. * * @return the character value */ public char readChar() { try { return getToken().charAt(0); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readChar"); return 0; } } /** * Gets a string value from the next token. * * @return the string value * * @throws IOException if an input or output exception occurred. */ public String readstring() throws IOException { return EasyIn.myCrappyReadLine(); } /** * Gets a string value from the next token. * Same as readstring() except it does not throw IOException. * * @return the string value */ public String readString() { try { return EasyIn.myCrappyReadLine(); } catch (IOException ioe) { System.err.println("IO Exception in EasyIn.readString"); return ""; } } /** * This method is just here to test the class */ public static void main (String args[]){ EasyIn easy = new EasyIn(); System.out.print("enter char: "); System.out.flush(); System.out.println("You entered: " + easy.readChar() ); System.out.print("enter String: "); System.out.flush(); System.out.println("You entered: " + easy.readString() ); System.out.print("enter boolean: "); System.out.flush(); System.out.println("You entered: " + easy.readBoolean() ); System.out.print("enter byte: "); System.out.flush(); System.out.println("You entered: " + easy.readByte() ); System.out.print("enter short: "); System.out.flush(); System.out.println("You entered: " + easy.readShort() ); System.out.print("enter int: "); System.out.flush(); System.out.println("You entered: " + easy.readInt() ); System.out.print("enter long: "); System.out.flush(); System.out.println("You entered: " + easy.readLong() ); System.out.print("enter float: "); System.out.flush(); System.out.println("You entered: " + easy.readFloat() ); System.out.print("enter double: "); System.out.flush(); System.out.println("You entered: " + easy.readDouble() ); } } f2j-0.8.1/util/org/netlib/util/Dummy.java0000600000077700002310000000270711031241064020205 0ustar seymourgraduatepackage org.netlib.util; /** * Placeholders for Fortran GOTO statements and labels. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class aids in the translation of goto statements. * The code generator translates gotos and labels into calls * to Dummy.go_to() or Dummy.label(). These calls act as * 'placeholders' so that the gotos and labels can be found * in the class file and converted to real branch * instructions in the bytecode. Thus the resulting class * file should contain no calls to Dummy.go_to() or Dummy.label(). * If so, the print statements should warn the user that the * goto translation was not successful. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class Dummy { /** * Placeholder for a Fortran GOTO statement. * * @param clname name of the program unit where this GOTO exists * @param lbl the label number (target) of the GOTO */ public static void go_to(String clname, int lbl) { System.err.println("Warning: Untransformed goto remaining in program! (" +clname+", " + lbl + ")"); } /** * Placeholder for a Fortran label. * * @param clname name of the program unit where this label exists * @param lbl the label number */ public static void label(String clname, int lbl) { System.err.println("Warning: Untransformed label remaining in program! (" +clname+", " + lbl + ")"); } } f2j-0.8.1/util/org/netlib/util/Etime.java0000600000077700002310000000362411031241064020154 0ustar seymourgraduatepackage org.netlib.util; /** * Implementation of Fortran ETIME intrinsic. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class implements the Fortran 77 ETIME intrinsic. * ETIME is supposed to provide the CPU time for the * process since the start of execution. Currently, * Java doesn't have a similar method, so we use this * cheesy simulation:
*

    *
  • f2j inserts a call to Etime.etime() at the beginning * of the program. *
  • on the first call, record the current time *
  • on subsequent calls, return the difference * between the time of the current call and the starting * time. *
* Essentially, this version of etime returns the * wall-clock time elapsed since the beginning of * execution. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class Etime { private static int call_num = 0; private static long start_time = 0; /** * Initializes the timer. */ public static void etime() { float [] dummy = new float[2]; etime(dummy,0); } /** * Get the elapsed time. Sets the first element of the * array 't' to the elapsed time. This is also the * return value. * * @param t Two-element array of times. The first * element should be user time. The second element * should be system time. Currently these are set * the same, though. * @param t_offset Offset from t. Normally zero. * * @return first element of t. */ public static float etime(float [] t, int t_offset) { if(call_num++ == 0) { start_time = System.currentTimeMillis(); t[0 + t_offset] = 0.0f; t[1 + t_offset] = 0.0f; return 0.0f; } t[0 + t_offset]=(float)(System.currentTimeMillis() - start_time) / 1000.0f; t[1 + t_offset] = t[0 + t_offset]; return t[0 + t_offset]; } } f2j-0.8.1/util/org/netlib/util/Util.buffered0000600000077700002310000003203111031241064020661 0ustar seymourgraduatepackage org.netlib.util; import java.io.*; import java.util.Vector; import org.j_paine.formatter.*; /** * Implementations of various Fortran intrinsic functions. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class contains various helper routines for f2j-generated code. * These routines are primarily implemented for handling Fortran intrinsic * functions. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class Util { /** * Inserts a string into a substring of another string. *

* This method handles situations in which the lhs of an * assignment statement is a substring operation. For example: *

* * a(3:4) = 'hi' * *

* We haven't figured out an elegant way to do this with Java Strings, * but we do handle it, as follows: *

*

* * a = new StringW( * a.val.substring(0,E1-1) + * "hi".substring(0,E2-E1+1) + * a.val.substring(E2,a.val.length()) * ); * *

* Where E1 is the expression representing the starting index of the substring * and E2 is the expression representing the ending index of the substring *

* The resulting code looks pretty bad because we have to be * prepared to handle rhs strings that are too big to fit in * the lhs substring. *

* @param x dest (string to be inserted into) * @param y source (substring to insert into 'x') * @param E1 expression representing the start of the substring * @param E2 expression representing the end of the substring * * @return the string containing the complete string after inserting the * substring */ public static String stringInsert(String x, String y, int E1, int E2) { String tmp; tmp = new String( x.substring(0,E1-1) + y.substring(0,E2-E1+1) + x.substring(E2,x.length())); return tmp; } /** * Inserts a string into a single character substring of another string. * * @param x dest (string to be inserted into) * @param y source (substring to insert into 'x') * @param E1 expression representing the index of the character * * @return the string containing the complete string after inserting the * substring */ public static String stringInsert(String x, String y, int E1) { return stringInsert(x, y, E1, E1); } /** * Returns a string representation of the character at the given index. * Note: this is based on the Fortran index (1..N). * * @param s the string * @param idx the index * * @return new string containing a single character (from s[idx]) */ public static String strCharAt(String s, int idx) { return String.valueOf(s.charAt(idx-1)); } /** * Three argument integer max function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static int max(int x, int y, int z) { return Math.max( x > y ? x : y, Math.max(y,z)); } /** * Three argument single precision max function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static float max(float x, float y, float z) { return Math.max( x > y ? x : y, Math.max(y,z)); } /** * Three argument double precision max function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static double max(double x, double y, double z) { return Math.max( x > y ? x : y, Math.max(y,z)); } /** * Three argument integer min function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static int min(int x, int y, int z) { return Math.min( x < y ? x : y, Math.min(y,z)); } /** * Three argument single precision min function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static float min(float x, float y, float z) { return Math.min( x < y ? x : y, Math.min(y,z)); } /** * Three argument double precision min function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static double min(double x, double y, double z) { return Math.min( x < y ? x : y, Math.min(y,z)); } /** * Base-10 logarithm function. * * @param x the value * * @return base-10 log of x */ public static double log10(double x) { return Math.log(x) / 2.30258509; } /** * Base-10 logarithm function. * * @param x the value * * @return base-10 log of x */ public static float log10(float x) { return (float) (Math.log(x) / 2.30258509); } /** * Fortran nearest integer (NINT) intrinsic function. *

* Returns: *

    *
  • (int)(x+0.5), if x >= 0 *
  • (int)(x-0.5), if x < 0 *
* * @param x the floating point value * * @return the nearest integer to x */ public static int nint(float x) { return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5)); } /** * Fortran nearest integer (IDNINT) intrinsic function. *

* Returns:
*

    *
  • (int)(x+0.5), if x >= 0 *
  • (int)(x-0.5), if x < 0 *
* * @param x the double precision floating point value * * @return the nearest integer to x */ public static int idnint(double x) { return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5)); } /** * Fortran floating point transfer of sign (SIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
* * @param a1 floating point value * @param a2 sign transfer indicator * * @return equivalent of Fortran SIGN(a1,a2) as described above. */ public static float sign(float a1, float a2) { return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1); } /** * Fortran integer transfer of sign (ISIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
* * @param a1 integer value * @param a2 sign transfer indicator * * @return equivalent of Fortran ISIGN(a1,a2) as described above. */ public static int isign(int a1, int a2) { return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1); } /** * Fortran double precision transfer of sign (DSIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
* * @param a1 double precision floating point value * @param a2 sign transfer indicator * * @return equivalent of Fortran DSIGN(a1,a2) as described above. */ public static double dsign(double a1, double a2) { return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1); } /** * Fortran floating point positive difference (DIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
* * @param a1 floating point value * @param a2 floating point value * * @return equivalent of Fortran DIM(a1,a2) as described above. */ public static float dim(float a1, float a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran integer positive difference (IDIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
* * @param a1 integer value * @param a2 integer value * * @return equivalent of Fortran IDIM(a1,a2) as described above. */ public static int idim(int a1, int a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran double precision positive difference (DDIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
* * @param a1 double precision floating point value * @param a2 double precision floating point value * * @return equivalent of Fortran DDIM(a1,a2) as described above. */ public static double ddim(double a1, double a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran hyperbolic sine (SINH) intrinsic function. * * @param a the value to get the sine of * * @return the hyperbolic sine of a */ public static double sinh(double a) { return ( Math.exp(a) - Math.exp(-a) ) * 0.5; } /** * Fortran hyperbolic cosine (COSH) intrinsic function. * * @param a the value to get the cosine of * * @return the hyperbolic cosine of a */ public static double cosh(double a) { return ( Math.exp(a) + Math.exp(-a) ) * 0.5; } /** * Fortran hyperbolic tangent (TANH) intrinsic function. * * @param a the value to get the tangent of * * @return the hyperbolic tangent of a */ public static double tanh(double a) { return sinh(a) / cosh(a); } /** * Pauses execution temporarily. *

* I think this was an implementation dependent feature of Fortran 77. */ public static void pause() { pause(null); } /** * Pauses execution temporarily. *

* I think this was an implementation dependent feature of Fortran 77. * * @param msg the message to be printed before pausing. if null, no * message will be printed. */ public static void pause(String msg) { if(msg != null) System.err.println("PAUSE: " + msg); else System.err.print("PAUSE: "); System.err.println("To resume execution, type: go"); System.err.println("Any other input will terminate the program."); BufferedReader in = new BufferedReader(new InputStreamReader(System.in)); String response = null; try { response = in.readLine(); } catch (IOException e) { response = null; } if( (response == null) || !response.equals("go")) { System.err.println("STOP"); System.exit(0); } } /** * Formatted write. * * @param fmt String containing the Fortran format specification. * @param v Vector containing the arguments to the WRITE() call. * */ public static void f77write(String fmt, Vector v) { if(fmt == null) { f77write(v); return; } try { Formatter f = new Formatter(fmt); Vector newvec = processVector(v); f.write( newvec, System.out ); System.out.println(); } catch ( Exception e ) { String m = e.getMessage(); if(m != null) System.out.println(m); else System.out.println(); } } /** * Unformatted write. * * @param v Vector containing the arguments to the WRITE() call. * */ public static void f77write(Vector v) { java.util.Enumeration e; Object o; Vector newvec = processVector(v); e = newvec.elements(); /* fortran seems to prepend a space before the first * unformatted element. since non-string types get * a string prepended in the loop below, we only * do it for strings here. */ if(e.hasMoreElements()) { o = e.nextElement(); if(o instanceof String) System.out.print(" "); output_unformatted_element(o); } while(e.hasMoreElements()) output_unformatted_element(e.nextElement()); System.out.println(); } private static void output_unformatted_element(Object o) { if(o instanceof Boolean) { /* print true/false as T/F like fortran does */ if(((Boolean) o).booleanValue()) System.out.print(" T"); else System.out.print(" F"); } else if((o instanceof Float) || (o instanceof Double)) System.out.print(" " + o); // two spaces else if(o instanceof String) System.out.print(o); else System.out.print(" " + o); // one space } private static BufferedReader in_reader = null; /** * Formatted read. * * @param fmt String containing the Fortran format specification. * @param v Vector containing the arguments to the READ() call. * */ public static int f77read(String fmt, Vector v) { try { Formatter f = new Formatter(fmt); if(in_reader == null) in_reader = new BufferedReader(new InputStreamReader(System.in)); f.read(v, in_reader); } catch ( EndOfFileWhenStartingReadException eof_exc) { return 0; } catch ( Exception e ) { String m = e.getMessage(); if(m != null) System.out.println(m); else System.out.println("Warning: READ exception."); return -1; } return v.size(); } /** * Expands array elements into separate entries in the Vector. * */ static Vector processVector(Vector v) { java.util.Enumeration e; Vector newvec = new Vector(); for(e = v.elements(); e.hasMoreElements() ;) { Object el = e.nextElement(); if(el instanceof ArraySpec) newvec.addAll(((ArraySpec)el).get_vec()); else newvec.addElement(el); } return newvec; } } f2j-0.8.1/util/org/netlib/util/MatConv.java0000600000077700002310000001276311031241064020464 0ustar seymourgraduatepackage org.netlib.util; /** * Conversions between one-dimensional linearized arrays and two-dimensional arays. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class contains methods for converting between the linearized * arrays used by f2j-generated code and the more natural Java-style * two-dimensional arrays. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class MatConv { /** * Convert a double precision two-dimensional array to * a linearized one-dimensional array. * * @param m the matrix to be converted * * @return the linearized array */ public static double[] doubleTwoDtoOneD (double[][]m) { /* We make the assumption here that the matrices are * square (or rectangular), to get the value of * the second index. */ int ld = m.length; double[] apimatrix = new double[ld * m[0].length]; for (int i = 0; i < ld; i++) for (int j = 0; j < m[0].length; j++) apimatrix[i + j * ld] = m[i][j]; return apimatrix; } /** * Convert a double precision linearized one-dimensional array * to a two-dimensional array. * * @param vec the linearized array to be converted * @param ld leading dimension of the array * * @return the two-dimensional array */ public static double[][] doubleOneDtoTwoD(double [] vec, int ld) { int i,j; double [][] mat = new double [ld][vec.length / ld]; for (i = 0; i < ld; i++) for (j = 0; j < mat[0].length; j++) mat[i][j] = vec[i + j * ld]; return mat; } /** * Convert a single precision two-dimensional array to * a linearized one-dimensional array. * * @param m the matrix to be converted * * @return the linearized array */ public static float[] floatTwoDtoOneD (float[][]m) { /* We make the assumption here that the matrices are * square (or rectangular), to get the value of * the second index. */ int ld = m.length; float[] apimatrix = new float[ld * m[0].length]; for (int i = 0; i < ld; i++) for (int j = 0; j < m[0].length; j++) apimatrix[i + j * ld] = m[i][j]; return apimatrix; } /** * Convert a single precision linearized one-dimensional array * to a two-dimensional array. * * @param vec the linearized array to be converted * @param ld leading dimension of the array * * @return the two-dimensional array */ public static float[][] floatOneDtoTwoD(float [] vec, int ld) { int i,j; float [][] mat = new float [ld][vec.length / ld]; for (i = 0; i < ld; i++) for (j = 0; j < mat[0].length; j++) mat[i][j] = vec[i + j * ld]; return mat; } /** * Convert an integer two-dimensional array to * a linearized one-dimensional array. * * @param m the matrix to be converted * * @return the linearized array */ public static int[] intTwoDtoOneD (int[][]m) { /* We make the assumption here that the matrices are * square (or rectangular), to get the value of * the second index. */ int ld = m.length; int[] apimatrix = new int[ld * m[0].length]; for (int i = 0; i < ld; i++) for (int j = 0; j < m[0].length; j++) apimatrix[i + j * ld] = m[i][j]; return apimatrix; } /** * Convert an integer linearized one-dimensional array * to a two-dimensional array. * * @param vec the linearized array to be converted * @param ld leading dimension of the array * * @return the two-dimensional array */ public static int[][] intOneDtoTwoD(int [] vec, int ld) { int i,j; int [][] mat = new int [ld][vec.length / ld]; for (i = 0; i < ld; i++) for (j = 0; j < mat[0].length; j++) mat[i][j] = vec[i + j * ld]; return mat; } /** * Copies a linearized array into an already allocated two-dimensional * matrix. This is typically called from the simplified wrappers * after the raw routine has been called and the results need to be * copied back into the Java-style two-dimensional matrix. * * @param mat destination matrix * @param vec source array */ public static void copyOneDintoTwoD(double [][]mat, double[]vec) { int i,j; int ld = mat.length; for (i = 0; i < ld; i++) for (j = 0; j < mat[0].length; j++) mat[i][j] = vec[i + j * ld]; } /** * Copies a linearized array into an already allocated two-dimensional * matrix. This is typically called from the simplified wrappers * after the raw routine has been called and the results need to be * copied back into the Java-style two-dimensional matrix. * * @param mat destination matrix * @param vec source array */ public static void copyOneDintoTwoD(float [][]mat, float[]vec) { int i,j; int ld = mat.length; for (i = 0; i < ld; i++) for (j = 0; j < mat[0].length; j++) mat[i][j] = vec[i + j * ld]; } /** * Copies a linearized array into an already allocated two-dimensional * matrix. This is typically called from the simplified wrappers * after the raw routine has been called and the results need to be * copied back into the Java-style two-dimensional matrix. * * @param mat destination matrix * @param vec source array */ public static void copyOneDintoTwoD(int [][]mat, int[]vec) { int i,j; int ld = mat.length; for (i = 0; i < ld; i++) for (j = 0; j < mat[0].length; j++) mat[i][j] = vec[i + j * ld]; } } f2j-0.8.1/util/org/netlib/util/Second.java0000600000077700002310000000237511031241064020326 0ustar seymourgraduatepackage org.netlib.util; /** * Implementation of Fortran SECOND intrinsic function. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class implements the Fortran 77 SECOND intrinsic. * SECOND is supposed to provide the CPU time for the * process since the start of execution. Currently, * Java doesn't have a similar method, so we use this * cheesy simulation:
*

    *
  • f2j inserts a call at the beginning of the program * to record the start time. *
  • on the first call, record the current time. *
  • on subsequent calls, return the difference * between the current call time and the starting * time. *
* Essentially, this version of etime returns the * wall-clock time elapsed since the beginning of * execution. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class Second { /** * Supposed to return the elapsed CPU time since the beginning of * program execution. Currently implemented as wall clock time. * * @return the elapsed time. */ public static float second() { float [] tarray= new float[2]; Etime.etime(); Etime.etime(tarray,0); return tarray[0]; } } f2j-0.8.1/util/org/netlib/util/StringW.java0000600000077700002310000000101211031241064020473 0ustar seymourgraduatepackage org.netlib.util; /** * f2j object wrapper for strings. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class acts as an object wrapper for passing string * values by reference in f2j translated files. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class StringW { public String val; /** * Create a new string wrapper. * * @param x the initial value */ public StringW(String x) { val = x; } } f2j-0.8.1/util/org/netlib/util/Util.java0000600000077700002310000003151711031241064020030 0ustar seymourgraduatepackage org.netlib.util; import java.io.*; import java.util.Vector; import org.j_paine.formatter.*; /** * Implementations of various Fortran intrinsic functions. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class contains various helper routines for f2j-generated code. * These routines are primarily implemented for handling Fortran intrinsic * functions. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class Util { /** * Inserts a string into a substring of another string. *

* This method handles situations in which the lhs of an * assignment statement is a substring operation. For example: *

* * a(3:4) = 'hi' * *

* We haven't figured out an elegant way to do this with Java Strings, * but we do handle it, as follows: *

*

* * a = new StringW( * a.val.substring(0,E1-1) + * "hi".substring(0,E2-E1+1) + * a.val.substring(E2,a.val.length()) * ); * *

* Where E1 is the expression representing the starting index of the substring * and E2 is the expression representing the ending index of the substring *

* The resulting code looks pretty bad because we have to be * prepared to handle rhs strings that are too big to fit in * the lhs substring. *

* @param x dest (string to be inserted into) * @param y source (substring to insert into 'x') * @param E1 expression representing the start of the substring * @param E2 expression representing the end of the substring * * @return the string containing the complete string after inserting the * substring */ public static String stringInsert(String x, String y, int E1, int E2) { String tmp; tmp = new String( x.substring(0,E1-1) + y.substring(0,E2-E1+1) + x.substring(E2,x.length())); return tmp; } /** * Inserts a string into a single character substring of another string. * * @param x dest (string to be inserted into) * @param y source (substring to insert into 'x') * @param E1 expression representing the index of the character * * @return the string containing the complete string after inserting the * substring */ public static String stringInsert(String x, String y, int E1) { return stringInsert(x, y, E1, E1); } /** * Returns a string representation of the character at the given index. * Note: this is based on the Fortran index (1..N). * * @param s the string * @param idx the index * * @return new string containing a single character (from s[idx]) */ public static String strCharAt(String s, int idx) { return String.valueOf(s.charAt(idx-1)); } /** * Three argument integer max function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static int max(int x, int y, int z) { return Math.max( x > y ? x : y, Math.max(y,z)); } /** * Three argument single precision max function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static float max(float x, float y, float z) { return Math.max( x > y ? x : y, Math.max(y,z)); } /** * Three argument double precision max function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static double max(double x, double y, double z) { return Math.max( x > y ? x : y, Math.max(y,z)); } /** * Three argument integer min function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static int min(int x, int y, int z) { return Math.min( x < y ? x : y, Math.min(y,z)); } /** * Three argument single precision min function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static float min(float x, float y, float z) { return Math.min( x < y ? x : y, Math.min(y,z)); } /** * Three argument double precision min function. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static double min(double x, double y, double z) { return Math.min( x < y ? x : y, Math.min(y,z)); } /** * Base-10 logarithm function. * * @param x the value * * @return base-10 log of x */ public static double log10(double x) { return Math.log(x) / 2.30258509; } /** * Base-10 logarithm function. * * @param x the value * * @return base-10 log of x */ public static float log10(float x) { return (float) (Math.log(x) / 2.30258509); } /** * Fortran nearest integer (NINT) intrinsic function. *

* Returns: *

    *
  • (int)(x+0.5), if x >= 0 *
  • (int)(x-0.5), if x < 0 *
* * @param x the floating point value * * @return the nearest integer to x */ public static int nint(float x) { return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5)); } /** * Fortran nearest integer (IDNINT) intrinsic function. *

* Returns:
*

    *
  • (int)(x+0.5), if x >= 0 *
  • (int)(x-0.5), if x < 0 *
* * @param x the double precision floating point value * * @return the nearest integer to x */ public static int idnint(double x) { return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5)); } /** * Fortran floating point transfer of sign (SIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
* * @param a1 floating point value * @param a2 sign transfer indicator * * @return equivalent of Fortran SIGN(a1,a2) as described above. */ public static float sign(float a1, float a2) { return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1); } /** * Fortran integer transfer of sign (ISIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
* * @param a1 integer value * @param a2 sign transfer indicator * * @return equivalent of Fortran ISIGN(a1,a2) as described above. */ public static int isign(int a1, int a2) { return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1); } /** * Fortran double precision transfer of sign (DSIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
* * @param a1 double precision floating point value * @param a2 sign transfer indicator * * @return equivalent of Fortran DSIGN(a1,a2) as described above. */ public static double dsign(double a1, double a2) { return (a2 >= 0) ? Math.abs(a1) : -Math.abs(a1); } /** * Fortran floating point positive difference (DIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
* * @param a1 floating point value * @param a2 floating point value * * @return equivalent of Fortran DIM(a1,a2) as described above. */ public static float dim(float a1, float a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran integer positive difference (IDIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
* * @param a1 integer value * @param a2 integer value * * @return equivalent of Fortran IDIM(a1,a2) as described above. */ public static int idim(int a1, int a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran double precision positive difference (DDIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
* * @param a1 double precision floating point value * @param a2 double precision floating point value * * @return equivalent of Fortran DDIM(a1,a2) as described above. */ public static double ddim(double a1, double a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran hyperbolic sine (SINH) intrinsic function. * * @param a the value to get the sine of * * @return the hyperbolic sine of a */ public static double sinh(double a) { return ( Math.exp(a) - Math.exp(-a) ) * 0.5; } /** * Fortran hyperbolic cosine (COSH) intrinsic function. * * @param a the value to get the cosine of * * @return the hyperbolic cosine of a */ public static double cosh(double a) { return ( Math.exp(a) + Math.exp(-a) ) * 0.5; } /** * Fortran hyperbolic tangent (TANH) intrinsic function. * * @param a the value to get the tangent of * * @return the hyperbolic tangent of a */ public static double tanh(double a) { return sinh(a) / cosh(a); } /** * Pauses execution temporarily. *

* I think this was an implementation dependent feature of Fortran 77. */ public static void pause() { pause(null); } /** * Pauses execution temporarily. *

* I think this was an implementation dependent feature of Fortran 77. * * @param msg the message to be printed before pausing. if null, no * message will be printed. */ public static void pause(String msg) { if(msg != null) System.err.println("PAUSE: " + msg); else System.err.print("PAUSE: "); System.err.println("To resume execution, type: go"); System.err.println("Any other input will terminate the program."); String response = null; try { response = EasyIn.myCrappyReadLine(); } catch (IOException e) { response = null; } if( (response == null) || !response.equals("go")) { System.err.println("STOP"); System.exit(0); } } /** * Formatted write. * * @param fmt String containing the Fortran format specification. * @param v Vector containing the arguments to the WRITE() call. * */ public static void f77write(String fmt, Vector v) { if(fmt == null) { f77write(v); return; } try { Formatter f = new Formatter(fmt); Vector newvec = processVector(v); f.write( newvec, System.out ); System.out.println(); } catch ( Exception e ) { String m = e.getMessage(); if(m != null) System.out.println(m); else System.out.println(); } } /** * Unformatted write. * * @param v Vector containing the arguments to the WRITE() call. * */ public static void f77write(Vector v) { java.util.Enumeration e; Object o; Vector newvec = processVector(v); e = newvec.elements(); /* fortran seems to prepend a space before the first * unformatted element. since non-string types get * a string prepended in the loop below, we only * do it for strings here. */ if(e.hasMoreElements()) { o = e.nextElement(); if(o instanceof String) System.out.print(" "); output_unformatted_element(o); } while(e.hasMoreElements()) output_unformatted_element(e.nextElement()); System.out.println(); } private static void output_unformatted_element(Object o) { if(o instanceof Boolean) { /* print true/false as T/F like fortran does */ if(((Boolean) o).booleanValue()) System.out.print(" T"); else System.out.print(" F"); } else if((o instanceof Float) || (o instanceof Double)) System.out.print(" " + o); // two spaces else if(o instanceof String) System.out.print(o); else System.out.print(" " + o); // one space } /** * Formatted read. * * @param fmt String containing the Fortran format specification. * @param v Vector containing the arguments to the READ() call. * */ public static int f77read(String fmt, Vector v) { try { Formatter f = new Formatter(fmt); f.read( v, new DataInputStream(System.in) ); } catch ( EndOfFileWhenStartingReadException eof_exc) { return 0; } catch ( Exception e ) { String m = e.getMessage(); if(m != null) System.out.println(m); else System.out.println("Warning: READ exception."); return -1; } return v.size(); } /** * Expands array elements into separate entries in the Vector. * */ static Vector processVector(Vector v) { java.util.Enumeration e; Vector newvec = new Vector(); for(e = v.elements(); e.hasMoreElements() ;) { Object el = e.nextElement(); if(el instanceof ArraySpec) newvec.addAll(((ArraySpec)el).get_vec()); else newvec.addElement(el); } return newvec; } } f2j-0.8.1/util/org/netlib/util/booleanW.java0000600000077700002310000000102611031241064020651 0ustar seymourgraduatepackage org.netlib.util; /** * f2j object wrapper for booleans. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class acts as an object wrapper for passing boolean * values by reference in f2j translated files. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class booleanW { public boolean val; /** * Create a new boolean wrapper. * * @param x the initial value */ public booleanW(boolean x) { val = x; } } f2j-0.8.1/util/org/netlib/util/doubleW.java0000600000077700002310000000105411031241064020505 0ustar seymourgraduatepackage org.netlib.util; /** * f2j object wrapper for doubles. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class acts as an object wrapper for passing double * precision floating point values by reference in f2j * translated files. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class doubleW { public double val; /** * Create a new double wrapper. * * @param x the initial value */ public doubleW(double x) { val = x; } } f2j-0.8.1/util/org/netlib/util/floatW.java0000600000077700002310000000104611031241064020341 0ustar seymourgraduatepackage org.netlib.util; /** * f2j object wrapper for floats. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class acts as an object wrapper for passing single * precision floating point values by reference in f2j * translated files. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class floatW { public float val; /** * Create a new float wrapper. * * @param x the initial value */ public floatW(float x) { val = x; } } f2j-0.8.1/util/org/netlib/util/intW.java0000600000077700002310000000100211031241064020016 0ustar seymourgraduatepackage org.netlib.util; /** * f2j object wrapper for integers. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class acts as an object wrapper for passing integer * values by reference in f2j translated files. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public class intW { public int val; /** * Create a new int wrapper. * * @param x the initial value */ public intW(int x) { val = x; } } f2j-0.8.1/util/org/netlib/util/StrictUtil.java0000600000077700002310000001762011031241064021220 0ustar seymourgraduatepackage org.netlib.util; import java.io.*; /** * StrictMath versions of various math related Fortran intrinsic functions. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* This class contains Strict versions of the math related utilities * in {@link Util}. *

* @author Keith Seymour (seymour@cs.utk.edu) * */ public strictfp class StrictUtil extends Util { /** * Three argument integer max function. *

* This function uses Java's StrictMath package. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static int max(int x, int y, int z) { return StrictMath.max( x > y ? x : y, StrictMath.max(y,z)); } /** * Three argument single precision max function. *

* This function uses Java's StrictMath package. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static float max(float x, float y, float z) { return StrictMath.max( x > y ? x : y, StrictMath.max(y,z)); } /** * Three argument double precision max function. *

* This function uses Java's StrictMath package. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the largest of x, y, or z */ public static double max(double x, double y, double z) { return StrictMath.max( x > y ? x : y, StrictMath.max(y,z)); } /** * Three argument integer min function. *

* This function uses Java's StrictMath package. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static int min(int x, int y, int z) { return StrictMath.min( x < y ? x : y, StrictMath.min(y,z)); } /** * Three argument single precision min function. *

* This function uses Java's StrictMath package. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static float min(float x, float y, float z) { return StrictMath.min( x < y ? x : y, StrictMath.min(y,z)); } /** * Three argument double precision min function. *

* This function uses Java's StrictMath package. * * @param x value 1 * @param y value 2 * @param z value 3 * * @return the smallest of x, y, or z */ public static double min(double x, double y, double z) { return StrictMath.min( x < y ? x : y, StrictMath.min(y,z)); } /** * Base-10 logarithm function. *

* This function uses Java's StrictMath package. * * @param x the value * * @return base-10 log of x */ public static double log10(double x) { return StrictMath.log(x) / 2.30258509; } /** * Base-10 logarithm function. *

* This function uses Java's StrictMath package. * * @param x the value * * @return base-10 log of x */ public static float log10(float x) { return (float) (StrictMath.log(x) / 2.30258509); } /** * Fortran nearest integer (NINT) intrinsic function. *

* Returns: *

    *
  • (int)(x+0.5), if x >= 0 *
  • (int)(x-0.5), if x < 0 *
*

* This function uses Java's StrictMath package. * * @param x the floating point value * * @return the nearest integer to x */ public static int nint(float x) { return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5)); } /** * Fortran nearest integer (IDNINT) intrinsic function. *

* Returns:
*

    *
  • (int)(x+0.5), if x >= 0 *
  • (int)(x-0.5), if x < 0 *
*

* This function uses Java's StrictMath package. * * @param x the double precision floating point value * * @return the nearest integer to x */ public static int idnint(double x) { return (int) (( x >= 0 ) ? (x + 0.5) : (x - 0.5)); } /** * Fortran floating point transfer of sign (SIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
*

* This function uses Java's StrictMath package. * * @param a1 floating point value * @param a2 sign transfer indicator * * @return equivalent of Fortran SIGN(a1,a2) as described above. */ public static float sign(float a1, float a2) { return (a2 >= 0) ? StrictMath.abs(a1) : -StrictMath.abs(a1); } /** * Fortran integer transfer of sign (ISIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
*

* This function uses Java's StrictMath package. * * @param a1 integer value * @param a2 sign transfer indicator * * @return equivalent of Fortran ISIGN(a1,a2) as described above. */ public static int isign(int a1, int a2) { return (a2 >= 0) ? StrictMath.abs(a1) : -StrictMath.abs(a1); } /** * Fortran double precision transfer of sign (DSIGN) intrinsic function. *

* Returns:
*

    *
  • abs(a1), if a2 >= 0 *
  • -abs(a1), if a2 < 0 *
*

* This function uses Java's StrictMath package. * * @param a1 double precision floating point value * @param a2 sign transfer indicator * * @return equivalent of Fortran DSIGN(a1,a2) as described above. */ public static double dsign(double a1, double a2) { return (a2 >= 0) ? StrictMath.abs(a1) : -StrictMath.abs(a1); } /** * Fortran floating point positive difference (DIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
*

* This function uses Java's StrictMath package. * * @param a1 floating point value * @param a2 floating point value * * @return equivalent of Fortran DIM(a1,a2) as described above. */ public static float dim(float a1, float a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran integer positive difference (IDIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
*

* This function uses Java's StrictMath package. * * @param a1 integer value * @param a2 integer value * * @return equivalent of Fortran IDIM(a1,a2) as described above. */ public static int idim(int a1, int a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran double precision positive difference (DDIM) intrinsic function. *

* Returns:
*

    *
  • a1 - a2, if a1 > a2 *
  • 0, if a1 <= a2 *
*

* This function uses Java's StrictMath package. * * @param a1 double precision floating point value * @param a2 double precision floating point value * * @return equivalent of Fortran DDIM(a1,a2) as described above. */ public static double ddim(double a1, double a2) { return (a1 > a2) ? (a1 - a2) : 0; } /** * Fortran hyperbolic sine (SINH) intrinsic function. *

* This function uses Java's StrictMath package. * * @param a the value to get the sine of * * @return the hyperbolic sine of a */ public static double sinh(double a) { return ( StrictMath.exp(a) - StrictMath.exp(-a) ) * 0.5; } /** * Fortran hyperbolic cosine (COSH) intrinsic function. *

* This function uses Java's StrictMath package. * * @param a the value to get the cosine of * * @return the hyperbolic cosine of a */ public static double cosh(double a) { return ( StrictMath.exp(a) + StrictMath.exp(-a) ) * 0.5; } /** * Fortran hyperbolic tangent (TANH) intrinsic function. *

* This function uses Java's StrictMath package. * * @param a the value to get the tangent of * * @return the hyperbolic tangent of a */ public static double tanh(double a) { return sinh(a) / cosh(a); } } f2j-0.8.1/util/org/netlib/util/ArraySpec.java0000600000077700002310000000557611031241064021012 0ustar seymourgraduatepackage org.netlib.util; import java.util.Vector; /** * This class represents array arguments to I/O calls. For example, * if you pass an array to WRITE() in Fortran and the format specifies * to print multiple values, they'll be pulled from the array as * appropriate. Here, we just pull all the array elements into * the I/O vector. *

* This file is part of the Fortran-to-Java (f2j) system, * developed at the University of Tennessee. *

* @author Keith Seymour (seymour@cs.utk.edu) */ public class ArraySpec { private Vector vec; /** * Create a new ArraySpec for an integer array. * * @param arr The array to be used in the I/O call * @param offset The offset into the array (i.e. the start point) * @param len The number of elements to copy from the * array to the I/O vector. */ public ArraySpec(int [] arr, int offset, int len) { vec = new Vector(); for(int i=offset; i< offset+len; i++) vec.addElement(new Integer(arr[i])); } /** * Create a new ArraySpec for a double precision array. * * @param arr The array to be used in the I/O call * @param offset The offset into the array (i.e. the start point) * @param len The number of elements to copy from the * array to the I/O vector. */ public ArraySpec(double [] arr, int offset, int len) { vec = new Vector(); for(int i=offset; i< offset+len; i++) vec.addElement(new Double(arr[i])); } /** * Create a new ArraySpec for a float array. * * @param arr The array to be used in the I/O call * @param offset The offset into the array (i.e. the start point) * @param len The number of elements to copy from the * array to the I/O vector. */ public ArraySpec(float [] arr, int offset, int len) { vec = new Vector(); for(int i=offset; i< offset+len; i++) vec.addElement(new Float(arr[i])); } /** * Create a new ArraySpec for a String array. * * @param arr The array to be used in the I/O call * @param offset The offset into the array (i.e. the start point) * @param len The number of elements to copy from the * array to the I/O vector. */ public ArraySpec(String [] arr, int offset, int len) { vec = new Vector(); for(int i=offset; i< offset+len; i++) vec.addElement(new String(arr[i])); } /** * Create a new ArraySpec for a String (not array). Here the * String is not an array, but we want to pull out the characters * individually. * * @param str The string to be used in the I/O call */ public ArraySpec(String str) { char [] chars = str.toCharArray(); vec = new Vector(); for(int i = 0; i < chars.length; i++) vec.addElement(new String(String.valueOf(chars[i]))); } /** * Gets the I/O vector for this ArraySpec. * * @return the Vector representation of the ArraySpec. */ public Vector get_vec() { return vec; } } f2j-0.8.1/util/org/netlib/CVS/0000700000077700002310000000000011031241064015715 5ustar seymourgraduatef2j-0.8.1/util/org/netlib/CVS/Root0000600000077700002310000000006711031241064016570 0ustar seymourgraduate:ext:keithseymour@f2j.cvs.sourceforge.net:/cvsroot/f2j f2j-0.8.1/util/org/netlib/CVS/Repository0000600000077700002310000000002411031241064020015 0ustar seymourgraduatef2j/util/org/netlib f2j-0.8.1/util/org/netlib/CVS/Entries0000600000077700002310000000001311031241064017245 0ustar seymourgraduateD/util//// f2j-0.8.1/util/org/CVS/0000700000077700002310000000000011031241064014440 5ustar seymourgraduatef2j-0.8.1/util/org/CVS/Root0000600000077700002310000000006711031241064015313 0ustar seymourgraduate:ext:keithseymour@f2j.cvs.sourceforge.net:/cvsroot/f2j f2j-0.8.1/util/org/CVS/Repository0000600000077700002310000000001511031241064016540 0ustar seymourgraduatef2j/util/org f2j-0.8.1/util/org/CVS/Entries0000600000077700002310000000003311031241064015772 0ustar seymourgraduateD/netlib//// D/j_paine//// f2j-0.8.1/util/org/j_paine/0000700000077700002310000000000011031241065015413 5ustar seymourgraduatef2j-0.8.1/util/org/j_paine/formatter/0000700000077700002310000000000011031241065017416 5ustar seymourgraduatef2j-0.8.1/util/org/j_paine/formatter/FormatParser.jj0000600000077700002310000001171111031241064022352 0ustar seymourgraduate/* FormatParser.java */ /* This parser parses Fortran format strings. */ options { STATIC = true; DEBUG_PARSER = false; DEBUG_TOKEN_MANAGER = false; DEBUG_LOOKAHEAD = false; } PARSER_BEGIN(FormatParser) package org.j_paine.formatter; class FormatParser { } PARSER_END(FormatParser) SKIP : { <(" ")+> } TOKEN : { } // An unsigned integer, for repetition factors, field widths, etc. // previously: TOKEN : { } // A string literal inside a format. We haven't implemented // embedded quotes yet. TOKEN : { < A_DESC : "A" | "a" > } TOKEN : { < P_DESC : "P" | "p" > } TOKEN : { < X_DESC : "X" | "x" > } TOKEN : { < I_DESC : "I" | "i" > } TOKEN : { < F_DESC : "F" | "f" > } TOKEN : { < D_DESC : "D" | "d" > } TOKEN : { < E_DESC : "E" | "e" > } TOKEN : { < G_DESC : "G" | "g" > } TOKEN : { < L_DESC : "L" | "l" > } int Integer(): { Token t; } { t= { return (Integer.valueOf(t.image)).intValue(); } } /* I split FormatIOElement into FormatIOElementFloat and * FormatIOElementNonFloat because a floating point edit * descriptor (F, E, D, or G) may follow a P edit descriptor * without a comma. --kgs */ FormatElement FormatIOElementFloat(): { FormatElement fe; int w, d, m; w = d = m = -1; } { // for Iw.m, ignore the .m value /* added D and G edit descriptors, but just use the E implementation. --kgs */ ( w=Integer() "." d=Integer() { fe=new FormatF(w,d); } | w=Integer() "." d=Integer() { fe=new FormatE(w,d); } | w=Integer() "." d=Integer() { fe=new FormatE(w,d); } | w=Integer() "." d=Integer() { fe=new FormatE(w,d); } ) { return fe; } } FormatElement FormatIOElementNonFloat(): { FormatElement fe; int w, d, m; w = d = m = -1; } { // for Iw.m, ignore the .m value /* added L edit descriptor. --kgs */ ( [w=Integer()] { fe=new FormatA(w); } | w=Integer() ["." m=Integer()] { fe=new FormatI(w); } | w=Integer() { fe=new FormatL(w); } ) { return fe; } } // This represents a format element that transfers one // data item. FormatElement FormatNonIOElement(): {} { { return new FormatX(); } } // This represents a format element that doesn't transfer // any data items. FormatElement FormatElement(): { FormatElement fe; } { ( fe=FormatIOElementFloat() | fe=FormatIOElementNonFloat() | fe=FormatNonIOElement() | fe=FormatScale() ) { return fe; } } FormatElement FormatScale(): { FormatElement fe = null; int r=1; } { /* Commas may be omitted between a P edit descriptor and an * immediately following F, E, D, or G edit descriptor (13.5.9). * --kgs */ [ [r=Integer()] (fe=FormatIOElementFloat()) ] { return new FormatP(r, fe); } } FormatSlash FormatSlash(): {} { "/" { return new FormatSlash(); } } // These are a special case. Unlike other format elements, // Fortran permits several slashes to be concatenated without // commas to separate them, and you can't use a repetition // factor on them. FormatString FormatString(): { Token t; String s; } { ( t= ) { s = t.image; s = s.substring(1,s.length()-1); // Remove the quotes. return new FormatString(s); } } // Another special case that can't be repeated, and can be // concatenated to other elements without commas. void OptionalFormatSlashesOrStrings( Format f ): { FormatUniv fs; } { ( (fs=FormatSlash() | fs=FormatString()) { f.addElement(fs); } )* } FormatRepeatedItem FormatRepeatedItem(): { int r=1; FormatUniv fu; } { [ r=Integer() ] ( "(" fu=Format() ")" | fu=FormatElement() ) { /* here we check whether the parsed format element is a P edit * descriptor. in that case, it may have parsed a floating point * edit descriptor along with it (if it followed without a comma) * so return that element here. --kgs */ if(fu instanceof FormatP) { FormatRepeatedItem ritem; ritem = ((FormatP)fu).getRepeatedItem(); if(ritem != null) return ritem; else return new FormatRepeatedItem( r, fu ); } else return new FormatRepeatedItem( r, fu ); } } void FormatGroup( Format f ): { FormatRepeatedItem fri; } { ( OptionalFormatSlashesOrStrings( f ) [ fri = FormatRepeatedItem() { if(fri != null) f.addElement(fri); } OptionalFormatSlashesOrStrings( f ) ] ) } // This rather messy syntax allows us to have slashes and/or // strings either side of a format element or repeated group // without needing to separate them from each other or the element // with commas. // It also means that we can have empty format groups and format // groups that don't transfer any data elements. So for example, // the format ,/, is valid under this grammar. Format Format(): { FormatRepeatedItem fri; Format f = new Format(); } { ( FormatGroup(f) ) ( "," ( FormatGroup(f) ) )* { return f; } } f2j-0.8.1/util/org/j_paine/formatter/CVS/0000700000077700002310000000000011031241064020050 5ustar seymourgraduatef2j-0.8.1/util/org/j_paine/formatter/CVS/Root0000600000077700002310000000006711031241064020723 0ustar seymourgraduate:ext:keithseymour@f2j.cvs.sourceforge.net:/cvsroot/f2j f2j-0.8.1/util/org/j_paine/formatter/CVS/Repository0000600000077700002310000000003711031241064022154 0ustar seymourgraduatef2j/util/org/j_paine/formatter f2j-0.8.1/util/org/j_paine/formatter/CVS/Entries0000600000077700002310000000152011031241064021404 0ustar seymourgraduate/NumberParser.java/1.1/Fri Apr 13 17:39:38 2007// /NumberParser.jj/1.1/Fri Apr 13 17:39:36 2007// /NumberParserConstants.java/1.1/Fri Apr 13 17:39:38 2007// /NumberParserTokenManager.java/1.1/Fri Apr 13 17:39:38 2007// /ParseException.java/1.1/Thu Apr 12 18:15:22 2007// /SimpleCharStream.java/1.1/Thu Apr 12 18:19:48 2007// /Token.java/1.1/Thu Apr 12 18:15:22 2007// /TokenMgrError.java/1.1/Thu Apr 12 18:15:22 2007// /EndOfFileWhenStartingReadException.java/1.2/Wed May 9 21:05:40 2007// /FormatParser.java/1.3/Wed May 9 20:50:00 2007// /FormatParser.jj/1.3/Wed May 9 20:49:54 2007// /README/1.2/Wed May 9 21:07:57 2007// /FormatParserConstants.java/1.2/Wed May 9 20:50:00 2007// /FormatParserTokenManager.java/1.2/Wed May 9 20:50:00 2007// /Formatter.java/1.5/Tue Nov 13 19:52:35 2007// /PrintfFormat.java/1.1/Tue Nov 13 04:16:00 2007// D f2j-0.8.1/util/org/j_paine/formatter/FormatParser.java0000600000077700002310000003431411031241064022674 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. FormatParser.java */ package org.j_paine.formatter; class FormatParser implements FormatParserConstants { static final public int Integer() throws ParseException { Token t; t = jj_consume_token(INTEGER); {if (true) return (Integer.valueOf(t.image)).intValue();} throw new Error("Missing return statement in function"); } /* I split FormatIOElement into FormatIOElementFloat and * FormatIOElementNonFloat because a floating point edit * descriptor (F, E, D, or G) may follow a P edit descriptor * without a comma. --kgs */ static final public FormatElement FormatIOElementFloat() throws ParseException { FormatElement fe; int w, d, m; w = d = m = -1; switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case F_DESC: jj_consume_token(F_DESC); w = Integer(); jj_consume_token(13); d = Integer(); fe=new FormatF(w,d); break; case D_DESC: jj_consume_token(D_DESC); w = Integer(); jj_consume_token(13); d = Integer(); fe=new FormatE(w,d); break; case E_DESC: jj_consume_token(E_DESC); w = Integer(); jj_consume_token(13); d = Integer(); fe=new FormatE(w,d); break; case G_DESC: jj_consume_token(G_DESC); w = Integer(); jj_consume_token(13); d = Integer(); fe=new FormatE(w,d); break; default: jj_la1[0] = jj_gen; jj_consume_token(-1); throw new ParseException(); } {if (true) return fe;} throw new Error("Missing return statement in function"); } static final public FormatElement FormatIOElementNonFloat() throws ParseException { FormatElement fe; int w, d, m; w = d = m = -1; switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case A_DESC: jj_consume_token(A_DESC); switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case INTEGER: w = Integer(); break; default: jj_la1[1] = jj_gen; ; } fe=new FormatA(w); break; case I_DESC: jj_consume_token(I_DESC); w = Integer(); switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 13: jj_consume_token(13); m = Integer(); break; default: jj_la1[2] = jj_gen; ; } fe=new FormatI(w); break; case L_DESC: jj_consume_token(L_DESC); w = Integer(); fe=new FormatL(w); break; default: jj_la1[3] = jj_gen; jj_consume_token(-1); throw new ParseException(); } {if (true) return fe;} throw new Error("Missing return statement in function"); } // This represents a format element that transfers one // data item. static final public FormatElement FormatNonIOElement() throws ParseException { jj_consume_token(X_DESC); {if (true) return new FormatX();} throw new Error("Missing return statement in function"); } // This represents a format element that doesn't transfer // any data items. static final public FormatElement FormatElement() throws ParseException { FormatElement fe; switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case F_DESC: case D_DESC: case E_DESC: case G_DESC: fe = FormatIOElementFloat(); break; case A_DESC: case I_DESC: case L_DESC: fe = FormatIOElementNonFloat(); break; case X_DESC: fe = FormatNonIOElement(); break; case P_DESC: fe = FormatScale(); break; default: jj_la1[4] = jj_gen; jj_consume_token(-1); throw new ParseException(); } {if (true) return fe;} throw new Error("Missing return statement in function"); } static final public FormatElement FormatScale() throws ParseException { FormatElement fe = null; int r=1; jj_consume_token(P_DESC); switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case INTEGER: case F_DESC: case D_DESC: case E_DESC: case G_DESC: switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case INTEGER: r = Integer(); break; default: jj_la1[5] = jj_gen; ; } fe = FormatIOElementFloat(); break; default: jj_la1[6] = jj_gen; ; } {if (true) return new FormatP(r, fe);} throw new Error("Missing return statement in function"); } static final public FormatSlash FormatSlash() throws ParseException { jj_consume_token(14); {if (true) return new FormatSlash();} throw new Error("Missing return statement in function"); } // These are a special case. Unlike other format elements, // Fortran permits several slashes to be concatenated without // commas to separate them, and you can't use a repetition // factor on them. static final public FormatString FormatString() throws ParseException { Token t; String s; t = jj_consume_token(STRING); s = t.image; s = s.substring(1,s.length()-1); // Remove the quotes. {if (true) return new FormatString(s);} throw new Error("Missing return statement in function"); } // Another special case that can't be repeated, and can be // concatenated to other elements without commas. static final public void OptionalFormatSlashesOrStrings(Format f) throws ParseException { FormatUniv fs; label_1: while (true) { switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case STRING: case 14: ; break; default: jj_la1[7] = jj_gen; break label_1; } switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 14: fs = FormatSlash(); break; case STRING: fs = FormatString(); break; default: jj_la1[8] = jj_gen; jj_consume_token(-1); throw new ParseException(); } f.addElement(fs); } } static final public FormatRepeatedItem FormatRepeatedItem() throws ParseException { int r=1; FormatUniv fu; switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case INTEGER: r = Integer(); break; default: jj_la1[9] = jj_gen; ; } switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 15: jj_consume_token(15); fu = Format(); jj_consume_token(16); break; case A_DESC: case P_DESC: case X_DESC: case I_DESC: case F_DESC: case D_DESC: case E_DESC: case G_DESC: case L_DESC: fu = FormatElement(); break; default: jj_la1[10] = jj_gen; jj_consume_token(-1); throw new ParseException(); } /* here we check whether the parsed format element is a P edit * descriptor. in that case, it may have parsed a floating point * edit descriptor along with it (if it followed without a comma) * so return that element here. --kgs */ if(fu instanceof FormatP) { FormatRepeatedItem ritem; ritem = ((FormatP)fu).getRepeatedItem(); if(ritem != null) {if (true) return ritem;} else {if (true) return new FormatRepeatedItem( r, fu );} } else {if (true) return new FormatRepeatedItem( r, fu );} throw new Error("Missing return statement in function"); } static final public void FormatGroup(Format f) throws ParseException { FormatRepeatedItem fri; OptionalFormatSlashesOrStrings(f); switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case INTEGER: case A_DESC: case P_DESC: case X_DESC: case I_DESC: case F_DESC: case D_DESC: case E_DESC: case G_DESC: case L_DESC: case 15: fri = FormatRepeatedItem(); if(fri != null) f.addElement(fri); OptionalFormatSlashesOrStrings(f); break; default: jj_la1[11] = jj_gen; ; } } // This rather messy syntax allows us to have slashes and/or // strings either side of a format element or repeated group // without needing to separate them from each other or the element // with commas. // It also means that we can have empty format groups and format // groups that don't transfer any data elements. So for example, // the format ,/, is valid under this grammar. static final public Format Format() throws ParseException { FormatRepeatedItem fri; Format f = new Format(); FormatGroup(f); label_2: while (true) { switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 17: ; break; default: jj_la1[12] = jj_gen; break label_2; } jj_consume_token(17); FormatGroup(f); } {if (true) return f;} throw new Error("Missing return statement in function"); } static private boolean jj_initialized_once = false; static public FormatParserTokenManager token_source; static SimpleCharStream jj_input_stream; static public Token token, jj_nt; static private int jj_ntk; static private int jj_gen; static final private int[] jj_la1 = new int[13]; static private int[] jj_la1_0; static { jj_la1_0(); } private static void jj_la1_0() { jj_la1_0 = new int[] {0xf00,0x4,0x2000,0x1090,0x1ff0,0x4,0xf04,0x4008,0x4008,0x4,0x9ff0,0x9ff4,0x20000,}; } public FormatParser(java.io.InputStream stream) { this(stream, null); } public FormatParser(java.io.InputStream stream, String encoding) { if (jj_initialized_once) { System.out.println("ERROR: Second call to constructor of static parser. You must"); System.out.println(" either use ReInit() or set the JavaCC option STATIC to false"); System.out.println(" during parser generation."); throw new Error(); } jj_initialized_once = true; try { jj_input_stream = new SimpleCharStream(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); } token_source = new FormatParserTokenManager(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 13; i++) jj_la1[i] = -1; } static public void ReInit(java.io.InputStream stream) { ReInit(stream, null); } static public void ReInit(java.io.InputStream stream, String encoding) { try { jj_input_stream.ReInit(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); } token_source.ReInit(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 13; i++) jj_la1[i] = -1; } public FormatParser(java.io.Reader stream) { if (jj_initialized_once) { System.out.println("ERROR: Second call to constructor of static parser. You must"); System.out.println(" either use ReInit() or set the JavaCC option STATIC to false"); System.out.println(" during parser generation."); throw new Error(); } jj_initialized_once = true; jj_input_stream = new SimpleCharStream(stream, 1, 1); token_source = new FormatParserTokenManager(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 13; i++) jj_la1[i] = -1; } static public void ReInit(java.io.Reader stream) { jj_input_stream.ReInit(stream, 1, 1); token_source.ReInit(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 13; i++) jj_la1[i] = -1; } public FormatParser(FormatParserTokenManager tm) { if (jj_initialized_once) { System.out.println("ERROR: Second call to constructor of static parser. You must"); System.out.println(" either use ReInit() or set the JavaCC option STATIC to false"); System.out.println(" during parser generation."); throw new Error(); } jj_initialized_once = true; token_source = tm; token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 13; i++) jj_la1[i] = -1; } public void ReInit(FormatParserTokenManager tm) { token_source = tm; token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 13; i++) jj_la1[i] = -1; } static final private Token jj_consume_token(int kind) throws ParseException { Token oldToken; if ((oldToken = token).next != null) token = token.next; else token = token.next = token_source.getNextToken(); jj_ntk = -1; if (token.kind == kind) { jj_gen++; return token; } token = oldToken; jj_kind = kind; throw generateParseException(); } static final public Token getNextToken() { if (token.next != null) token = token.next; else token = token.next = token_source.getNextToken(); jj_ntk = -1; jj_gen++; return token; } static final public Token getToken(int index) { Token t = token; for (int i = 0; i < index; i++) { if (t.next != null) t = t.next; else t = t.next = token_source.getNextToken(); } return t; } static final private int jj_ntk() { if ((jj_nt=token.next) == null) return (jj_ntk = (token.next=token_source.getNextToken()).kind); else return (jj_ntk = jj_nt.kind); } static private java.util.Vector jj_expentries = new java.util.Vector(); static private int[] jj_expentry; static private int jj_kind = -1; static public ParseException generateParseException() { jj_expentries.removeAllElements(); boolean[] la1tokens = new boolean[18]; for (int i = 0; i < 18; i++) { la1tokens[i] = false; } if (jj_kind >= 0) { la1tokens[jj_kind] = true; jj_kind = -1; } for (int i = 0; i < 13; i++) { if (jj_la1[i] == jj_gen) { for (int j = 0; j < 32; j++) { if ((jj_la1_0[i] & (1< 2) kind = 2; jjCheckNAdd(1); } else if (curChar == 39) jjCheckNAddTwoStates(3, 4); else if (curChar == 32) { if (kind > 1) kind = 1; jjCheckNAdd(0); } break; case 0: if (curChar != 32) break; if (kind > 1) kind = 1; jjCheckNAdd(0); break; case 1: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 2) kind = 2; jjCheckNAdd(1); break; case 3: if ((0xffffff7fffffffffL & l) != 0L) jjCheckNAddTwoStates(3, 4); break; case 4: if (curChar == 39 && kind > 3) kind = 3; break; default : break; } } while(i != startsAt); } else if (curChar < 128) { long l = 1L << (curChar & 077); MatchLoop: do { switch(jjstateSet[--i]) { case 2: if ((0x100000001000L & l) != 0L) { if (kind > 12) kind = 12; } else if ((0x8000000080L & l) != 0L) { if (kind > 11) kind = 11; } else if ((0x2000000020L & l) != 0L) { if (kind > 10) kind = 10; } else if ((0x1000000010L & l) != 0L) { if (kind > 9) kind = 9; } else if ((0x4000000040L & l) != 0L) { if (kind > 8) kind = 8; } else if ((0x20000000200L & l) != 0L) { if (kind > 7) kind = 7; } else if ((0x100000001000000L & l) != 0L) { if (kind > 6) kind = 6; } else if ((0x1000000010000L & l) != 0L) { if (kind > 5) kind = 5; } else if ((0x200000002L & l) != 0L) { if (kind > 4) kind = 4; } break; case 3: jjAddStates(0, 1); break; case 5: if ((0x200000002L & l) != 0L && kind > 4) kind = 4; break; case 6: if ((0x1000000010000L & l) != 0L && kind > 5) kind = 5; break; case 7: if ((0x100000001000000L & l) != 0L && kind > 6) kind = 6; break; case 8: if ((0x20000000200L & l) != 0L && kind > 7) kind = 7; break; case 9: if ((0x4000000040L & l) != 0L && kind > 8) kind = 8; break; case 10: if ((0x1000000010L & l) != 0L && kind > 9) kind = 9; break; case 11: if ((0x2000000020L & l) != 0L && kind > 10) kind = 10; break; case 12: if ((0x8000000080L & l) != 0L && kind > 11) kind = 11; break; case 13: if ((0x100000001000L & l) != 0L && kind > 12) kind = 12; break; default : break; } } while(i != startsAt); } else { int i2 = (curChar & 0xff) >> 6; long l2 = 1L << (curChar & 077); MatchLoop: do { switch(jjstateSet[--i]) { case 3: if ((jjbitVec0[i2] & l2) != 0L) jjAddStates(0, 1); break; default : break; } } while(i != startsAt); } if (kind != 0x7fffffff) { jjmatchedKind = kind; jjmatchedPos = curPos; kind = 0x7fffffff; } ++curPos; if ((i = jjnewStateCnt) == (startsAt = 14 - (jjnewStateCnt = startsAt))) return curPos; try { curChar = input_stream.readChar(); } catch(java.io.IOException e) { return curPos; } } } static final int[] jjnextStates = { 3, 4, }; public static final String[] jjstrLiteralImages = { "", null, null, null, null, null, null, null, null, null, null, null, null, "\56", "\57", "\50", "\51", "\54", }; public static final String[] lexStateNames = { "DEFAULT", }; static final long[] jjtoToken = { 0x3fffdL, }; static final long[] jjtoSkip = { 0x2L, }; static protected SimpleCharStream input_stream; static private final int[] jjrounds = new int[14]; static private final int[] jjstateSet = new int[28]; static protected char curChar; public FormatParserTokenManager(SimpleCharStream stream){ if (input_stream != null) throw new TokenMgrError("ERROR: Second call to constructor of static lexer. You must use ReInit() to initialize the static variables.", TokenMgrError.STATIC_LEXER_ERROR); input_stream = stream; } public FormatParserTokenManager(SimpleCharStream stream, int lexState){ this(stream); SwitchTo(lexState); } static public void ReInit(SimpleCharStream stream) { jjmatchedPos = jjnewStateCnt = 0; curLexState = defaultLexState; input_stream = stream; ReInitRounds(); } static private final void ReInitRounds() { int i; jjround = 0x80000001; for (i = 14; i-- > 0;) jjrounds[i] = 0x80000000; } static public void ReInit(SimpleCharStream stream, int lexState) { ReInit(stream); SwitchTo(lexState); } static public void SwitchTo(int lexState) { if (lexState >= 1 || lexState < 0) throw new TokenMgrError("Error: Ignoring invalid lexical state : " + lexState + ". State unchanged.", TokenMgrError.INVALID_LEXICAL_STATE); else curLexState = lexState; } static protected Token jjFillToken() { Token t = Token.newToken(jjmatchedKind); t.kind = jjmatchedKind; String im = jjstrLiteralImages[jjmatchedKind]; t.image = (im == null) ? input_stream.GetImage() : im; t.beginLine = input_stream.getBeginLine(); t.beginColumn = input_stream.getBeginColumn(); t.endLine = input_stream.getEndLine(); t.endColumn = input_stream.getEndColumn(); return t; } static int curLexState = 0; static int defaultLexState = 0; static int jjnewStateCnt; static int jjround; static int jjmatchedPos; static int jjmatchedKind; public static Token getNextToken() { int kind; Token specialToken = null; Token matchedToken; int curPos = 0; EOFLoop : for (;;) { try { curChar = input_stream.BeginToken(); } catch(java.io.IOException e) { jjmatchedKind = 0; matchedToken = jjFillToken(); return matchedToken; } jjmatchedKind = 0x7fffffff; jjmatchedPos = 0; curPos = jjMoveStringLiteralDfa0_0(); if (jjmatchedKind != 0x7fffffff) { if (jjmatchedPos + 1 < curPos) input_stream.backup(curPos - jjmatchedPos - 1); if ((jjtoToken[jjmatchedKind >> 6] & (1L << (jjmatchedKind & 077))) != 0L) { matchedToken = jjFillToken(); return matchedToken; } else { continue EOFLoop; } } int error_line = input_stream.getEndLine(); int error_column = input_stream.getEndColumn(); String error_after = null; boolean EOFSeen = false; try { input_stream.readChar(); input_stream.backup(1); } catch (java.io.IOException e1) { EOFSeen = true; error_after = curPos <= 1 ? "" : input_stream.GetImage(); if (curChar == '\n' || curChar == '\r') { error_line++; error_column = 0; } else error_column++; } if (!EOFSeen) { input_stream.backup(1); error_after = curPos <= 1 ? "" : input_stream.GetImage(); } throw new TokenMgrError(EOFSeen, curLexState, error_line, error_column, error_after, curChar, TokenMgrError.LEXICAL_ERROR); } } } f2j-0.8.1/util/org/j_paine/formatter/TokenMgrError.java0000600000077700002310000001016411031241064023024 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. TokenMgrError.java Version 3.0 */ package org.j_paine.formatter; public class TokenMgrError extends Error { /* * Ordinals for various reasons why an Error of this type can be thrown. */ /** * Lexical error occured. */ static final int LEXICAL_ERROR = 0; /** * An attempt wass made to create a second instance of a static token manager. */ static final int STATIC_LEXER_ERROR = 1; /** * Tried to change to an invalid lexical state. */ static final int INVALID_LEXICAL_STATE = 2; /** * Detected (and bailed out of) an infinite loop in the token manager. */ static final int LOOP_DETECTED = 3; /** * Indicates the reason why the exception is thrown. It will have * one of the above 4 values. */ int errorCode; /** * Replaces unprintable characters by their espaced (or unicode escaped) * equivalents in the given string */ protected static final String addEscapes(String str) { StringBuffer retval = new StringBuffer(); char ch; for (int i = 0; i < str.length(); i++) { switch (str.charAt(i)) { case 0 : continue; case '\b': retval.append("\\b"); continue; case '\t': retval.append("\\t"); continue; case '\n': retval.append("\\n"); continue; case '\f': retval.append("\\f"); continue; case '\r': retval.append("\\r"); continue; case '\"': retval.append("\\\""); continue; case '\'': retval.append("\\\'"); continue; case '\\': retval.append("\\\\"); continue; default: if ((ch = str.charAt(i)) < 0x20 || ch > 0x7e) { String s = "0000" + Integer.toString(ch, 16); retval.append("\\u" + s.substring(s.length() - 4, s.length())); } else { retval.append(ch); } continue; } } return retval.toString(); } /** * Returns a detailed message for the Error when it is thrown by the * token manager to indicate a lexical error. * Parameters : * EOFSeen : indicates if EOF caused the lexicl error * curLexState : lexical state in which this error occured * errorLine : line number when the error occured * errorColumn : column number when the error occured * errorAfter : prefix that was seen before this error occured * curchar : the offending character * Note: You can customize the lexical error message by modifying this method. */ protected static String LexicalError(boolean EOFSeen, int lexState, int errorLine, int errorColumn, String errorAfter, char curChar) { return("Lexical error at line " + errorLine + ", column " + errorColumn + ". Encountered: " + (EOFSeen ? " " : ("\"" + addEscapes(String.valueOf(curChar)) + "\"") + " (" + (int)curChar + "), ") + "after : \"" + addEscapes(errorAfter) + "\""); } /** * You can also modify the body of this method to customize your error messages. * For example, cases like LOOP_DETECTED and INVALID_LEXICAL_STATE are not * of end-users concern, so you can return something like : * * "Internal Error : Please file a bug report .... " * * from this method for such cases in the release version of your parser. */ public String getMessage() { return super.getMessage(); } /* * Constructors of various flavors follow. */ public TokenMgrError() { } public TokenMgrError(String message, int reason) { super(message); errorCode = reason; } public TokenMgrError(boolean EOFSeen, int lexState, int errorLine, int errorColumn, String errorAfter, char curChar, int reason) { this(LexicalError(EOFSeen, lexState, errorLine, errorColumn, errorAfter, curChar), reason); } } f2j-0.8.1/util/org/j_paine/formatter/ParseException.java0000600000077700002310000001443211031241064023217 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. ParseException.java Version 3.0 */ package org.j_paine.formatter; /** * This exception is thrown when parse errors are encountered. * You can explicitly create objects of this exception type by * calling the method generateParseException in the generated * parser. * * You can modify this class to customize your error reporting * mechanisms so long as you retain the public fields. */ public class ParseException extends Exception { /** * This constructor is used by the method "generateParseException" * in the generated parser. Calling this constructor generates * a new object of this type with the fields "currentToken", * "expectedTokenSequences", and "tokenImage" set. The boolean * flag "specialConstructor" is also set to true to indicate that * this constructor was used to create this object. * This constructor calls its super class with the empty string * to force the "toString" method of parent class "Throwable" to * print the error message in the form: * ParseException: */ public ParseException(Token currentTokenVal, int[][] expectedTokenSequencesVal, String[] tokenImageVal ) { super(""); specialConstructor = true; currentToken = currentTokenVal; expectedTokenSequences = expectedTokenSequencesVal; tokenImage = tokenImageVal; } /** * The following constructors are for use by you for whatever * purpose you can think of. Constructing the exception in this * manner makes the exception behave in the normal way - i.e., as * documented in the class "Throwable". The fields "errorToken", * "expectedTokenSequences", and "tokenImage" do not contain * relevant information. The JavaCC generated code does not use * these constructors. */ public ParseException() { super(); specialConstructor = false; } public ParseException(String message) { super(message); specialConstructor = false; } /** * This variable determines which constructor was used to create * this object and thereby affects the semantics of the * "getMessage" method (see below). */ protected boolean specialConstructor; /** * This is the last token that has been consumed successfully. If * this object has been created due to a parse error, the token * followng this token will (therefore) be the first error token. */ public Token currentToken; /** * Each entry in this array is an array of integers. Each array * of integers represents a sequence of tokens (by their ordinal * values) that is expected at this point of the parse. */ public int[][] expectedTokenSequences; /** * This is a reference to the "tokenImage" array of the generated * parser within which the parse error occurred. This array is * defined in the generated ...Constants interface. */ public String[] tokenImage; /** * This method has the standard behavior when this object has been * created using the standard constructors. Otherwise, it uses * "currentToken" and "expectedTokenSequences" to generate a parse * error message and returns it. If this object has been created * due to a parse error, and you do not catch it (it gets thrown * from the parser), then this method is called during the printing * of the final stack trace, and hence the correct error message * gets displayed. */ public String getMessage() { if (!specialConstructor) { return super.getMessage(); } StringBuffer expected = new StringBuffer(); int maxSize = 0; for (int i = 0; i < expectedTokenSequences.length; i++) { if (maxSize < expectedTokenSequences[i].length) { maxSize = expectedTokenSequences[i].length; } for (int j = 0; j < expectedTokenSequences[i].length; j++) { expected.append(tokenImage[expectedTokenSequences[i][j]]).append(" "); } if (expectedTokenSequences[i][expectedTokenSequences[i].length - 1] != 0) { expected.append("..."); } expected.append(eol).append(" "); } String retval = "Encountered \""; Token tok = currentToken.next; for (int i = 0; i < maxSize; i++) { if (i != 0) retval += " "; if (tok.kind == 0) { retval += tokenImage[0]; break; } retval += add_escapes(tok.image); tok = tok.next; } retval += "\" at line " + currentToken.next.beginLine + ", column " + currentToken.next.beginColumn; retval += "." + eol; if (expectedTokenSequences.length == 1) { retval += "Was expecting:" + eol + " "; } else { retval += "Was expecting one of:" + eol + " "; } retval += expected.toString(); return retval; } /** * The end of line string for this machine. */ protected String eol = System.getProperty("line.separator", "\n"); /** * Used to convert raw characters to their escaped version * when these raw version cannot be used as part of an ASCII * string literal. */ protected String add_escapes(String str) { StringBuffer retval = new StringBuffer(); char ch; for (int i = 0; i < str.length(); i++) { switch (str.charAt(i)) { case 0 : continue; case '\b': retval.append("\\b"); continue; case '\t': retval.append("\\t"); continue; case '\n': retval.append("\\n"); continue; case '\f': retval.append("\\f"); continue; case '\r': retval.append("\\r"); continue; case '\"': retval.append("\\\""); continue; case '\'': retval.append("\\\'"); continue; case '\\': retval.append("\\\\"); continue; default: if ((ch = str.charAt(i)) < 0x20 || ch > 0x7e) { String s = "0000" + Integer.toString(ch, 16); retval.append("\\u" + s.substring(s.length() - 4, s.length())); } else { retval.append(ch); } continue; } } return retval.toString(); } } f2j-0.8.1/util/org/j_paine/formatter/Token.java0000600000077700002310000000515411031241064021347 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. Token.java Version 3.0 */ package org.j_paine.formatter; /** * Describes the input token stream. */ public class Token { /** * An integer that describes the kind of this token. This numbering * system is determined by JavaCCParser, and a table of these numbers is * stored in the file ...Constants.java. */ public int kind; /** * beginLine and beginColumn describe the position of the first character * of this token; endLine and endColumn describe the position of the * last character of this token. */ public int beginLine, beginColumn, endLine, endColumn; /** * The string image of the token. */ public String image; /** * A reference to the next regular (non-special) token from the input * stream. If this is the last token from the input stream, or if the * token manager has not read tokens beyond this one, this field is * set to null. This is true only if this token is also a regular * token. Otherwise, see below for a description of the contents of * this field. */ public Token next; /** * This field is used to access special tokens that occur prior to this * token, but after the immediately preceding regular (non-special) token. * If there are no such special tokens, this field is set to null. * When there are more than one such special token, this field refers * to the last of these special tokens, which in turn refers to the next * previous special token through its specialToken field, and so on * until the first special token (whose specialToken field is null). * The next fields of special tokens refer to other special tokens that * immediately follow it (without an intervening regular token). If there * is no such token, this field is null. */ public Token specialToken; /** * Returns the image. */ public String toString() { return image; } /** * Returns a new Token object, by default. However, if you want, you * can create and return subclass objects based on the value of ofKind. * Simply add the cases to the switch for all those special cases. * For example, if you have a subclass of Token called IDToken that * you want to create if ofKind is ID, simlpy add something like : * * case MyParserConstants.ID : return new IDToken(); * * to the following switch statement. Then you can cast matchedToken * variable to the appropriate type and use it in your lexical actions. */ public static final Token newToken(int ofKind) { switch(ofKind) { default : return new Token(); } } } f2j-0.8.1/util/org/j_paine/formatter/SimpleCharStream.java0000600000077700002310000002564211031241064023476 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. SimpleCharStream.java Version 4.0 */ package org.j_paine.formatter; /** * An implementation of interface CharStream, where the stream is assumed to * contain only ASCII characters (without unicode processing). */ public class SimpleCharStream { public static final boolean staticFlag = false; int bufsize; int available; int tokenBegin; public int bufpos = -1; protected int bufline[]; protected int bufcolumn[]; protected int column = 0; protected int line = 1; protected boolean prevCharIsCR = false; protected boolean prevCharIsLF = false; protected java.io.Reader inputStream; protected char[] buffer; protected int maxNextCharInd = 0; protected int inBuf = 0; protected int tabSize = 8; protected void setTabSize(int i) { tabSize = i; } protected int getTabSize(int i) { return tabSize; } protected void ExpandBuff(boolean wrapAround) { char[] newbuffer = new char[bufsize + 2048]; int newbufline[] = new int[bufsize + 2048]; int newbufcolumn[] = new int[bufsize + 2048]; try { if (wrapAround) { System.arraycopy(buffer, tokenBegin, newbuffer, 0, bufsize - tokenBegin); System.arraycopy(buffer, 0, newbuffer, bufsize - tokenBegin, bufpos); buffer = newbuffer; System.arraycopy(bufline, tokenBegin, newbufline, 0, bufsize - tokenBegin); System.arraycopy(bufline, 0, newbufline, bufsize - tokenBegin, bufpos); bufline = newbufline; System.arraycopy(bufcolumn, tokenBegin, newbufcolumn, 0, bufsize - tokenBegin); System.arraycopy(bufcolumn, 0, newbufcolumn, bufsize - tokenBegin, bufpos); bufcolumn = newbufcolumn; maxNextCharInd = (bufpos += (bufsize - tokenBegin)); } else { System.arraycopy(buffer, tokenBegin, newbuffer, 0, bufsize - tokenBegin); buffer = newbuffer; System.arraycopy(bufline, tokenBegin, newbufline, 0, bufsize - tokenBegin); bufline = newbufline; System.arraycopy(bufcolumn, tokenBegin, newbufcolumn, 0, bufsize - tokenBegin); bufcolumn = newbufcolumn; maxNextCharInd = (bufpos -= tokenBegin); } } catch (Throwable t) { throw new Error(t.getMessage()); } bufsize += 2048; available = bufsize; tokenBegin = 0; } protected void FillBuff() throws java.io.IOException { if (maxNextCharInd == available) { if (available == bufsize) { if (tokenBegin > 2048) { bufpos = maxNextCharInd = 0; available = tokenBegin; } else if (tokenBegin < 0) bufpos = maxNextCharInd = 0; else ExpandBuff(false); } else if (available > tokenBegin) available = bufsize; else if ((tokenBegin - available) < 2048) ExpandBuff(true); else available = tokenBegin; } int i; try { if ((i = inputStream.read(buffer, maxNextCharInd, available - maxNextCharInd)) == -1) { inputStream.close(); throw new java.io.IOException(); } else maxNextCharInd += i; return; } catch(java.io.IOException e) { --bufpos; backup(0); if (tokenBegin == -1) tokenBegin = bufpos; throw e; } } public char BeginToken() throws java.io.IOException { tokenBegin = -1; char c = readChar(); tokenBegin = bufpos; return c; } protected void UpdateLineColumn(char c) { column++; if (prevCharIsLF) { prevCharIsLF = false; line += (column = 1); } else if (prevCharIsCR) { prevCharIsCR = false; if (c == '\n') { prevCharIsLF = true; } else line += (column = 1); } switch (c) { case '\r' : prevCharIsCR = true; break; case '\n' : prevCharIsLF = true; break; case '\t' : column--; column += (tabSize - (column % tabSize)); break; default : break; } bufline[bufpos] = line; bufcolumn[bufpos] = column; } public char readChar() throws java.io.IOException { if (inBuf > 0) { --inBuf; if (++bufpos == bufsize) bufpos = 0; return buffer[bufpos]; } if (++bufpos >= maxNextCharInd) FillBuff(); char c = buffer[bufpos]; UpdateLineColumn(c); return (c); } /** * @deprecated * @see #getEndColumn */ public int getColumn() { return bufcolumn[bufpos]; } /** * @deprecated * @see #getEndLine */ public int getLine() { return bufline[bufpos]; } public int getEndColumn() { return bufcolumn[bufpos]; } public int getEndLine() { return bufline[bufpos]; } public int getBeginColumn() { return bufcolumn[tokenBegin]; } public int getBeginLine() { return bufline[tokenBegin]; } public void backup(int amount) { inBuf += amount; if ((bufpos -= amount) < 0) bufpos += bufsize; } public SimpleCharStream(java.io.Reader dstream, int startline, int startcolumn, int buffersize) { inputStream = dstream; line = startline; column = startcolumn - 1; available = bufsize = buffersize; buffer = new char[buffersize]; bufline = new int[buffersize]; bufcolumn = new int[buffersize]; } public SimpleCharStream(java.io.Reader dstream, int startline, int startcolumn) { this(dstream, startline, startcolumn, 4096); } public SimpleCharStream(java.io.Reader dstream) { this(dstream, 1, 1, 4096); } public void ReInit(java.io.Reader dstream, int startline, int startcolumn, int buffersize) { inputStream = dstream; line = startline; column = startcolumn - 1; if (buffer == null || buffersize != buffer.length) { available = bufsize = buffersize; buffer = new char[buffersize]; bufline = new int[buffersize]; bufcolumn = new int[buffersize]; } prevCharIsLF = prevCharIsCR = false; tokenBegin = inBuf = maxNextCharInd = 0; bufpos = -1; } public void ReInit(java.io.Reader dstream, int startline, int startcolumn) { ReInit(dstream, startline, startcolumn, 4096); } public void ReInit(java.io.Reader dstream) { ReInit(dstream, 1, 1, 4096); } public SimpleCharStream(java.io.InputStream dstream, String encoding, int startline, int startcolumn, int buffersize) throws java.io.UnsupportedEncodingException { this(encoding == null ? new java.io.InputStreamReader(dstream) : new java.io.InputStreamReader(dstream, encoding), startline, startcolumn, buffersize); } public SimpleCharStream(java.io.InputStream dstream, int startline, int startcolumn, int buffersize) { this(new java.io.InputStreamReader(dstream), startline, startcolumn, buffersize); } public SimpleCharStream(java.io.InputStream dstream, String encoding, int startline, int startcolumn) throws java.io.UnsupportedEncodingException { this(dstream, encoding, startline, startcolumn, 4096); } public SimpleCharStream(java.io.InputStream dstream, int startline, int startcolumn) { this(dstream, startline, startcolumn, 4096); } public SimpleCharStream(java.io.InputStream dstream, String encoding) throws java.io.UnsupportedEncodingException { this(dstream, encoding, 1, 1, 4096); } public SimpleCharStream(java.io.InputStream dstream) { this(dstream, 1, 1, 4096); } public void ReInit(java.io.InputStream dstream, String encoding, int startline, int startcolumn, int buffersize) throws java.io.UnsupportedEncodingException { ReInit(encoding == null ? new java.io.InputStreamReader(dstream) : new java.io.InputStreamReader(dstream, encoding), startline, startcolumn, buffersize); } public void ReInit(java.io.InputStream dstream, int startline, int startcolumn, int buffersize) { ReInit(new java.io.InputStreamReader(dstream), startline, startcolumn, buffersize); } public void ReInit(java.io.InputStream dstream, String encoding) throws java.io.UnsupportedEncodingException { ReInit(dstream, encoding, 1, 1, 4096); } public void ReInit(java.io.InputStream dstream) { ReInit(dstream, 1, 1, 4096); } public void ReInit(java.io.InputStream dstream, String encoding, int startline, int startcolumn) throws java.io.UnsupportedEncodingException { ReInit(dstream, encoding, startline, startcolumn, 4096); } public void ReInit(java.io.InputStream dstream, int startline, int startcolumn) { ReInit(dstream, startline, startcolumn, 4096); } public String GetImage() { if (bufpos >= tokenBegin) return new String(buffer, tokenBegin, bufpos - tokenBegin + 1); else return new String(buffer, tokenBegin, bufsize - tokenBegin) + new String(buffer, 0, bufpos + 1); } public char[] GetSuffix(int len) { char[] ret = new char[len]; if ((bufpos + 1) >= len) System.arraycopy(buffer, bufpos - len + 1, ret, 0, len); else { System.arraycopy(buffer, bufsize - (len - bufpos - 1), ret, 0, len - bufpos - 1); System.arraycopy(buffer, 0, ret, len - bufpos - 1, bufpos + 1); } return ret; } public void Done() { buffer = null; bufline = null; bufcolumn = null; } /** * Method to adjust line and column numbers for the start of a token. */ public void adjustBeginLineColumn(int newLine, int newCol) { int start = tokenBegin; int len; if (bufpos >= tokenBegin) { len = bufpos - tokenBegin + inBuf + 1; } else { len = bufsize - tokenBegin + bufpos + 1 + inBuf; } int i = 0, j = 0, k = 0; int nextColDiff = 0, columnDiff = 0; while (i < len && bufline[j = start % bufsize] == bufline[k = ++start % bufsize]) { bufline[j] = newLine; nextColDiff = columnDiff + bufcolumn[k] - bufcolumn[j]; bufcolumn[j] = newCol + columnDiff; columnDiff = nextColDiff; i++; } if (i < len) { bufline[j] = newLine++; bufcolumn[j] = newCol + columnDiff; while (i++ < len) { if (bufline[j = start % bufsize] != bufline[++start % bufsize]) bufline[j] = newLine++; else bufline[j] = newLine; } } line = bufline[j]; column = bufcolumn[j]; } } f2j-0.8.1/util/org/j_paine/formatter/FormatParserConstants.java0000600000077700002310000000127711031241064024573 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. FormatParserConstants.java */ package org.j_paine.formatter; public interface FormatParserConstants { int EOF = 0; int INTEGER = 2; int STRING = 3; int A_DESC = 4; int P_DESC = 5; int X_DESC = 6; int I_DESC = 7; int F_DESC = 8; int D_DESC = 9; int E_DESC = 10; int G_DESC = 11; int L_DESC = 12; int DEFAULT = 0; String[] tokenImage = { "", "", "", "", "", "", "", "", "", "", "", "", "", "\".\"", "\"/\"", "\"(\"", "\")\"", "\",\"", }; } f2j-0.8.1/util/org/j_paine/formatter/NumberParser.jj0000600000077700002310000000322711031241064022355 0ustar seymourgraduate/* NumberParser.java */ /* This parser is used to check the syntax of numbers read by our formatted read routines. */ options { STATIC = false; DEBUG_PARSER = false; DEBUG_TOKEN_MANAGER = false; DEBUG_LOOKAHEAD = false; } PARSER_BEGIN(NumberParser) package org.j_paine.formatter; class NumberParser { } PARSER_END(NumberParser) TOKEN : { < INTEGER_LITERAL: > | < #DECIMAL_LITERAL: "0" | ["1"-"9"] (["0"-"9"])* > | < LOGICAL_LITERAL: "T" | "F" > // We don't allow leading zeroes in integers, as these // might indicate typing errors in the data. | < FLOATING_POINT_LITERAL: (["0"-"9"])+ "." (["0"-"9"])* ()? | "." (["0"-"9"])+ ()? | (["0"-"9"])+ | (["0"-"9"])+ ()? > | < #EXPONENT: ["e","E"] (["+","-"])? (["0"-"9"])+ > } int Float(): { int start = 0; } { ( " " {start++;} )* [ "-" | "+" ] ( | ) { return start; } } // This is the syntax of numbers we want a real format to accept. // The makes sure that trailing non-numeric characters // (even spaces) are reported as an error. // Returns an integer which is the number of spaces to skip before // the number starts. int Integer(): { int start = 0; } { ( " " {start++;} )* [ "-" | "+" ] { return start; } } // This is the syntax of numbers we want an integer format to // accept. // Returns an integer which is the number of spaces to skip before // the number starts. int Boolean(): { int start = 0; } { ( " " {start++;} )* { return start; } } f2j-0.8.1/util/org/j_paine/formatter/NumberParser.java0000600000077700002310000001642011031241064022672 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. NumberParser.java */ package org.j_paine.formatter; class NumberParser implements NumberParserConstants { final public int Float() throws ParseException { int start = 0; label_1: while (true) { switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 6: ; break; default: jj_la1[0] = jj_gen; break label_1; } jj_consume_token(6); start++; } switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 7: case 8: switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 7: jj_consume_token(7); break; case 8: jj_consume_token(8); break; default: jj_la1[1] = jj_gen; jj_consume_token(-1); throw new ParseException(); } break; default: jj_la1[2] = jj_gen; ; } switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case INTEGER_LITERAL: jj_consume_token(INTEGER_LITERAL); break; case FLOATING_POINT_LITERAL: jj_consume_token(FLOATING_POINT_LITERAL); break; default: jj_la1[3] = jj_gen; jj_consume_token(-1); throw new ParseException(); } jj_consume_token(0); {if (true) return start;} throw new Error("Missing return statement in function"); } // This is the syntax of numbers we want a real format to accept. // The makes sure that trailing non-numeric characters // (even spaces) are reported as an error. // Returns an integer which is the number of spaces to skip before // the number starts. final public int Integer() throws ParseException { int start = 0; label_2: while (true) { switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 6: ; break; default: jj_la1[4] = jj_gen; break label_2; } jj_consume_token(6); start++; } switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 7: case 8: switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 7: jj_consume_token(7); break; case 8: jj_consume_token(8); break; default: jj_la1[5] = jj_gen; jj_consume_token(-1); throw new ParseException(); } break; default: jj_la1[6] = jj_gen; ; } jj_consume_token(INTEGER_LITERAL); jj_consume_token(0); {if (true) return start;} throw new Error("Missing return statement in function"); } // This is the syntax of numbers we want an integer format to // accept. // Returns an integer which is the number of spaces to skip before // the number starts. final public int Boolean() throws ParseException { int start = 0; label_3: while (true) { switch ((jj_ntk==-1)?jj_ntk():jj_ntk) { case 6: ; break; default: jj_la1[7] = jj_gen; break label_3; } jj_consume_token(6); start++; } jj_consume_token(LOGICAL_LITERAL); jj_consume_token(0); {if (true) return start;} throw new Error("Missing return statement in function"); } public NumberParserTokenManager token_source; SimpleCharStream jj_input_stream; public Token token, jj_nt; private int jj_ntk; private int jj_gen; final private int[] jj_la1 = new int[8]; static private int[] jj_la1_0; static { jj_la1_0(); } private static void jj_la1_0() { jj_la1_0 = new int[] {0x40,0x180,0x180,0x12,0x40,0x180,0x180,0x40,}; } public NumberParser(java.io.InputStream stream) { this(stream, null); } public NumberParser(java.io.InputStream stream, String encoding) { try { jj_input_stream = new SimpleCharStream(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); } token_source = new NumberParserTokenManager(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 8; i++) jj_la1[i] = -1; } public void ReInit(java.io.InputStream stream) { ReInit(stream, null); } public void ReInit(java.io.InputStream stream, String encoding) { try { jj_input_stream.ReInit(stream, encoding, 1, 1); } catch(java.io.UnsupportedEncodingException e) { throw new RuntimeException(e); } token_source.ReInit(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 8; i++) jj_la1[i] = -1; } public NumberParser(java.io.Reader stream) { jj_input_stream = new SimpleCharStream(stream, 1, 1); token_source = new NumberParserTokenManager(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 8; i++) jj_la1[i] = -1; } public void ReInit(java.io.Reader stream) { jj_input_stream.ReInit(stream, 1, 1); token_source.ReInit(jj_input_stream); token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 8; i++) jj_la1[i] = -1; } public NumberParser(NumberParserTokenManager tm) { token_source = tm; token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 8; i++) jj_la1[i] = -1; } public void ReInit(NumberParserTokenManager tm) { token_source = tm; token = new Token(); jj_ntk = -1; jj_gen = 0; for (int i = 0; i < 8; i++) jj_la1[i] = -1; } final private Token jj_consume_token(int kind) throws ParseException { Token oldToken; if ((oldToken = token).next != null) token = token.next; else token = token.next = token_source.getNextToken(); jj_ntk = -1; if (token.kind == kind) { jj_gen++; return token; } token = oldToken; jj_kind = kind; throw generateParseException(); } final public Token getNextToken() { if (token.next != null) token = token.next; else token = token.next = token_source.getNextToken(); jj_ntk = -1; jj_gen++; return token; } final public Token getToken(int index) { Token t = token; for (int i = 0; i < index; i++) { if (t.next != null) t = t.next; else t = t.next = token_source.getNextToken(); } return t; } final private int jj_ntk() { if ((jj_nt=token.next) == null) return (jj_ntk = (token.next=token_source.getNextToken()).kind); else return (jj_ntk = jj_nt.kind); } private java.util.Vector jj_expentries = new java.util.Vector(); private int[] jj_expentry; private int jj_kind = -1; public ParseException generateParseException() { jj_expentries.removeAllElements(); boolean[] la1tokens = new boolean[9]; for (int i = 0; i < 9; i++) { la1tokens[i] = false; } if (jj_kind >= 0) { la1tokens[jj_kind] = true; jj_kind = -1; } for (int i = 0; i < 8; i++) { if (jj_la1[i] == jj_gen) { for (int j = 0; j < 32; j++) { if ((jj_la1_0[i] & (1< 4) kind = 4; jjCheckNAddStates(0, 5); } else if (curChar == 46) jjCheckNAdd(5); if ((0x3fe000000000000L & l) != 0L) { if (kind > 1) kind = 1; jjCheckNAdd(2); } else if (curChar == 48) { if (kind > 1) kind = 1; } break; case 1: if ((0x3fe000000000000L & l) == 0L) break; if (kind > 1) kind = 1; jjCheckNAdd(2); break; case 2: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 1) kind = 1; jjCheckNAdd(2); break; case 4: if (curChar == 46) jjCheckNAdd(5); break; case 5: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAddTwoStates(5, 6); break; case 7: if ((0x280000000000L & l) != 0L) jjCheckNAdd(8); break; case 8: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAdd(8); break; case 9: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAddStates(0, 5); break; case 10: if ((0x3ff000000000000L & l) != 0L) jjCheckNAddTwoStates(10, 11); break; case 11: if (curChar != 46) break; if (kind > 4) kind = 4; jjCheckNAddTwoStates(12, 13); break; case 12: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAddTwoStates(12, 13); break; case 14: if ((0x280000000000L & l) != 0L) jjCheckNAdd(15); break; case 15: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAdd(15); break; case 16: if ((0x3ff000000000000L & l) != 0L) jjCheckNAddTwoStates(16, 17); break; case 18: if ((0x280000000000L & l) != 0L) jjCheckNAdd(19); break; case 19: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAdd(19); break; case 20: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAddTwoStates(20, 21); break; case 22: if ((0x280000000000L & l) != 0L) jjCheckNAdd(23); break; case 23: if ((0x3ff000000000000L & l) == 0L) break; if (kind > 4) kind = 4; jjCheckNAdd(23); break; default : break; } } while(i != startsAt); } else if (curChar < 128) { long l = 1L << (curChar & 077); MatchLoop: do { switch(jjstateSet[--i]) { case 0: if ((0x100040L & l) != 0L) kind = 3; break; case 6: if ((0x2000000020L & l) != 0L) jjAddStates(6, 7); break; case 13: if ((0x2000000020L & l) != 0L) jjAddStates(8, 9); break; case 17: if ((0x2000000020L & l) != 0L) jjAddStates(10, 11); break; case 21: if ((0x2000000020L & l) != 0L) jjAddStates(12, 13); break; default : break; } } while(i != startsAt); } else { int i2 = (curChar & 0xff) >> 6; long l2 = 1L << (curChar & 077); MatchLoop: do { switch(jjstateSet[--i]) { default : break; } } while(i != startsAt); } if (kind != 0x7fffffff) { jjmatchedKind = kind; jjmatchedPos = curPos; kind = 0x7fffffff; } ++curPos; if ((i = jjnewStateCnt) == (startsAt = 24 - (jjnewStateCnt = startsAt))) return curPos; try { curChar = input_stream.readChar(); } catch(java.io.IOException e) { return curPos; } } } static final int[] jjnextStates = { 10, 11, 16, 17, 20, 21, 7, 8, 14, 15, 18, 19, 22, 23, }; public static final String[] jjstrLiteralImages = { "", null, null, null, null, null, "\40", "\55", "\53", }; public static final String[] lexStateNames = { "DEFAULT", }; protected SimpleCharStream input_stream; private final int[] jjrounds = new int[24]; private final int[] jjstateSet = new int[48]; protected char curChar; public NumberParserTokenManager(SimpleCharStream stream){ if (SimpleCharStream.staticFlag) throw new Error("ERROR: Cannot use a static CharStream class with a non-static lexical analyzer."); input_stream = stream; } public NumberParserTokenManager(SimpleCharStream stream, int lexState){ this(stream); SwitchTo(lexState); } public void ReInit(SimpleCharStream stream) { jjmatchedPos = jjnewStateCnt = 0; curLexState = defaultLexState; input_stream = stream; ReInitRounds(); } private final void ReInitRounds() { int i; jjround = 0x80000001; for (i = 24; i-- > 0;) jjrounds[i] = 0x80000000; } public void ReInit(SimpleCharStream stream, int lexState) { ReInit(stream); SwitchTo(lexState); } public void SwitchTo(int lexState) { if (lexState >= 1 || lexState < 0) throw new TokenMgrError("Error: Ignoring invalid lexical state : " + lexState + ". State unchanged.", TokenMgrError.INVALID_LEXICAL_STATE); else curLexState = lexState; } protected Token jjFillToken() { Token t = Token.newToken(jjmatchedKind); t.kind = jjmatchedKind; String im = jjstrLiteralImages[jjmatchedKind]; t.image = (im == null) ? input_stream.GetImage() : im; t.beginLine = input_stream.getBeginLine(); t.beginColumn = input_stream.getBeginColumn(); t.endLine = input_stream.getEndLine(); t.endColumn = input_stream.getEndColumn(); return t; } int curLexState = 0; int defaultLexState = 0; int jjnewStateCnt; int jjround; int jjmatchedPos; int jjmatchedKind; public Token getNextToken() { int kind; Token specialToken = null; Token matchedToken; int curPos = 0; EOFLoop : for (;;) { try { curChar = input_stream.BeginToken(); } catch(java.io.IOException e) { jjmatchedKind = 0; matchedToken = jjFillToken(); return matchedToken; } jjmatchedKind = 0x7fffffff; jjmatchedPos = 0; curPos = jjMoveStringLiteralDfa0_0(); if (jjmatchedKind != 0x7fffffff) { if (jjmatchedPos + 1 < curPos) input_stream.backup(curPos - jjmatchedPos - 1); matchedToken = jjFillToken(); return matchedToken; } int error_line = input_stream.getEndLine(); int error_column = input_stream.getEndColumn(); String error_after = null; boolean EOFSeen = false; try { input_stream.readChar(); input_stream.backup(1); } catch (java.io.IOException e1) { EOFSeen = true; error_after = curPos <= 1 ? "" : input_stream.GetImage(); if (curChar == '\n' || curChar == '\r') { error_line++; error_column = 0; } else error_column++; } if (!EOFSeen) { input_stream.backup(1); error_after = curPos <= 1 ? "" : input_stream.GetImage(); } throw new TokenMgrError(EOFSeen, curLexState, error_line, error_column, error_after, curChar, TokenMgrError.LEXICAL_ERROR); } } } f2j-0.8.1/util/org/j_paine/formatter/NumberParserConstants.java0000600000077700002310000000102511031241064024562 0ustar seymourgraduate/* Generated By:JavaCC: Do not edit this line. NumberParserConstants.java */ package org.j_paine.formatter; public interface NumberParserConstants { int EOF = 0; int INTEGER_LITERAL = 1; int DECIMAL_LITERAL = 2; int LOGICAL_LITERAL = 3; int FLOATING_POINT_LITERAL = 4; int EXPONENT = 5; int DEFAULT = 0; String[] tokenImage = { "", "", "", "", "", "", "\" \"", "\"-\"", "\"+\"", }; } f2j-0.8.1/util/org/j_paine/formatter/README0000600000077700002310000000121111031241064020272 0ustar seymourgraduateThis directory contains the Formatter package written by Jocelyn Paine. http://www.j-paine.org/Formatter This is actually a modified version of the Formatter, hacked up to work with f2j. Among other things, I removed some exception handling, so the modified version may not be ideal for use in other Java code. A quick summary of the modifications: -added package name -loop back to reuse format spec if more elements in vector -support L (logical) formats -added parsing for P formats, but no scale support -removed some exceptions to better emulate g77 -return padded strings on READ -allow edit descriptors to be upper or lower case f2j-0.8.1/util/org/j_paine/formatter/Formatter.buffered0000600000077700002310000013257711031241064023105 0ustar seymourgraduate/* Formatter.java * * This is a modified version of Jocelyn Paine's Formatter package: * http://www.j-paine.org/Formatter * * Modifications are flagged with "kgs" in the comments. */ package org.j_paine.formatter; import java.io.BufferedReader; import java.io.IOException; import java.io.PrintStream; import java.io.StringReader; import java.util.Hashtable; import java.util.Vector; /* This class holds a Format, and has methods for reading and writing data against it. */ public class Formatter { private Format format = null; private FormatMap format_map = null; public Formatter( String format ) throws InvalidFormatException { this( new Format(format) ); } public Formatter( Format format ) { this.format = format; } public void setFormatMap( FormatMap format_map ) { this.format_map = format_map; } public void write( Vector v, PrintStream out ) throws OutputFormatException { FormatX dummy_el = new FormatX(); FormatOutputList vp = new VectorAndPointer( v ); /* Loop back around and reuse the format spec if * there are still elements in the vector. Keep * going until all elements in the vector have * been printed. --kgs */ while(true) { try { this.format.write( vp, out ); vp.checkCurrentElementForWrite(dummy_el); out.println(); }catch(EndOfVectorOnWriteException e) { break; } } } public void write( int i, PrintStream out ) throws OutputFormatException { write( new Integer(i), out ); } public void write( long l, PrintStream out ) throws OutputFormatException { write( new Long(l), out ); } public void write( float f, PrintStream out ) throws OutputFormatException { write( new Float(f), out ); } public void write( double d, PrintStream out ) throws OutputFormatException { write( new Double(d), out ); } public void write( Object o, PrintStream out ) throws OutputFormatException { Vector v = new Vector(); v.addElement( o ); write( v, out ); } public void read( Vector v, BufferedReader in ) throws InputFormatException { FormatInputList vp = new VectorAndPointer( v ); InputStreamAndBuffer inb = new InputStreamAndBuffer(in); this.format.read( vp, inb, this.format_map ); } public void read( Vector v, Hashtable ht, BufferedReader in ) throws InputFormatException { FormatInputList vp = new StringsHashtableAndPointer( v, ht ); InputStreamAndBuffer inb = new InputStreamAndBuffer(in); this.format.read( vp, inb, this.format_map ); } public void read( String[] s, Hashtable ht, BufferedReader in ) throws InputFormatException { Vector v = new Vector(); for ( int i = 0; i getWidth()) ) return s.substring(0, getWidth()); else { if(getWidth() > s.length()) { char [] pad = new char[getWidth() - s.length()]; for(int i=0;i 0) { char [] pad = new char[len]; for(int i=0;i getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else if(o instanceof String) { /* String passed to I edit descriptor. try converting the * first character to an integer. --kgs */ return convertToString(new Integer((int) (((String)o).charAt(0))), vecptr); } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; // np.ReInit( new StringBufferInputStream(s) ); np.ReInit( new StringReader(s) ); try { int start = np.Integer(); Long l = new Long( s.substring(start) ); return l; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "I"+getWidth(); } } /* * Handles logical (boolean) edit descriptors. */ class FormatL extends FormatIOElement { public FormatL( int w ) { setWidth( w ); } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Boolean ) { char [] b = new char[getWidth()]; int i; for(i=0;i getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; // np.ReInit( new StringBufferInputStream(s) ); np.ReInit( new StringReader(s) ); try { int start = np.Boolean(); char brep = s.substring(start).charAt(0); Boolean b; if(brep == 't' || brep == 'T') b = new Boolean(true); else if(brep == 'f' || brep == 'F') b = new Boolean(false); else throw new ParseException("bad logical value"); return b; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "L"+getWidth(); } } /* This class represents an Fw.d format element. Numbers should be output with d decimal places. */ class FormatF extends FormatIOElement { private int d; public FormatF( int w, int d ) { setWidth( w ); this.d = d; } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Integer || o instanceof Long || o instanceof Float || o instanceof Double ) { CJFormat cjf = new CJFormat(); cjf.setWidth( getWidth() ); cjf.setPrecision( this.d ); cjf.setPre( "" ); cjf.setPost( "" ); cjf.setLeadingZeroes( false ); cjf.setShowPlus( false ); cjf.setAlternate( false ); cjf.setShowSpace( false ); cjf.setLeftAlign( false ); cjf.setFmt( 'f' ); s = cjf.form( ((Number)o).doubleValue() ); /* Throw an exception if the string won't fit. */ if ( s.length() > getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; // np.ReInit( new StringBufferInputStream(s) ); np.ReInit( new StringReader(s) ); try { int start = np.Float(); Double d = new Double( s.substring(start) ); return d; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "F"+getWidth()+"."+this.d; } } /* This class represents an Ew.d format element. Numbers should be output as s0.dd...ddEsdd where s is a sign. */ class FormatE extends FormatIOElement { int d; public FormatE( int w, int d ) { setWidth( w ); this.d = d; } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Integer || o instanceof Long || o instanceof Float || o instanceof Double ) { CJFormat cjf = new CJFormat(); cjf.setWidth( getWidth() ); cjf.setPrecision( this.d ); cjf.setPre( "" ); cjf.setPost( "" ); cjf.setLeadingZeroes( false ); cjf.setShowPlus( false ); cjf.setAlternate( false ); cjf.setShowSpace( false ); cjf.setLeftAlign( false ); cjf.setFmt( 'E' ); s = cjf.form( ((Number)o).doubleValue() ); /* Throw an exception if the string won't fit. */ if ( s.length() > getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; // np.ReInit( new StringBufferInputStream(s) ); np.ReInit( new StringReader(s) ); try { int start = np.Float(); Double d = new Double( s.substring(start) ); return d; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "E"+getWidth()+"."+this.d; } } /* This class represents an / item. */ class FormatSlash extends FormatElement { public void write( FormatOutputList vp, PrintStream out ) { out.println(); } public void read( FormatInputList vp, InputStreamAndBuffer in, FormatMap format_map ) throws InputFormatException { in.readLine( vp.getPtr(), this ); } public String toString() { return "/"; } } /* This class represents an embedded literal, e.g. 'Title'. toString() does not yet handle embedded quotes. */ class FormatString extends FormatElement { private String s; public FormatString( String s ) { this.s = s; } public void write( FormatOutputList vp, PrintStream out ) { out.print(this.s); } public void read( FormatInputList vp, InputStreamAndBuffer in, FormatMap format_map ) throws InputFormatException { String s = in.getSlice( this.s.length(), vp.getPtr(), this ); if ( !( this.s.equals(s) ) ) throw new UnmatchedStringOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport() ); in.advance( this.s.length() ); } public String toString() { return "'" + this.s + "'"; } } /* This class represents a mapping from input data. We use it to specify, for example, that on input, an "X" should be replaced by a "0" before being interpreted by the formatted input routines. The user must provide an instance of this class, with getMapping defined. getMapping should return either null, if the input string is to be left as it is, or a replacement string. */ abstract class FormatMap { public abstract String getMapping( String in ); } interface FormatOutputList { boolean hasCurrentElement(); void checkCurrentElementForWrite( FormatElement format_element ) throws EndOfVectorOnWriteException; Object getCurrentElement(); Object getCurrentElementAndAdvance(); /* Returns the current pointer. Used only in generating error messages. */ int getPtr(); } interface FormatInputList { /* format_element and in are only for generating error messages. */ void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) throws InputFormatException; // If the list is a VectorAndPointer, it won't throw an exception. // If it is a StringsHashtableAndPointer, it will throw a // EndOfKeyVectorOnReadException. /* Puts o into the input list and advances its pointer. Must be defined for each subclass. format_element and in are only for generating error messages. */ void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) throws InputFormatException; /* Returns the current pointer. Used only in generating error messages. */ int getPtr(); } /* This class represents a Vector and a current-element pointer. We use it when outputting or inputting a Vector against a format: the pointer keeps track of the current element being output, and can be incremented by the format write and read methods. */ class VectorAndPointer implements FormatInputList, FormatOutputList { private Vector v = null; private int vecptr = 0; // On output, vecptr points at the next element to be used. // On input, it points at the next free slot to be filled. public VectorAndPointer( Vector v ) { this.v = v; } public VectorAndPointer() { this.v = new Vector(); } public boolean hasCurrentElement() { return ( this.vecptr < this.v.size() ); } public void checkCurrentElementForWrite( FormatElement format_element ) throws EndOfVectorOnWriteException { if ( !hasCurrentElement() ) throw new EndOfVectorOnWriteException( this.vecptr, format_element.toString() ); } /* Checks that the current element in the input list is OK and throws an exception if not. For this implementation of FormatInputList, there are no error conditions - we introduced the method for the StringHashtableAndPointer class, and need it here for compatibility. format_element and in are only for generating error messages. */ public void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) { } public Object getCurrentElement() { return this.v.elementAt( this.vecptr ); } public Object getCurrentElementAndAdvance() { this.vecptr = this.vecptr+1; return this.v.elementAt( this.vecptr-1 ); } /* Puts o into the input list and advances its pointer. format_element and in are only for generating error messages, and not used in this implementation, since no error conditions can arise. */ public void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) { this.v.addElement(o); this.vecptr = this.vecptr + 1; } public void advance() { this.vecptr = this.vecptr + 1; } /* Returns the current pointer. Used only in generating error messages. */ public int getPtr() { return this.vecptr; } } /* This class represents a Vector of Strings and a current-element pointer. We use it when inputting data against a format. */ class StringsHashtableAndPointer implements FormatInputList { private VectorAndPointer vp; private Hashtable ht; public StringsHashtableAndPointer( Vector strings, Hashtable ht ) { this.vp = new VectorAndPointer( strings ); this.ht = ht; } /* Checks that there is a current element in the key vector, and throws an exception if not. format_element and in are only for generating error messages. */ public void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) throws EndOfKeyVectorOnReadException { if ( !(this.vp.hasCurrentElement() ) ) throw new EndOfKeyVectorOnReadException( this.vp.getPtr(), format_element.toString(), in.getLineErrorReport() ); } /* Puts o into the input list and advances its pointer. In this implementation, that means getting the current key, putting o into an appropriate hashtable slot, and advancing the pointer in the vector of keys. format_element and in are only for generating error messages. */ public void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) throws KeyNotStringOnReadException { Object current_key = this.vp.getCurrentElement(); if ( current_key instanceof String ) { this.ht.put( (String)current_key, o ); this.vp.advance(); } else throw new KeyNotStringOnReadException( current_key, this.vp.getPtr(), format_element.toString(), in.getLineErrorReport() ); } /* Returns the current pointer. Used only in generating error messages. */ public int getPtr() { return this.vp.getPtr(); } } /* This class holds an input stream and a line buffer. */ class InputStreamAndBuffer { private BufferedReader in; // The stream we read from. private String line; // The line just read. private int ptr; // Initialised to 0 after reading a line. Index of the next // character to use in line. private int line_number; // Initially 0. Is incremented each time a line is read, so // the first line read is number 1. private boolean nothing_read; // Initially true. Is set false after reading a line. We // use this so that the first call of getSlice // knows to read a line. public InputStreamAndBuffer( BufferedReader in ) { this.in = in; this.ptr = 0; this.line = ""; this.line_number = 0; this.nothing_read = true; } /* Reads the next line into the line buffer. vecptr and format are used only in generating error messages. */ public void readLine( int vecptr, FormatElement format ) throws EndOfFileWhenStartingReadException, LineMissingOnReadException, IOExceptionOnReadException { try { String line = this.in.readLine(); if ( line == null ) { if ( this.nothing_read ) throw new EndOfFileWhenStartingReadException( vecptr, format.toString(), this.line, this.line_number ); else throw new LineMissingOnReadException( vecptr, format.toString(), this.line, this.line_number ); } else { this.ptr = 0; this.nothing_read = false; this.line_number = this.line_number + 1; this.line = line; // Don't do the assignment until we've checked for a null // line, because then we can then use this.line as the // previous value for error messages. } } catch ( IOException e ) { throw new IOExceptionOnReadException( this.line, this.line_number, e.getMessage() ); } } /* Returns a string consisting of the next width characters, and throws an exception if the line is not long enough. The 'vecptr' and 'format' parameters are used only in generating error messages. */ public String getSlice( int width, int vecptr, FormatElement format ) throws DataMissingOnReadException, LineMissingOnReadException, EndOfFileWhenStartingReadException, IOExceptionOnReadException { if ( this.nothing_read ) readLine( vecptr, format ); if ( this.ptr+width > this.line.length() ) { /* if there aren't 'width' characters left, just return the * remainder of the line. --kgs */ return this.line.substring( this.ptr ); } else { return this.line.substring( this.ptr, this.ptr+width ); } } /* Advances the pointer by width. */ public void advance( int width ) { this.ptr = this.ptr + width; } /* Generates an error report showing the line, character pointer ptr and line number. */ public String getLineErrorReport() { StringBuffer s = new StringBuffer(); /* Report the line number. */ s.append( " Line number = " + this.line_number + ":\n" ); /* Show the line. */ s.append( this.line + "\n" ); /* Show an arrow under ptr. */ for ( int i=0; i getWidth()) ) return s.substring(0, getWidth()); else { if(getWidth() > s.length()) { char [] pad = new char[getWidth() - s.length()]; for(int i=0;i 0) { char [] pad = new char[len]; for(int i=0;i getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else if(o instanceof String) { return convertToString(new Integer((int) (((String)o).charAt(0))), vecptr); } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringBufferInputStream(s) ); try { int start = np.Integer(); Long l = new Long( s.substring(start) ); return l; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "I"+getWidth(); } } class FormatL extends FormatIOElement { public FormatL( int w ) { setWidth( w ); } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Boolean ) { char [] b = new char[getWidth()]; int i; for(i=0;i getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringBufferInputStream(s) ); try { int start = np.Boolean(); char brep = s.substring(start).charAt(0); Boolean b; if(brep == 't' || brep == 'T') b = new Boolean(true); else if(brep == 'f' || brep == 'F') b = new Boolean(false); else throw new ParseException("bad logical value"); return b; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "L"+getWidth(); } } /* This class represents an Fw.d format element. Numbers should be output with d decimal places. */ class FormatF extends FormatIOElement { private int d; public FormatF( int w, int d ) { setWidth( w ); this.d = d; } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Integer || o instanceof Long || o instanceof Float || o instanceof Double ) { CJFormat cjf = new CJFormat(); cjf.setWidth( getWidth() ); cjf.setPrecision( this.d ); cjf.setPre( "" ); cjf.setPost( "" ); cjf.setLeadingZeroes( false ); cjf.setShowPlus( false ); cjf.setAlternate( false ); cjf.setShowSpace( false ); cjf.setLeftAlign( false ); cjf.setFmt( 'f' ); s = cjf.form( ((Number)o).doubleValue() ); /* Throw an exception if the string won't fit. */ if ( s.length() > getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringBufferInputStream(s) ); try { int start = np.Float(); Double d = new Double( s.substring(start) ); return d; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "F"+getWidth()+"."+this.d; } } /* This class represents an Ew.d format element. Numbers should be output as s0.dd...ddEsdd where s is a sign. */ class FormatE extends FormatIOElement { int d; public FormatE( int w, int d ) { setWidth( w ); this.d = d; } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Integer || o instanceof Long || o instanceof Float || o instanceof Double ) { CJFormat cjf = new CJFormat(); cjf.setWidth( getWidth() ); cjf.setPrecision( this.d ); cjf.setPre( "" ); cjf.setPost( "" ); cjf.setLeadingZeroes( false ); cjf.setShowPlus( false ); cjf.setAlternate( false ); cjf.setShowSpace( false ); cjf.setLeftAlign( false ); cjf.setFmt( 'E' ); s = cjf.form( ((Number)o).doubleValue() ); /* Throw an exception if the string won't fit. */ if ( s.length() > getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringBufferInputStream(s) ); try { int start = np.Float(); Double d = new Double( s.substring(start) ); return d; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "E"+getWidth()+"."+this.d; } } /* This class represents an / item. */ class FormatSlash extends FormatElement { public void write( FormatOutputList vp, PrintStream out ) { out.println(); } public void read( FormatInputList vp, InputStreamAndBuffer in, FormatMap format_map ) throws InputFormatException { in.readLine( vp.getPtr(), this ); } public String toString() { return "/"; } } /* This class represents an embedded literal, e.g. 'Title'. toString() does not yet handle embedded quotes. */ class FormatString extends FormatElement { private String s; public FormatString( String s ) { this.s = s; } public void write( FormatOutputList vp, PrintStream out ) { out.print(this.s); } public void read( FormatInputList vp, InputStreamAndBuffer in, FormatMap format_map ) throws InputFormatException { String s = in.getSlice( this.s.length(), vp.getPtr(), this ); if ( !( this.s.equals(s) ) ) throw new UnmatchedStringOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport() ); in.advance( this.s.length() ); } public String toString() { return "'" + this.s + "'"; } } /* This class represents a mapping from input data. We use it to specify, for example, that on input, an "X" should be replaced by a "0" before being interpreted by the formatted input routines. The user must provide an instance of this class, with getMapping defined. getMapping should return either null, if the input string is to be left as it is, or a replacement string. */ abstract class FormatMap { public abstract String getMapping( String in ); } interface FormatOutputList { boolean hasCurrentElement(); void checkCurrentElementForWrite( FormatElement format_element ) throws EndOfVectorOnWriteException; Object getCurrentElement(); Object getCurrentElementAndAdvance(); /* Returns the current pointer. Used only in generating error messages. */ int getPtr(); } interface FormatInputList { /* format_element and in are only for generating error messages. */ void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) throws InputFormatException; // If the list is a VectorAndPointer, it won't throw an exception. // If it is a StringsHashtableAndPointer, it will throw a // EndOfKeyVectorOnReadException. /* Puts o into the input list and advances its pointer. Must be defined for each subclass. format_element and in are only for generating error messages. */ void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) throws InputFormatException; /* Returns the current pointer. Used only in generating error messages. */ int getPtr(); } /* This class represents a Vector and a current-element pointer. We use it when outputting or inputting a Vector against a format: the pointer keeps track of the current element being output, and can be incremented by the format write and read methods. */ class VectorAndPointer implements FormatInputList, FormatOutputList { private Vector v = null; private int vecptr = 0; // On output, vecptr points at the next element to be used. // On input, it points at the next free slot to be filled. public VectorAndPointer( Vector v ) { this.v = v; } public VectorAndPointer() { this.v = new Vector(); } public boolean hasCurrentElement() { return ( this.vecptr < this.v.size() ); } public void checkCurrentElementForWrite( FormatElement format_element ) throws EndOfVectorOnWriteException { if ( !hasCurrentElement() ) throw new EndOfVectorOnWriteException( this.vecptr, format_element.toString() ); } /* Checks that the current element in the input list is OK and throws an exception if not. For this implementation of FormatInputList, there are no error conditions - we introduced the method for the StringHashtableAndPointer class, and need it here for compatibility. format_element and in are only for generating error messages. */ public void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) { } public Object getCurrentElement() { return this.v.elementAt( this.vecptr ); } public Object getCurrentElementAndAdvance() { this.vecptr = this.vecptr+1; return this.v.elementAt( this.vecptr-1 ); } /* Puts o into the input list and advances its pointer. format_element and in are only for generating error messages, and not used in this implementation, since no error conditions can arise. */ public void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) { this.v.addElement(o); this.vecptr = this.vecptr + 1; } public void advance() { this.vecptr = this.vecptr + 1; } /* Returns the current pointer. Used only in generating error messages. */ public int getPtr() { return this.vecptr; } } /* This class represents a Vector of Strings and a current-element pointer. We use it when inputting data against a format. */ class StringsHashtableAndPointer implements FormatInputList { private VectorAndPointer vp; private Hashtable ht; public StringsHashtableAndPointer( Vector strings, Hashtable ht ) { this.vp = new VectorAndPointer( strings ); this.ht = ht; } /* Checks that there is a current element in the key vector, and throws an exception if not. format_element and in are only for generating error messages. */ public void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) throws EndOfKeyVectorOnReadException { if ( !(this.vp.hasCurrentElement() ) ) throw new EndOfKeyVectorOnReadException( this.vp.getPtr(), format_element.toString(), in.getLineErrorReport() ); } /* Puts o into the input list and advances its pointer. In this implementation, that means getting the current key, putting o into an appropriate hashtable slot, and advancing the pointer in the vector of keys. format_element and in are only for generating error messages. */ public void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) throws KeyNotStringOnReadException { Object current_key = this.vp.getCurrentElement(); if ( current_key instanceof String ) { this.ht.put( (String)current_key, o ); this.vp.advance(); } else throw new KeyNotStringOnReadException( current_key, this.vp.getPtr(), format_element.toString(), in.getLineErrorReport() ); } /* Returns the current pointer. Used only in generating error messages. */ public int getPtr() { return this.vp.getPtr(); } } /* This class holds an input stream and a line buffer. */ class InputStreamAndBuffer { private DataInputStream in; // The stream we read from. private String line; // The line just read. private int ptr; // Initialised to 0 after reading a line. Index of the next // character to use in line. private int line_number; // Initially 0. Is incremented each time a line is read, so // the first line read is number 1. private boolean nothing_read; // Initially true. Is set false after reading a line. We // use this so that the first call of getSlice // knows to read a line. public InputStreamAndBuffer( DataInputStream in ) { this.in = in; this.ptr = 0; this.line = ""; this.line_number = 0; this.nothing_read = true; } /* Reads the next line into the line buffer. vecptr and format are used only in generating error messages. */ public void readLine( int vecptr, FormatElement format ) throws EndOfFileWhenStartingReadException, LineMissingOnReadException, IOExceptionOnReadException { try { String line = this.in.readLine(); if ( line == null ) { if ( this.nothing_read ) throw new EndOfFileWhenStartingReadException( vecptr, format.toString(), this.line, this.line_number ); else throw new LineMissingOnReadException( vecptr, format.toString(), this.line, this.line_number ); } else { this.ptr = 0; this.nothing_read = false; this.line_number = this.line_number + 1; this.line = line; // Don't do the assignment until we've checked for a null // line, because then we can then use this.line as the // previous value for error messages. } } catch ( IOException e ) { throw new IOExceptionOnReadException( this.line, this.line_number, e.getMessage() ); } } /* Returns a string consisting of the next width characters, and throws an exception if the line is not long enough. The 'vecptr' and 'format' parameters are used only in generating error messages. */ public String getSlice( int width, int vecptr, FormatElement format ) throws DataMissingOnReadException, LineMissingOnReadException, EndOfFileWhenStartingReadException, IOExceptionOnReadException { if ( this.nothing_read ) readLine( vecptr, format ); if ( this.ptr+width > this.line.length() ) { /** throw new DataMissingOnReadException( vecptr, format.toString(), getLineErrorReport() ); **/ return this.line.substring( this.ptr ); } else { return this.line.substring( this.ptr, this.ptr+width ); } } /* Advances the pointer by width. */ public void advance( int width ) { this.ptr = this.ptr + width; } /* Generates an error report showing the line, character pointer ptr and line number. */ public String getLineErrorReport() { StringBuffer s = new StringBuffer(); /* Report the line number. */ s.append( " Line number = " + this.line_number + ":\n" ); /* Show the line. */ s.append( this.line + "\n" ); /* Show an arrow under ptr. */ for ( int i=0; i getWidth()) ) return s.substring(0, getWidth()); else { if(getWidth() > s.length()) { char [] pad = new char[getWidth() - s.length()]; for(int i=0;i 0) { char [] pad = new char[len]; for(int i=0;i getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else if(o instanceof String) { /* String passed to I edit descriptor. try converting the * first character to an integer. --kgs */ return convertToString(new Integer((int) (((String)o).charAt(0))), vecptr); } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringReader(s) ); try { int start = np.Integer(); Long l = new Long( s.substring(start) ); return l; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "I"+getWidth(); } } /* * Handles logical (boolean) edit descriptors. */ class FormatL extends FormatIOElement { public FormatL( int w ) { setWidth( w ); } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Boolean ) { char [] b = new char[getWidth()]; int i; for(i=0;i getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringReader(s) ); try { int start = np.Boolean(); char brep = s.substring(start).charAt(0); Boolean b; if(brep == 't' || brep == 'T') b = new Boolean(true); else if(brep == 'f' || brep == 'F') b = new Boolean(false); else throw new ParseException("bad logical value"); return b; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "L"+getWidth(); } } /* This class represents an Fw.d format element. Numbers should be output with d decimal places. */ class FormatF extends FormatIOElement { private int d; public FormatF( int w, int d ) { setWidth( w ); this.d = d; } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Integer || o instanceof Long || o instanceof Float || o instanceof Double ) { String fmtstr = "%" + Integer.toString(getWidth()) + "." + Integer.toString(this.d) + "f"; s = new PrintfFormat(fmtstr).sprintf(o); /* Throw an exception if the string won't fit. */ if ( s.length() > getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringReader(s) ); try { int start = np.Float(); Double d = new Double( s.substring(start) ); return d; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "F"+getWidth()+"."+this.d; } } /* This class represents an Ew.d format element. Numbers should be output as s0.dd...ddEsdd where s is a sign. */ class FormatE extends FormatIOElement { int d; public FormatE( int w, int d ) { setWidth( w ); this.d = d; } String convertToString( Object o, int vecptr ) throws IllegalObjectOnWriteException, NumberTooWideOnWriteException { String s; /* Convert the number to a string. */ if ( o instanceof Integer || o instanceof Long || o instanceof Float || o instanceof Double ) { String fmtstr = "%" + Integer.toString(getWidth()) + "." + Integer.toString(this.d) + "E"; s = new PrintfFormat(fmtstr).sprintf(o); /* Throw an exception if the string won't fit. */ if ( s.length() > getWidth() ) throw new NumberTooWideOnWriteException( (Number)o, vecptr, this.toString() ); else return s; } else throw new IllegalObjectOnWriteException( o, vecptr, this.toString() ); } /* vp and in are used only in generating error messages. */ Object convertFromString( String s, FormatInputList vp, InputStreamAndBuffer in ) throws InvalidNumberOnReadException { /* Parse the string to check it's a valid number, and convert if so. */ NumberParser np = Parsers.theParsers().number_parser; np.ReInit( new StringReader(s) ); try { int start = np.Float(); Double d = new Double( s.substring(start) ); return d; } catch ( ParseException e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } catch ( TokenMgrError e ) { throw new InvalidNumberOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport(), e.getMessage() ); } } public String toString() { return "E"+getWidth()+"."+this.d; } } /* This class represents an / item. */ class FormatSlash extends FormatElement { public void write( FormatOutputList vp, PrintStream out ) { out.println(); } public void read( FormatInputList vp, InputStreamAndBuffer in, FormatMap format_map ) throws InputFormatException { in.readLine( vp.getPtr(), this ); } public String toString() { return "/"; } } /* This class represents an embedded literal, e.g. 'Title'. toString() does not yet handle embedded quotes. */ class FormatString extends FormatElement { private String s; public FormatString( String s ) { this.s = s; } public void write( FormatOutputList vp, PrintStream out ) { out.print(this.s); } public void read( FormatInputList vp, InputStreamAndBuffer in, FormatMap format_map ) throws InputFormatException { String s = in.getSlice( this.s.length(), vp.getPtr(), this ); if ( !( this.s.equals(s) ) ) throw new UnmatchedStringOnReadException( s, vp.getPtr(), this.toString(), in.getLineErrorReport() ); in.advance( this.s.length() ); } public String toString() { return "'" + this.s + "'"; } } /* This class represents a mapping from input data. We use it to specify, for example, that on input, an "X" should be replaced by a "0" before being interpreted by the formatted input routines. The user must provide an instance of this class, with getMapping defined. getMapping should return either null, if the input string is to be left as it is, or a replacement string. */ abstract class FormatMap { public abstract String getMapping( String in ); } interface FormatOutputList { boolean hasCurrentElement(); void checkCurrentElementForWrite( FormatElement format_element ) throws EndOfVectorOnWriteException; Object getCurrentElement(); Object getCurrentElementAndAdvance(); /* Returns the current pointer. Used only in generating error messages. */ int getPtr(); } interface FormatInputList { /* format_element and in are only for generating error messages. */ void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) throws InputFormatException; // If the list is a VectorAndPointer, it won't throw an exception. // If it is a StringsHashtableAndPointer, it will throw a // EndOfKeyVectorOnReadException. /* Puts o into the input list and advances its pointer. Must be defined for each subclass. format_element and in are only for generating error messages. */ void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) throws InputFormatException; /* Returns the current pointer. Used only in generating error messages. */ int getPtr(); } /* This class represents a Vector and a current-element pointer. We use it when outputting or inputting a Vector against a format: the pointer keeps track of the current element being output, and can be incremented by the format write and read methods. */ class VectorAndPointer implements FormatInputList, FormatOutputList { private Vector v = null; private int vecptr = 0; // On output, vecptr points at the next element to be used. // On input, it points at the next free slot to be filled. public VectorAndPointer( Vector v ) { this.v = v; } public VectorAndPointer() { this.v = new Vector(); } public boolean hasCurrentElement() { return ( this.vecptr < this.v.size() ); } public void checkCurrentElementForWrite( FormatElement format_element ) throws EndOfVectorOnWriteException { if ( !hasCurrentElement() ) throw new EndOfVectorOnWriteException( this.vecptr, format_element.toString() ); } /* Checks that the current element in the input list is OK and throws an exception if not. For this implementation of FormatInputList, there are no error conditions - we introduced the method for the StringHashtableAndPointer class, and need it here for compatibility. format_element and in are only for generating error messages. */ public void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) { } public Object getCurrentElement() { return this.v.elementAt( this.vecptr ); } public Object getCurrentElementAndAdvance() { this.vecptr = this.vecptr+1; return this.v.elementAt( this.vecptr-1 ); } /* Puts o into the input list and advances its pointer. format_element and in are only for generating error messages, and not used in this implementation, since no error conditions can arise. */ public void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) { this.v.addElement(o); this.vecptr = this.vecptr + 1; } public void advance() { this.vecptr = this.vecptr + 1; } /* Returns the current pointer. Used only in generating error messages. */ public int getPtr() { return this.vecptr; } } /* This class represents a Vector of Strings and a current-element pointer. We use it when inputting data against a format. */ class StringsHashtableAndPointer implements FormatInputList { private VectorAndPointer vp; private Hashtable ht; public StringsHashtableAndPointer( Vector strings, Hashtable ht ) { this.vp = new VectorAndPointer( strings ); this.ht = ht; } /* Checks that there is a current element in the key vector, and throws an exception if not. format_element and in are only for generating error messages. */ public void checkCurrentElementForRead( FormatElement format_element, InputStreamAndBuffer in ) throws EndOfKeyVectorOnReadException { if ( !(this.vp.hasCurrentElement() ) ) throw new EndOfKeyVectorOnReadException( this.vp.getPtr(), format_element.toString(), in.getLineErrorReport() ); } /* Puts o into the input list and advances its pointer. In this implementation, that means getting the current key, putting o into an appropriate hashtable slot, and advancing the pointer in the vector of keys. format_element and in are only for generating error messages. */ public void putElementAndAdvance( Object o, FormatElement format_element, InputStreamAndBuffer in ) throws KeyNotStringOnReadException { Object current_key = this.vp.getCurrentElement(); if ( current_key instanceof String ) { this.ht.put( (String)current_key, o ); this.vp.advance(); } else throw new KeyNotStringOnReadException( current_key, this.vp.getPtr(), format_element.toString(), in.getLineErrorReport() ); } /* Returns the current pointer. Used only in generating error messages. */ public int getPtr() { return this.vp.getPtr(); } } /* This class holds an input stream and a line buffer. */ class InputStreamAndBuffer { private DataInputStream in; // The stream we read from. private String line; // The line just read. private int ptr; // Initialised to 0 after reading a line. Index of the next // character to use in line. private int line_number; // Initially 0. Is incremented each time a line is read, so // the first line read is number 1. private boolean nothing_read; // Initially true. Is set false after reading a line. We // use this so that the first call of getSlice // knows to read a line. public InputStreamAndBuffer( DataInputStream in ) { this.in = in; this.ptr = 0; this.line = ""; this.line_number = 0; this.nothing_read = true; } /* Really crappy readline implementation to quiet deprecation warnings * about using DataInputStream.readLine(). --kgs */ public String readLine_hack() throws java.io.IOException { StringBuffer sb = new StringBuffer(); int c = 0; while(c >= 0) { c = in.read(); if(c < 0) return null; if((char)c == '\n') break; sb.append((char) c); } return sb.toString(); } /* Reads the next line into the line buffer. vecptr and format are used only in generating error messages. */ public void readLine( int vecptr, FormatElement format ) throws EndOfFileWhenStartingReadException, LineMissingOnReadException, IOExceptionOnReadException { try { String line = readLine_hack(); if ( line == null ) { if ( this.nothing_read ) throw new EndOfFileWhenStartingReadException( vecptr, format.toString(), this.line, this.line_number ); else throw new LineMissingOnReadException( vecptr, format.toString(), this.line, this.line_number ); } else { this.ptr = 0; this.nothing_read = false; this.line_number = this.line_number + 1; this.line = line; // Don't do the assignment until we've checked for a null // line, because then we can then use this.line as the // previous value for error messages. } } catch ( IOException e ) { throw new IOExceptionOnReadException( this.line, this.line_number, e.getMessage() ); } } /* Returns a string consisting of the next width characters, and throws an exception if the line is not long enough. The 'vecptr' and 'format' parameters are used only in generating error messages. */ public String getSlice( int width, int vecptr, FormatElement format ) throws DataMissingOnReadException, LineMissingOnReadException, EndOfFileWhenStartingReadException, IOExceptionOnReadException { if ( this.nothing_read ) readLine( vecptr, format ); if ( this.ptr+width > this.line.length() ) { /* if there aren't 'width' characters left, just return the * remainder of the line. --kgs */ return this.line.substring( this.ptr ); } else { return this.line.substring( this.ptr, this.ptr+width ); } } /* Advances the pointer by width. */ public void advance( int width ) { this.ptr = this.ptr + width; } /* Generates an error report showing the line, character pointer ptr and line number. */ public String getLineErrorReport() { StringBuffer s = new StringBuffer(); /* Report the line number. */ s.append( " Line number = " + this.line_number + ":\n" ); /* Show the line. */ s.append( this.line + "\n" ); /* Show an arrow under ptr. */ for ( int i=0; i * A control string is a Java string that contains a * control specification. The control specification * starts at the first percent sign (%) in the string, * provided that this percent sign *

    *
  1. is not escaped protected by a matching % or is * not an escape % character, *
  2. is not at the end of the format string, and *
  3. precedes a sequence of characters that parses as * a valid control specification. *
*

* A control specification usually takes the form: *

 % ['-+ #0]* [0..9]* { . [0..9]* }+
 *                { [hlL] }+ [idfgGoxXeEcs]
 *
* There are variants of this basic form that are * discussed below.

*

* The format is composed of zero or more directives * defined as follows: *

    *
  • ordinary characters, which are simply copied to * the output stream; *
  • escape sequences, which represent non-graphic * characters; and *
  • conversion specifications, each of which * results in the fetching of zero or more arguments. *

*

* The results are undefined if there are insufficient * arguments for the format. Usually an unchecked * exception will be thrown. If the format is * exhausted while arguments remain, the excess * arguments are evaluated but are otherwise ignored. * In format strings containing the % form of * conversion specifications, each argument in the * argument list is used exactly once.

*

* Conversions can be applied to the nth * argument after the format in the argument list, * rather than to the next unused argument. In this * case, the conversion characer % is replaced by the * sequence %n$, where n is * a decimal integer giving the position of the * argument in the argument list.

*

* In format strings containing the %n$ * form of conversion specifications, each argument * in the argument list is used exactly once.

* *

Escape Sequences

*

* The following table lists escape sequences and * associated actions on display devices capable of * the action. * * * * * * * * * * * * *
SequenceNameDescription
\\backlashNone. *
\aalertAttempts to alert * the user through audible or visible * notification. *
\bbackspaceMoves the * printing position to one column before * the current position, unless the * current position is the start of a line. *
\fform-feedMoves the * printing position to the initial * printing position of the next logical * page. *
\nnewlineMoves the * printing position to the start of the * next line. *
\rcarriage-returnMoves * the printing position to the start of * the current line. *
\ttabMoves the printing * position to the next implementation- * defined horizontal tab position. *
\vvertical-tabMoves the * printing position to the start of the * next implementation-defined vertical * tab position. *

*

Conversion Specifications

*

* Each conversion specification is introduced by * the percent sign character (%). After the character * %, the following appear in sequence:

*

* Zero or more flags (in any order), which modify the * meaning of the conversion specification.

*

* An optional minimum field width. If the converted * value has fewer characters than the field width, it * will be padded with spaces by default on the left; * t will be padded on the right, if the left- * adjustment flag (-), described below, is given to * the field width. The field width takes the form * of a decimal integer. If the conversion character * is s, the field width is the the minimum number of * characters to be printed.

*

* An optional precision that gives the minumum number * of digits to appear for the d, i, o, x or X * conversions (the field is padded with leading * zeros); the number of digits to appear after the * radix character for the e, E, and f conversions, * the maximum number of significant digits for the g * and G conversions; or the maximum number of * characters to be written from a string is s and S * conversions. The precision takes the form of an * optional decimal digit string, where a null digit * string is treated as 0. If a precision appears * with a c conversion character the precision is * ignored. *

*

* An optional h specifies that a following d, i, o, * x, or X conversion character applies to a type * short argument (the argument will be promoted * according to the integral promotions and its value * converted to type short before printing).

*

* An optional l (ell) specifies that a following * d, i, o, x, or X conversion character applies to a * type long argument.

*

* A field width or precision may be indicated by an * asterisk (*) instead of a digit string. In this * case, an integer argument supplised the field width * precision. The argument that is actually converted * is not fetched until the conversion letter is seen, * so the the arguments specifying field width or * precision must appear before the argument (if any) * to be converted. If the precision argument is * negative, it will be changed to zero. A negative * field width argument is taken as a - flag, followed * by a positive field width.

*

* In format strings containing the %n$ * form of a conversion specification, a field width * or precision may be indicated by the sequence * *m$, where m is a decimal integer * giving the position in the argument list (after the * format argument) of an integer argument containing * the field width or precision.

*

* The format can contain either numbered argument * specifications (that is, %n$ and * *m$), or unnumbered argument * specifications (that is % and *), but normally not * both. The only exception to this is that %% can * be mixed with the %n$ form. The * results of mixing numbered and unnumbered argument * specifications in a format string are undefined.

* *

Flag Characters

*

* The flags and their meanings are:

*
*
'
integer portion of the result of a * decimal conversion (%i, %d, %f, %g, or %G) will * be formatted with thousands' grouping * characters. For other conversions the flag * is ignored. The non-monetary grouping * character is used. *
-
result of the conversion is left-justified * within the field. (It will be right-justified * if this flag is not specified). *
+
result of a signed conversion always * begins with a sign (+ or -). (It will begin * with a sign only when a negative value is * converted if this flag is not specified.) *
<space>
If the first character of a * signed conversion is not a sign, a space * character will be placed before the result. * This means that if the space character and + * flags both appear, the space flag will be * ignored. *
#
value is to be converted to an alternative * form. For c, d, i, and s conversions, the flag * has no effect. For o conversion, it increases * the precision to force the first digit of the * result to be a zero. For x or X conversion, a * non-zero result has 0x or 0X prefixed to it, * respectively. For e, E, f, g, and G * conversions, the result always contains a radix * character, even if no digits follow the radix * character (normally, a decimal point appears in * the result of these conversions only if a digit * follows it). For g and G conversions, trailing * zeros will not be removed from the result as * they normally are. *
0
d, i, o, x, X, e, E, f, g, and G * conversions, leading zeros (following any * indication of sign or base) are used to pad to * the field width; no space padding is * performed. If the 0 and - flags both appear, * the 0 flag is ignored. For d, i, o, x, and X * conversions, if a precision is specified, the * 0 flag will be ignored. For c conversions, * the flag is ignored. *
* *

Conversion Characters

*

* Each conversion character results in fetching zero * or more arguments. The results are undefined if * there are insufficient arguments for the format. * Usually, an unchecked exception will be thrown. * If the format is exhausted while arguments remain, * the excess arguments are ignored.

* *

* The conversion characters and their meanings are: *

*
*
d,i
The int argument is converted to a * signed decimal in the style [-]dddd. The * precision specifies the minimum number of * digits to appear; if the value being * converted can be represented in fewer * digits, it will be expanded with leading * zeros. The default precision is 1. The * result of converting 0 with an explicit * precision of 0 is no characters. *
o
The int argument is converted to unsigned * octal format in the style ddddd. The * precision specifies the minimum number of * digits to appear; if the value being * converted can be represented in fewer * digits, it will be expanded with leading * zeros. The default precision is 1. The * result of converting 0 with an explicit * precision of 0 is no characters. *
x
The int argument is converted to unsigned * hexadecimal format in the style dddd; the * letters abcdef are used. The precision * specifies the minimum numberof digits to * appear; if the value being converted can be * represented in fewer digits, it will be * expanded with leading zeros. The default * precision is 1. The result of converting 0 * with an explicit precision of 0 is no * characters. *
X
Behaves the same as the x conversion * character except that letters ABCDEF are * used instead of abcdef. *
f
The floating point number argument is * written in decimal notation in the style * [-]ddd.ddd, where the number of digits after * the radix character (shown here as a decimal * point) is equal to the precision * specification. A Locale is used to determine * the radix character to use in this format. * If the precision is omitted from the * argument, six digits are written after the * radix character; if the precision is * explicitly 0 and the # flag is not specified, * no radix character appears. If a radix * character appears, at least 1 digit appears * before it. The value is rounded to the * appropriate number of digits. *
e,E
The floating point number argument is * written in the style [-]d.ddde{+-}dd * (the symbols {+-} indicate either a plus or * minus sign), where there is one digit before * the radix character (shown here as a decimal * point) and the number of digits after it is * equal to the precision. A Locale is used to * determine the radix character to use in this * format. When the precision is missing, six * digits are written after the radix character; * if the precision is 0 and the # flag is not * specified, no radix character appears. The * E conversion will produce a number with E * instead of e introducing the exponent. The * exponent always contains at least two digits. * However, if the value to be written requires * an exponent greater than two digits, * additional exponent digits are written as * necessary. The value is rounded to the * appropriate number of digits. *
g,G
The floating point number argument is * written in style f or e (or in sytle E in the * case of a G conversion character), with the * precision specifying the number of * significant digits. If the precision is * zero, it is taken as one. The style used * depends on the value converted: style e * (or E) will be used only if the exponent * resulting from the conversion is less than * -4 or greater than or equal to the precision. * Trailing zeros are removed from the result. * A radix character appears only if it is * followed by a digit. *
c,C
The integer argument is converted to a * char and the result is written. * *
s,S
The argument is taken to be a string and * bytes from the string are written until the * end of the string or the number of bytes * indicated by the precision specification of * the argument is reached. If the precision * is omitted from the argument, it is taken to * be infinite, so all characters up to the end * of the string are written. *
%
Write a % character; no argument is * converted. *
*

* If a conversion specification does not match one of * the above forms, an IllegalArgumentException is * thrown and the instance of PrintfFormat is not * created.

*

* If a floating point value is the internal * representation for infinity, the output is * [+]Infinity, where Infinity is either Infinity or * Inf, depending on the desired output string length. * Printing of the sign follows the rules described * above.

*

* If a floating point value is the internal * representation for "not-a-number," the output is * [+]NaN. Printing of the sign follows the rules * described above.

*

* In no case does a non-existent or small field width * cause truncation of a field; if the result of a * conversion is wider than the field width, the field * is simply expanded to contain the conversion result. *

*

* The behavior is like printf. One exception is that * the minimum number of exponent digits is 3 instead * of 2 for e and E formats when the optional L is used * before the e, E, g, or G conversion character. The * optional L does not imply conversion to a long long * double.

*

* The biggest divergence from the C printf * specification is in the use of 16 bit characters. * This allows the handling of characters beyond the * small ASCII character set and allows the utility to * interoperate correctly with the rest of the Java * runtime environment.

*

* Omissions from the C printf specification are * numerous. All the known omissions are present * because Java never uses bytes to represent * characters and does not have pointers:

*
    *
  • %c is the same as %C. *
  • %s is the same as %S. *
  • u, p, and n conversion characters. *
  • %ws format. *
  • h modifier applied to an n conversion character. *
  • l (ell) modifier applied to the c, n, or s * conversion characters. *
  • ll (ell ell) modifier to d, i, o, u, x, or X * conversion characters. *
  • ll (ell ell) modifier to an n conversion * character. *
  • c, C, d,i,o,u,x, and X conversion characters * apply to Byte, Character, Short, Integer, Long * types. *
  • f, e, E, g, and G conversion characters apply * to Float and Double types. *
  • s and S conversion characters apply to String * types. *
  • All other reference types can be formatted * using the s or S conversion characters only. *
*

* Most of this specification is quoted from the Unix * man page for the sprintf utility.

* * @author Allan Jacobs * @version 1 * Release 1: Initial release. * Release 2: Asterisk field widths and precisions * %n$ and *m$ * Bug fixes * g format fix (2 digits in e form corrupt) * rounding in f format implemented * round up when digit not printed is 5 * formatting of -0.0f * round up/down when last digits are 50000... */ public class PrintfFormat { /** * Constructs an array of control specifications * possibly preceded, separated, or followed by * ordinary strings. Control strings begin with * unpaired percent signs. A pair of successive * percent signs designates a single percent sign in * the format. * @param fmtArg Control string. * @exception IllegalArgumentException if the control * string is null, zero length, or otherwise * malformed. */ public PrintfFormat(String fmtArg) throws IllegalArgumentException { this(Locale.getDefault(),fmtArg); } /** * Constructs an array of control specifications * possibly preceded, separated, or followed by * ordinary strings. Control strings begin with * unpaired percent signs. A pair of successive * percent signs designates a single percent sign in * the format. * @param fmtArg Control string. * @exception IllegalArgumentException if the control * string is null, zero length, or otherwise * malformed. */ public PrintfFormat(Locale locale,String fmtArg) throws IllegalArgumentException { dfs = new DecimalFormatSymbols(locale); int ePos=0; ConversionSpecification sFmt=null; String unCS = this.nonControl(fmtArg,0); if (unCS!=null) { sFmt = new ConversionSpecification(); sFmt.setLiteral(unCS); vFmt.addElement(sFmt); } while(cPos!=-1 && cPosstart
and ending at either the end * of the String s, the next unpaired * percent sign, or at the end of the String if the * last character is a percent sign. * @param s Control string. * @param start Position in the string * s to begin looking for the start * of a control string. * @return the substring from the start position * to the beginning of the control string. */ private String nonControl(String s,int start) { String ret=""; cPos=s.indexOf("%",start); if (cPos==-1) cPos=s.length(); return s.substring(start,cPos); } /** * Format an array of objects. Byte, Short, * Integer, Long, Float, Double, and Character * arguments are treated as wrappers for primitive * types. * @param o The array of objects to format. * @return The formatted String. */ public String sprintf(Object[] o) { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; int i=0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); else { if (cs.isPositionalSpecification()) { i=cs.getArgumentPosition()-1; if (cs.isPositionalFieldWidth()) { int ifw=cs.getArgumentPositionForFieldWidth()-1; cs.setFieldWidthWithArg(((Integer)o[ifw]).intValue()); } if (cs.isPositionalPrecision()) { int ipr=cs.getArgumentPositionForPrecision()-1; cs.setPrecisionWithArg(((Integer)o[ipr]).intValue()); } } else { if (cs.isVariableFieldWidth()) { cs.setFieldWidthWithArg(((Integer)o[i]).intValue()); i++; } if (cs.isVariablePrecision()) { cs.setPrecisionWithArg(((Integer)o[i]).intValue()); i++; } } if (o[i] instanceof Byte) sb.append(cs.internalsprintf( ((Byte)o[i]).byteValue())); else if (o[i] instanceof Short) sb.append(cs.internalsprintf( ((Short)o[i]).shortValue())); else if (o[i] instanceof Integer) sb.append(cs.internalsprintf( ((Integer)o[i]).intValue())); else if (o[i] instanceof Long) sb.append(cs.internalsprintf( ((Long)o[i]).longValue())); else if (o[i] instanceof Float) sb.append(cs.internalsprintf( ((Float)o[i]).floatValue())); else if (o[i] instanceof Double) sb.append(cs.internalsprintf( ((Double)o[i]).doubleValue())); else if (o[i] instanceof Character) sb.append(cs.internalsprintf( ((Character)o[i]).charValue())); else if (o[i] instanceof String) sb.append(cs.internalsprintf( (String)o[i])); else sb.append(cs.internalsprintf( o[i])); if (!cs.isPositionalSpecification()) i++; } } return sb.toString(); } /** * Format nothing. Just use the control string. * @return the formatted String. */ public String sprintf() { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); } return sb.toString(); } /** * Format an int. * @param x The int to format. * @return The formatted String. * @exception IllegalArgumentException if the * conversion character is f, e, E, g, G, s, * or S. */ public String sprintf(int x) throws IllegalArgumentException { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); else sb.append(cs.internalsprintf(x)); } return sb.toString(); } /** * Format an long. * @param x The long to format. * @return The formatted String. * @exception IllegalArgumentException if the * conversion character is f, e, E, g, G, s, * or S. */ public String sprintf(long x) throws IllegalArgumentException { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); else sb.append(cs.internalsprintf(x)); } return sb.toString(); } /** * Format a double. * @param x The double to format. * @return The formatted String. * @exception IllegalArgumentException if the * conversion character is c, C, s, S, * d, d, x, X, or o. */ public String sprintf(double x) throws IllegalArgumentException { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); else sb.append(cs.internalsprintf(x)); } return sb.toString(); } /** * Format a String. * @param x The String to format. * @return The formatted String. * @exception IllegalArgumentException if the * conversion character is neither s nor S. */ public String sprintf(String x) throws IllegalArgumentException { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); else sb.append(cs.internalsprintf(x)); } return sb.toString(); } /** * Format an Object. Convert wrapper types to * their primitive equivalents and call the * appropriate internal formatting method. Convert * Strings using an internal formatting method for * Strings. Otherwise use the default formatter * (use toString). * @param x the Object to format. * @return the formatted String. * @exception IllegalArgumentException if the * conversion character is inappropriate for * formatting an unwrapped value. */ public String sprintf(Object x) throws IllegalArgumentException { Enumeration e = vFmt.elements(); ConversionSpecification cs = null; char c = 0; StringBuffer sb=new StringBuffer(); while (e.hasMoreElements()) { cs = (ConversionSpecification) e.nextElement(); c = cs.getConversionCharacter(); if (c=='\0') sb.append(cs.getLiteral()); else if (c=='%') sb.append("%"); else { if (x instanceof Byte) sb.append(cs.internalsprintf( ((Byte)x).byteValue())); else if (x instanceof Short) sb.append(cs.internalsprintf( ((Short)x).shortValue())); else if (x instanceof Integer) sb.append(cs.internalsprintf( ((Integer)x).intValue())); else if (x instanceof Long) sb.append(cs.internalsprintf( ((Long)x).longValue())); else if (x instanceof Float) sb.append(cs.internalsprintf( ((Float)x).floatValue())); else if (x instanceof Double) sb.append(cs.internalsprintf( ((Double)x).doubleValue())); else if (x instanceof Character) sb.append(cs.internalsprintf( ((Character)x).charValue())); else if (x instanceof String) sb.append(cs.internalsprintf( (String)x)); else sb.append(cs.internalsprintf(x)); } } return sb.toString(); } /** *

* ConversionSpecification allows the formatting of * a single primitive or object embedded within a * string. The formatting is controlled by a * format string. Only one Java primitive or * object can be formatted at a time. *

* A format string is a Java string that contains * a control string. The control string starts at * the first percent sign (%) in the string, * provided that this percent sign *

    *
  1. is not escaped protected by a matching % or * is not an escape % character, *
  2. is not at the end of the format string, and *
  3. precedes a sequence of characters that parses * as a valid control string. *
*

* A control string takes the form: *

 % ['-+ #0]* [0..9]* { . [0..9]* }+
   *                { [hlL] }+ [idfgGoxXeEcs]
   *
*

* The behavior is like printf. One (hopefully the * only) exception is that the minimum number of * exponent digits is 3 instead of 2 for e and E * formats when the optional L is used before the * e, E, g, or G conversion character. The * optional L does not imply conversion to a long * long double. */ private class ConversionSpecification { /** * Constructor. Used to prepare an instance * to hold a literal, not a control string. */ ConversionSpecification() { } /** * Constructor for a conversion specification. * The argument must begin with a % and end * with the conversion character for the * conversion specification. * @param fmtArg String specifying the * conversion specification. * @exception IllegalArgumentException if the * input string is null, zero length, or * otherwise malformed. */ ConversionSpecification(String fmtArg) throws IllegalArgumentException { if (fmtArg==null) throw new NullPointerException(); if (fmtArg.length()==0) throw new IllegalArgumentException( "Control strings must have positive"+ " lengths."); if (fmtArg.charAt(0)=='%') { fmt = fmtArg; pos=1; setArgPosition(); setFlagCharacters(); setFieldWidth(); setPrecision(); setOptionalHL(); if (setConversionCharacter()) { if (pos==fmtArg.length()) { if(leadingZeros&&leftJustify) leadingZeros=false; if(precisionSet&&leadingZeros){ if(conversionCharacter=='d' ||conversionCharacter=='i' ||conversionCharacter=='o' ||conversionCharacter=='x') { leadingZeros=false; } } } else throw new IllegalArgumentException( "Malformed conversion specification="+ fmtArg); } else throw new IllegalArgumentException( "Malformed conversion specification="+ fmtArg); } else throw new IllegalArgumentException( "Control strings must begin with %."); } /** * Set the String for this instance. * @param s the String to store. */ void setLiteral(String s) { fmt = s; } /** * Get the String for this instance. Translate * any escape sequences. * * @return s the stored String. */ String getLiteral() { StringBuffer sb=new StringBuffer(); int i=0; while (itrue if the conversion * uses an * field width; otherwise * false. */ boolean isVariableFieldWidth() { return variableFieldWidth; } /** * Set the field width with an argument. A * negative field width is taken as a - flag * followed by a positive field width. * @param fw the field width. */ void setFieldWidthWithArg(int fw) { if (fw<0) leftJustify = true; fieldWidthSet = true; fieldWidth = Math.abs(fw); } /** * Check whether the specifier has a variable * precision that is going to be set by an * argument. * @return true if the conversion * uses an * precision; otherwise * false. */ boolean isVariablePrecision() { return variablePrecision; } /** * Set the precision with an argument. A * negative precision will be changed to zero. * @param pr the precision. */ void setPrecisionWithArg(int pr) { precisionSet = true; precision = Math.max(pr,0); } /** * Format an int argument using this conversion * specification. * @param s the int to format. * @return the formatted String. * @exception IllegalArgumentException if the * conversion character is f, e, E, g, or G. */ String internalsprintf(int s) throws IllegalArgumentException { String s2 = ""; switch(conversionCharacter) { case 'd': case 'i': if (optionalh) s2 = printDFormat((short)s); else if (optionall) s2 = printDFormat((long)s); else s2 = printDFormat(s); break; case 'x': case 'X': if (optionalh) s2 = printXFormat((short)s); else if (optionall) s2 = printXFormat((long)s); else s2 = printXFormat(s); break; case 'o': if (optionalh) s2 = printOFormat((short)s); else if (optionall) s2 = printOFormat((long)s); else s2 = printOFormat(s); break; case 'c': case 'C': s2 = printCFormat((char)s); break; default: throw new IllegalArgumentException( "Cannot format a int with a format using a "+ conversionCharacter+ " conversion character."); } return s2; } /** * Format a long argument using this conversion * specification. * @param s the long to format. * @return the formatted String. * @exception IllegalArgumentException if the * conversion character is f, e, E, g, or G. */ String internalsprintf(long s) throws IllegalArgumentException { String s2 = ""; switch(conversionCharacter) { case 'd': case 'i': if (optionalh) s2 = printDFormat((short)s); else if (optionall) s2 = printDFormat(s); else s2 = printDFormat((int)s); break; case 'x': case 'X': if (optionalh) s2 = printXFormat((short)s); else if (optionall) s2 = printXFormat(s); else s2 = printXFormat((int)s); break; case 'o': if (optionalh) s2 = printOFormat((short)s); else if (optionall) s2 = printOFormat(s); else s2 = printOFormat((int)s); break; case 'c': case 'C': s2 = printCFormat((char)s); break; default: throw new IllegalArgumentException( "Cannot format a long with a format using a "+ conversionCharacter+" conversion character."); } return s2; } /** * Format a double argument using this conversion * specification. * @param s the double to format. * @return the formatted String. * @exception IllegalArgumentException if the * conversion character is c, C, s, S, i, d, * x, X, or o. */ String internalsprintf(double s) throws IllegalArgumentException { String s2 = ""; switch(conversionCharacter) { case 'f': s2 = printFFormat(s); break; case 'E': case 'e': s2 = printEFormat(s); break; case 'G': case 'g': s2 = printGFormat(s); break; default: throw new IllegalArgumentException("Cannot "+ "format a double with a format using a "+ conversionCharacter+" conversion character."); } return s2; } /** * Format a String argument using this conversion * specification. * @param s the String to format. * @return the formatted String. * @exception IllegalArgumentException if the * conversion character is neither s nor S. */ String internalsprintf(String s) throws IllegalArgumentException { String s2 = ""; if(conversionCharacter=='s' || conversionCharacter=='S') s2 = printSFormat(s); else throw new IllegalArgumentException("Cannot "+ "format a String with a format using a "+ conversionCharacter+" conversion character."); return s2; } /** * Format an Object argument using this conversion * specification. * @param s the Object to format. * @return the formatted String. * @exception IllegalArgumentException if the * conversion character is neither s nor S. */ String internalsprintf(Object s) { String s2 = ""; if(conversionCharacter=='s' || conversionCharacter=='S') s2 = printSFormat(s.toString()); else throw new IllegalArgumentException( "Cannot format a String with a format using"+ " a "+conversionCharacter+ " conversion character."); return s2; } /** * For f format, the flag character '-', means that * the output should be left justified within the * field. The default is to pad with blanks on the * left. '+' character means that the conversion * will always begin with a sign (+ or -). The * blank flag character means that a non-negative * input will be preceded with a blank. If both * a '+' and a ' ' are specified, the blank flag * is ignored. The '0' flag character implies that * padding to the field width will be done with * zeros instead of blanks. * * The field width is treated as the minimum number * of characters to be printed. The default is to * add no padding. Padding is with blanks by * default. * * The precision, if set, is the number of digits * to appear after the radix character. Padding is * with trailing 0s. */ private char[] fFormatDigits(double x) { // int defaultDigits=6; String sx,sxOut; int i,j,k; int n1In,n2In; int expon=0; boolean minusSign=false; if (x>0.0) sx = Double.toString(x); else if (x<0.0) { sx = Double.toString(-x); minusSign=true; } else { sx = Double.toString(x); if (sx.charAt(0)=='-') { minusSign=true; sx=sx.substring(1); } } int ePos = sx.indexOf('E'); int rPos = sx.indexOf('.'); if (rPos!=-1) n1In=rPos; else if (ePos!=-1) n1In=ePos; else n1In=sx.length(); if (rPos!=-1) { if (ePos!=-1) n2In = ePos-rPos-1; else n2In = sx.length()-rPos-1; } else n2In = 0; if (ePos!=-1) { int ie=ePos+1; expon=0; if (sx.charAt(ie)=='-') { for (++ie; ie0) { ca6 = new char[ca5.length+nThousands+lead]; ca6[0]=ca5[0]; for (i=lead,k=lead; i0 && (dp-i)%3==0) { // ca6[k]=','; ca6[k]=dfs.getGroupingSeparator(); ca6[k+1]=ca5[i]; k+=2; } else { ca6[k]=ca5[i]; k++; } } for (; i0.0) sx = Double.toString(x); else if (x<0.0) { sx = Double.toString(-x); minusSign=true; } else { sx = Double.toString(x); if (sx.charAt(0)=='-') { minusSign=true; sx=sx.substring(1); } } ePos = sx.indexOf('E'); if (ePos==-1) ePos = sx.indexOf('e'); rPos = sx.indexOf('.'); if (rPos!=-1) n1In=rPos; else if (ePos!=-1) n1In=ePos; else n1In=sx.length(); if (rPos!=-1) { if (ePos!=-1) n2In = ePos-rPos-1; else n2In = sx.length()-rPos-1; } else n2In = 0; if (ePos!=-1) { int ie=ePos+1; expon=0; if (sx.charAt(ie)=='-') { for (++ie; ie=100) { switch(expon/100) { case 1: ca2[i]='1'; break; case 2: ca2[i]='2'; break; case 3: ca2[i]='3'; break; case 4: ca2[i]='4'; break; case 5: ca2[i]='5'; break; case 6: ca2[i]='6'; break; case 7: ca2[i]='7'; break; case 8: ca2[i]='8'; break; case 9: ca2[i]='9'; break; } i++; } switch((expon%100)/10) { case 0: ca2[i]='0'; break; case 1: ca2[i]='1'; break; case 2: ca2[i]='2'; break; case 3: ca2[i]='3'; break; case 4: ca2[i]='4'; break; case 5: ca2[i]='5'; break; case 6: ca2[i]='6'; break; case 7: ca2[i]='7'; break; case 8: ca2[i]='8'; break; case 9: ca2[i]='9'; break; } i++; switch(expon%10) { case 0: ca2[i]='0'; break; case 1: ca2[i]='1'; break; case 2: ca2[i]='2'; break; case 3: ca2[i]='3'; break; case 4: ca2[i]='4'; break; case 5: ca2[i]='5'; break; case 6: ca2[i]='6'; break; case 7: ca2[i]='7'; break; case 8: ca2[i]='8'; break; case 9: ca2[i]='9'; break; } int nZeros=0; if (!leftJustify && leadingZeros) { int xThousands=0; if (thousands) { int xlead=0; if (ca2[0]=='+'||ca2[0]=='-'||ca2[0]==' ') xlead=1; int xdp=xlead; for (; xdp0) { ca4 = new char[ca3.length+nThousands+lead]; ca4[0]=ca3[0]; for (i=lead,k=lead; i0 && (dp-i)%3==0) { // ca4[k]=','; ca4[k]=dfs.getGroupingSeparator(); ca4[k+1]=ca3[i]; k+=2; } else { ca4[k]=ca3[i]; k++; } } for (; itrue if the truncation forces * a round that will change the print */ private boolean checkForCarry(char[] ca1,int icarry) { boolean carry=false; if (icarry0) { carry=(ca1[icarry-1]=='1'||ca1[icarry-1]=='3' ||ca1[icarry-1]=='5'||ca1[icarry-1]=='7' ||ca1[icarry-1]=='9'); } } } return carry; } /** * Start the symbolic carry process. The process * is not quite finished because the symbolic * carry may change the length of the string and * change the exponent (in e format). * @param cLast index of the last digit changed * by the round * @param cFirst index of the first digit allowed * to be changed by this phase of the round * @return true if the carry forces * a round that will change the print still * more */ private boolean startSymbolicCarry( char[] ca,int cLast,int cFirst) { boolean carry=true; for (int i=cLast; carry && i>=cFirst; i--) { carry = false; switch(ca[i]) { case '0': ca[i]='1'; break; case '1': ca[i]='2'; break; case '2': ca[i]='3'; break; case '3': ca[i]='4'; break; case '4': ca[i]='5'; break; case '5': ca[i]='6'; break; case '6': ca[i]='7'; break; case '7': ca[i]='8'; break; case '8': ca[i]='9'; break; case '9': ca[i]='0'; carry=true; break; } } return carry; } /** * An intermediate routine on the way to creating * an e format String. The method decides whether * the input double value is an infinity, * not-a-number, or a finite double and formats * each type of input appropriately. * @param x the double value to be formatted. * @param eChar an 'e' or 'E' to use in the * converted double value. * @return the converted double value. */ private String eFormatString(double x,char eChar) { boolean noDigits=false; char[] ca4,ca5; if (Double.isInfinite(x)) { if (x==Double.POSITIVE_INFINITY) { if (leadingSign) ca4 = "+Inf".toCharArray(); else if (leadingSpace) ca4 = " Inf".toCharArray(); else ca4 = "Inf".toCharArray(); } else ca4 = "-Inf".toCharArray(); noDigits = true; } else if (Double.isNaN(x)) { if (leadingSign) ca4 = "+NaN".toCharArray(); else if (leadingSpace) ca4 = " NaN".toCharArray(); else ca4 = "NaN".toCharArray(); noDigits = true; } else ca4 = eFormatDigits(x,eChar); ca5 = applyFloatPadding(ca4,false); return new String(ca5); } /** * Apply zero or blank, left or right padding. * @param ca4 array of characters before padding is * finished * @param noDigits NaN or signed Inf * @return a padded array of characters */ private char[] applyFloatPadding( char[] ca4,boolean noDigits) { char[] ca5 = ca4; if (fieldWidthSet) { int i,j,nBlanks; if (leftJustify) { nBlanks = fieldWidth-ca4.length; if (nBlanks > 0) { ca5 = new char[ca4.length+nBlanks]; for (i=0; i 0) { ca5 = new char[ca4.length+nBlanks]; for (i=0; i 0) { ca5 = new char[ca4.length+nBlanks]; i=0; j=0; if (ca4[0]=='-') { ca5[0]='-'; i++; j++; } for (int k=0; k=-4 && expon=0; i--) if (sy.charAt(i)!='0') break; if (i>=0 && sy.charAt(i)=='.') i--; if (i==-1) sz="0"; else if (!Character.isDigit(sy.charAt(i))) sz=sy.substring(0,i+1)+"0"; else sz=sy.substring(0,i+1); if (expon>=-4 && expon=-4 && expon=0) ret = " "+ret; ca4 = ret.toCharArray(); } // Pad with blanks or zeros. ca5 = applyFloatPadding(ca4,false); precision=savePrecision; return new String(ca5); } /** * Format method for the d conversion specifer and * short argument. * * For d format, the flag character '-', means that * the output should be left justified within the * field. The default is to pad with blanks on the * left. A '+' character means that the conversion * will always begin with a sign (+ or -). The * blank flag character means that a non-negative * input will be preceded with a blank. If both a * '+' and a ' ' are specified, the blank flag is * ignored. The '0' flag character implies that * padding to the field width will be done with * zeros instead of blanks. * * The field width is treated as the minimum number * of characters to be printed. The default is to * add no padding. Padding is with blanks by * default. * * The precision, if set, is the minimum number of * digits to appear. Padding is with leading 0s. * @param x the short to format. * @return the formatted String. */ private String printDFormat(short x) { return printDFormat(Short.toString(x)); } /** * Format method for the d conversion character and * long argument. * * For d format, the flag character '-', means that * the output should be left justified within the * field. The default is to pad with blanks on the * left. A '+' character means that the conversion * will always begin with a sign (+ or -). The * blank flag character means that a non-negative * input will be preceded with a blank. If both a * '+' and a ' ' are specified, the blank flag is * ignored. The '0' flag character implies that * padding to the field width will be done with * zeros instead of blanks. * * The field width is treated as the minimum number * of characters to be printed. The default is to * add no padding. Padding is with blanks by * default. * * The precision, if set, is the minimum number of * digits to appear. Padding is with leading 0s. * @param x the long to format. * @return the formatted String. */ private String printDFormat(long x) { return printDFormat(Long.toString(x)); } /** * Format method for the d conversion character and * int argument. * * For d format, the flag character '-', means that * the output should be left justified within the * field. The default is to pad with blanks on the * left. A '+' character means that the conversion * will always begin with a sign (+ or -). The * blank flag character means that a non-negative * input will be preceded with a blank. If both a * '+' and a ' ' are specified, the blank flag is * ignored. The '0' flag character implies that * padding to the field width will be done with * zeros instead of blanks. * * The field width is treated as the minimum number * of characters to be printed. The default is to * add no padding. Padding is with blanks by * default. * * The precision, if set, is the minimum number of * digits to appear. Padding is with leading 0s. * @param x the int to format. * @return the formatted String. */ private String printDFormat(int x) { return printDFormat(Integer.toString(x)); } /** * Utility method for formatting using the d * conversion character. * @param sx the String to format, the result of * converting a short, int, or long to a * String. * @return the formatted String. */ private String printDFormat(String sx) { int nLeadingZeros=0; int nBlanks=0,n=0; int i=0,jFirst=0; boolean neg = sx.charAt(0)=='-'; if (sx.equals("0")&&precisionSet&&precision==0) sx=""; if (!neg) { if (precisionSet && sx.length() < precision) nLeadingZeros = precision-sx.length(); } else { if (precisionSet&&(sx.length()-1)precision) nPrint=precision; if (!fieldWidthSet) width = nPrint; int n=0; if (width>nPrint) n+=width-nPrint; if (nPrint>=x.length()) n+= x.length(); else n+= nPrint; char[] ca = new char[n]; int i=0; if (leftJustify) { if (nPrint>=x.length()) { char[] csx = x.toCharArray(); for (i=0; i=x.length()) { char[] csx = x.toCharArray(); for (int j=0; jtrue if the conversion * character is there, and * false otherwise. */ private boolean setConversionCharacter() { /* idfgGoxXeEcs */ boolean ret = false; conversionCharacter='\0'; if (pos < fmt.length()) { char c = fmt.charAt(pos); if (c=='i'||c=='d'||c=='f'||c=='g'||c=='G' || c=='o' || c=='x' || c=='X' || c=='e' || c=='E' || c=='c' || c=='s' || c=='%') { conversionCharacter = c; pos++; ret = true; } } return ret; } /** * Check for an h, l, or L in a format. An L is * used to control the minimum number of digits * in an exponent when using floating point * formats. An l or h is used to control * conversion of the input to a long or short, * respectively, before formatting. If any of * these is present, store them. */ private void setOptionalHL() { optionalh=false; optionall=false; optionalL=false; if (pos < fmt.length()) { char c = fmt.charAt(pos); if (c=='h') { optionalh=true; pos++; } else if (c=='l') { optionall=true; pos++; } else if (c=='L') { optionalL=true; pos++; } } } /** * Set the precision. */ private void setPrecision() { int firstPos = pos; precisionSet = false; if (pos firstPos+1) { String sz = fmt.substring(firstPos+1,pos); precision = Integer.parseInt(sz); precisionSet = true; } } } } /** * Set the field width. */ private void setFieldWidth() { int firstPos = pos; fieldWidth = 0; fieldWidthSet = false; if ((pos < fmt.length()) && (fmt.charAt(pos)=='*')) { pos++; if (!setFieldWidthArgPosition()) { variableFieldWidth = true; fieldWidthSet = true; } } else { while (pos < fmt.length()) { char c = fmt.charAt(pos); if (Character.isDigit(c)) pos++; else break; } if (firstPosn in %n$ forms. */ private void setArgPosition() { int xPos; for (xPos=pos; xPospos && xPosn in *n$ forms. */ private boolean setFieldWidthArgPosition() { boolean ret=false; int xPos; for (xPos=pos; xPospos && xPosn in *n$ forms. */ private boolean setPrecisionArgPosition() { boolean ret=false; int xPos; for (xPos=pos; xPospos && xPos. # # Copyright (C) 2003 Free Software Foundation, Inc. # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2 { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2 { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH # Name of the host. # hostname on some systems (SVR3.2, Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` exec 6>&1 # # Initializations. # ac_default_prefix=/usr/local ac_config_libobj_dir=. cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= SHELL=${CONFIG_SHELL-/bin/sh} # Maximum number of lines to put in a shell here document. # This variable seems obsolete. It should probably be removed, and # only ac_max_sed_lines should be used. : ${ac_max_here_lines=38} # Identity of this package. PACKAGE_NAME='f2j' PACKAGE_TARNAME='f2j' PACKAGE_VERSION='0.8.1' PACKAGE_STRING='f2j 0.8.1' PACKAGE_BUGREPORT='f2j@cs.utk.edu' ac_unique_file="f2j_TODO.txt" ac_subdirs_all="$ac_subdirs_all libbytecode" ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS F2J_INSTALL_PREFIX subdirs CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT SET_MAKE RANLIB ac_ct_RANLIB AR JAVAC JAVA YACC F2J_VERSION BYTE_DIR F2J_PACKAGE_STRING LIBOBJS LTLIBOBJS' ac_subst_files='' # Initialize some variables set by options. ac_init_help= ac_init_version=false # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datadir='${prefix}/share' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' libdir='${exec_prefix}/lib' includedir='${prefix}/include' oldincludedir='/usr/include' infodir='${prefix}/info' mandir='${prefix}/man' ac_prev= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval "$ac_prev=\$ac_option" ac_prev= continue fi ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'` # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_option in -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad | --data | --dat | --da) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \ | --da=*) datadir=$ac_optarg ;; -disable-* | --disable-*) ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` eval "enable_$ac_feature=no" ;; -enable-* | --enable-*) ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid feature name: $ac_feature" >&2 { (exit 1); exit 1; }; } ac_feature=`echo $ac_feature | sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "enable_$ac_feature='$ac_optarg'" ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst \ | --locals | --local | --loca | --loc | --lo) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* \ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package| sed 's/-/_/g'` case $ac_option in *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;; *) ac_optarg=yes ;; esac eval "with_$ac_package='$ac_optarg'" ;; -without-* | --without-*) ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid package name: $ac_package" >&2 { (exit 1); exit 1; }; } ac_package=`echo $ac_package | sed 's/-/_/g'` eval "with_$ac_package=no" ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) { echo "$as_me: error: unrecognized option: $ac_option Try \`$0 --help' for more information." >&2 { (exit 1); exit 1; }; } ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null && { echo "$as_me: error: invalid variable name: $ac_envvar" >&2 { (exit 1); exit 1; }; } ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` eval "$ac_envvar='$ac_optarg'" export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` { echo "$as_me: error: missing argument to $ac_option" >&2 { (exit 1); exit 1; }; } fi # Be sure to have absolute paths. for ac_var in exec_prefix prefix do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* | NONE | '' ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # Be sure to have absolute paths. for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \ localstatedir libdir includedir oldincludedir infodir mandir do eval ac_val=$`echo $ac_var` case $ac_val in [\\/$]* | ?:[\\/]* ) ;; *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2 { (exit 1); exit 1; }; };; esac done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host. If a cross compiler is detected then cross compile mode will be used." >&2 elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then its parent. ac_confdir=`(dirname "$0") 2>/dev/null || $as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$0" : 'X\(//\)[^/]' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$0" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` srcdir=$ac_confdir if test ! -r $srcdir/$ac_unique_file; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r $srcdir/$ac_unique_file; then if test "$ac_srcdir_defaulted" = yes; then { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2 { (exit 1); exit 1; }; } else { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2 { (exit 1); exit 1; }; } fi fi (cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null || { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2 { (exit 1); exit 1; }; } srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'` ac_env_build_alias_set=${build_alias+set} ac_env_build_alias_value=$build_alias ac_cv_env_build_alias_set=${build_alias+set} ac_cv_env_build_alias_value=$build_alias ac_env_host_alias_set=${host_alias+set} ac_env_host_alias_value=$host_alias ac_cv_env_host_alias_set=${host_alias+set} ac_cv_env_host_alias_value=$host_alias ac_env_target_alias_set=${target_alias+set} ac_env_target_alias_value=$target_alias ac_cv_env_target_alias_set=${target_alias+set} ac_cv_env_target_alias_value=$target_alias ac_env_CC_set=${CC+set} ac_env_CC_value=$CC ac_cv_env_CC_set=${CC+set} ac_cv_env_CC_value=$CC ac_env_CFLAGS_set=${CFLAGS+set} ac_env_CFLAGS_value=$CFLAGS ac_cv_env_CFLAGS_set=${CFLAGS+set} ac_cv_env_CFLAGS_value=$CFLAGS ac_env_LDFLAGS_set=${LDFLAGS+set} ac_env_LDFLAGS_value=$LDFLAGS ac_cv_env_LDFLAGS_set=${LDFLAGS+set} ac_cv_env_LDFLAGS_value=$LDFLAGS ac_env_CPPFLAGS_set=${CPPFLAGS+set} ac_env_CPPFLAGS_value=$CPPFLAGS ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set} ac_cv_env_CPPFLAGS_value=$CPPFLAGS # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures f2j 0.8.1 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] _ACEOF cat <<_ACEOF Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --datadir=DIR read-only architecture-independent data [PREFIX/share] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --infodir=DIR info documentation [PREFIX/info] --mandir=DIR man documentation [PREFIX/man] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then case $ac_init_help in short | recursive ) echo "Configuration of f2j 0.8.1:";; esac cat <<\_ACEOF Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-libbytecode-dir=dir directory containing bytecode library Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory CPPFLAGS C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to . _ACEOF fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. ac_popdir=`pwd` for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d $ac_dir || continue ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then echo $SHELL $ac_srcdir/configure.gnu --help=recursive elif test -f $ac_srcdir/configure; then echo $SHELL $ac_srcdir/configure --help=recursive elif test -f $ac_srcdir/configure.ac || test -f $ac_srcdir/configure.in; then echo $ac_configure --help else echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi cd $ac_popdir done fi test -n "$ac_init_help" && exit 0 if $ac_init_version; then cat <<\_ACEOF f2j configure 0.8.1 generated by GNU Autoconf 2.59 Copyright (C) 2003 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit 0 fi exec 5>config.log cat >&5 <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by f2j $as_me 0.8.1, which was generated by GNU Autoconf 2.59. Invocation command line was $ $0 $@ _ACEOF { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` hostinfo = `(hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. echo "PATH: $as_dir" done } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_sep= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;; 2) ac_configure_args1="$ac_configure_args1 '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'" # Get rid of the leading space. ac_sep=" " ;; esac done done $as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; } $as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; } # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Be sure not to use single quotes in there, as some shells, # such as our DU 5.0 friend, will then `close' the trap. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo cat <<\_ASBOX ## ---------------- ## ## Cache variables. ## ## ---------------- ## _ASBOX echo # The following way of writing the cache mishandles newlines in values, { (set) 2>&1 | case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in *ac_space=\ *) sed -n \ "s/'"'"'/'"'"'\\\\'"'"''"'"'/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p" ;; *) sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } echo cat <<\_ASBOX ## ----------------- ## ## Output variables. ## ## ----------------- ## _ASBOX echo for ac_var in $ac_subst_vars do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo if test -n "$ac_subst_files"; then cat <<\_ASBOX ## ------------- ## ## Output files. ## ## ------------- ## _ASBOX echo for ac_var in $ac_subst_files do eval ac_val=$`echo $ac_var` echo "$ac_var='"'"'$ac_val'"'"'" done | sort echo fi if test -s confdefs.h; then cat <<\_ASBOX ## ----------- ## ## confdefs.h. ## ## ----------- ## _ASBOX echo sed "/^$/d" confdefs.h | sort echo fi test "$ac_signal" != 0 && echo "$as_me: caught signal $ac_signal" echo "$as_me: exit $exit_status" } >&5 rm -f core *.core && rm -rf conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -rf conftest* confdefs.h # AIX cpp loses on an empty file, so make sure it contains at least a newline. echo >confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer explicitly selected file to automatically selected ones. if test -z "$CONFIG_SITE"; then if test "x$prefix" != xNONE; then CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site" else CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site" fi fi for ac_site_file in $CONFIG_SITE; do if test -r "$ac_site_file"; then { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5 echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special # files actually), so we avoid doing that. if test -f "$cache_file"; then { echo "$as_me:$LINENO: loading cache $cache_file" >&5 echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . $cache_file;; *) . ./$cache_file;; esac fi else { echo "$as_me:$LINENO: creating cache $cache_file" >&5 echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in `(set) 2>&1 | sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val="\$ac_cv_env_${ac_var}_value" eval ac_new_val="\$ac_env_${ac_var}_value" case $ac_old_set,$ac_new_set in set,) { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5 echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5 echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} { echo "$as_me:$LINENO: former value: $ac_old_val" >&5 echo "$as_me: former value: $ac_old_val" >&2;} { echo "$as_me:$LINENO: current value: $ac_new_val" >&5 echo "$as_me: current value: $ac_new_val" >&2;} ac_cache_corrupted=: fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*) ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) ac_configure_args="$ac_configure_args '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5 echo "$as_me: error: changes in the environment can compromise the build" >&2;} { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5 echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;} { (exit 1); exit 1; }; } fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test "x$prefix" != xNONE; then F2J_INSTALL_PREFIX=${prefix} else F2J_INSTALL_PREFIX=`pwd` fi prefix=$F2J_INSTALL_PREFIX ac_aux_dir= for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do if test -f $ac_dir/install-sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install-sh -c" break elif test -f $ac_dir/install.sh; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/install.sh -c" break elif test -f $ac_dir/shtool; then ac_aux_dir=$ac_dir ac_install_sh="$ac_aux_dir/shtool install -c" break fi done if test -z "$ac_aux_dir"; then { { echo "$as_me:$LINENO: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&5 echo "$as_me: error: cannot find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." >&2;} { (exit 1); exit 1; }; } fi ac_config_guess="$SHELL $ac_aux_dir/config.guess" ac_config_sub="$SHELL $ac_aux_dir/config.sub" ac_configure="$SHELL $ac_aux_dir/configure" # This should be Cygnus configure. subdirs="$subdirs libbytecode" ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then for ac_prog in gcc cc ecc xlc do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then echo "$as_me:$LINENO: result: $CC" >&5 echo "${ECHO_T}$CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in gcc cc ecc xlc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_CC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then echo "$as_me:$LINENO: result: $ac_ct_CC" >&5 echo "${ECHO_T}$ac_ct_CC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$ac_ct_CC" && break done CC=$ac_ct_CC fi test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&5 echo "$as_me: error: no acceptable C compiler found in \$PATH See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } # Provide some information about the compiler. echo "$as_me:$LINENO:" \ "checking for C compiler version" >&5 ac_compiler=`set X $ac_compile; echo $2` { (eval echo "$as_me:$LINENO: \"$ac_compiler --version &5\"") >&5 (eval $ac_compiler --version &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -v &5\"") >&5 (eval $ac_compiler -v &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } { (eval echo "$as_me:$LINENO: \"$ac_compiler -V &5\"") >&5 (eval $ac_compiler -V &5) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. echo "$as_me:$LINENO: checking for C compiler default output file name" >&5 echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6 ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5 (eval $ac_link_default) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # Find the output, starting from the most likely. This scheme is # not robust to junk in `.', hence go to wildcards (a.*) only as a last # resort. # Be careful to initialize this variable, since it used to be cached. # Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile. ac_cv_exeext= # b.out is created by i960 compilers. for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; conftest.$ac_ext ) # This is the source file. ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` # FIXME: I believe we export ac_cv_exeext for Libtool, # but it would be cool to find out if it's true. Does anybody # maintain Libtool? --akim. export ac_cv_exeext break;; * ) break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: C compiler cannot create executables See \`config.log' for more details." >&5 echo "$as_me: error: C compiler cannot create executables See \`config.log' for more details." >&2;} { (exit 77); exit 77; }; } fi ac_exeext=$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_file" >&5 echo "${ECHO_T}$ac_file" >&6 # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether the C compiler works" >&5 echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6 # FIXME: These cross compiler hacks should be removed for Autoconf 3.0 # If not cross compiling, check that we can run a simple program. if test "$cross_compiling" != yes; then if { ac_try='./$ac_file' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { echo "$as_me:$LINENO: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&5 echo "$as_me: error: cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi fi fi echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 rm -f a.out a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save # Check the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. echo "$as_me:$LINENO: checking whether we are cross compiling" >&5 echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6 echo "$as_me:$LINENO: result: $cross_compiling" >&5 echo "${ECHO_T}$cross_compiling" >&6 echo "$as_me:$LINENO: checking for suffix of executables" >&5 echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6 if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` export ac_cv_exeext break;; * ) break;; esac done else { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of executables: cannot compile and link See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest$ac_cv_exeext echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5 echo "${ECHO_T}$ac_cv_exeext" >&6 rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT echo "$as_me:$LINENO: checking for suffix of object files" >&5 echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6 if test "${ac_cv_objext+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; then for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&5 echo "$as_me: error: cannot compute suffix of object files: cannot compile See \`config.log' for more details." >&2;} { (exit 1); exit 1; }; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_objext" >&5 echo "${ECHO_T}$ac_cv_objext" >&6 OBJEXT=$ac_cv_objext ac_objext=$OBJEXT echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5 echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6 if test "${ac_cv_c_compiler_gnu+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_compiler_gnu=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_compiler_gnu=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5 echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6 GCC=`test $ac_compiler_gnu = yes && echo yes` ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS CFLAGS="-g" echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5 echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6 if test "${ac_cv_prog_cc_g+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_g=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_prog_cc_g=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5 echo "${ECHO_T}$ac_cv_prog_cc_g" >&6 if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5 echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6 if test "${ac_cv_prog_cc_stdc+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else ac_cv_prog_cc_stdc=no ac_save_CC=$CC cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include #include #include /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std1 is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std1. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF # Don't try gcc -ansi; that turns off useful extensions and # breaks some systems' header files. # AIX -qlanglvl=ansi # Ultrix and OSF/1 -std1 # HP-UX 10.20 and later -Ae # HP-UX older versions -Aa -D_HPUX_SOURCE # SVR4 -Xc -D__EXTENSIONS__ for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_prog_cc_stdc=$ac_arg break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext done rm -f conftest.$ac_ext conftest.$ac_objext CC=$ac_save_CC fi case "x$ac_cv_prog_cc_stdc" in x|xno) echo "$as_me:$LINENO: result: none needed" >&5 echo "${ECHO_T}none needed" >&6 ;; *) echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5 echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6 CC="$CC $ac_cv_prog_cc_stdc" ;; esac # Some people use a C++ compiler to compile C. Since we use `exit', # in C++ we need to declare it. In case someone uses the same compiler # for both compiling C and C++ we need to have the C++ compiler decide # the declaration of exit, since it's the most demanding environment. cat >conftest.$ac_ext <<_ACEOF #ifndef __cplusplus choke me #endif _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then for ac_declaration in \ '' \ 'extern "C" void std::exit (int) throw (); using std::exit;' \ 'extern "C" void std::exit (int); using std::exit;' \ 'extern "C" void exit (int) throw ();' \ 'extern "C" void exit (int);' \ 'void exit (int);' do cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration #include int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then : else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 continue fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ $ac_declaration int main () { exit (42); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then break else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext done rm -f conftest* if test -n "$ac_declaration"; then echo '#ifdef __cplusplus' >>confdefs.h echo $ac_declaration >>confdefs.h echo '#endif' >>confdefs.h fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5 echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6 if test "${ac_cv_c_bigendian+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else # See if sys/param.h defines the BYTE_ORDER macro. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN bogus endian macros #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then # It does; now see whether it defined to BIG_ENDIAN or not. cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ #include #include int main () { #if BYTE_ORDER != BIG_ENDIAN not big endian #endif ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=yes else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_cv_c_bigendian=no fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 # It does not; compile a test program. if test "$cross_compiling" = yes; then # try to guess the endianness by grepping values into an object file ac_cv_c_bigendian=unknown cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; } short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; } int main () { _ascii (); _ebcdic (); ; return 0; } _ACEOF rm -f conftest.$ac_objext if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5 (eval $ac_compile) 2>conftest.er1 ac_status=$? grep -v '^ *+' conftest.er1 >conftest.err rm -f conftest.er1 cat conftest.err >&5 echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='test -z "$ac_c_werror_flag" || test ! -s conftest.err' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; } && { ac_try='test -s conftest.$ac_objext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then ac_cv_c_bigendian=yes fi if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then if test "$ac_cv_c_bigendian" = unknown; then ac_cv_c_bigendian=no else # finding both strings is unlikely to happen, but who knows? ac_cv_c_bigendian=unknown fi fi else echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext else cat >conftest.$ac_ext <<_ACEOF /* confdefs.h. */ _ACEOF cat confdefs.h >>conftest.$ac_ext cat >>conftest.$ac_ext <<_ACEOF /* end confdefs.h. */ int main () { /* Are we little or big endian? From Harbison&Steele. */ union { long l; char c[sizeof (long)]; } u; u.l = 1; exit (u.c[sizeof (long) - 1] == 1); } _ACEOF rm -f conftest$ac_exeext if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5 (eval $ac_link) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); } && { ac_try='./conftest$ac_exeext' { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5 (eval $ac_try) 2>&5 ac_status=$? echo "$as_me:$LINENO: \$? = $ac_status" >&5 (exit $ac_status); }; }; then ac_cv_c_bigendian=no else echo "$as_me: program exited with status $ac_status" >&5 echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ( exit $ac_status ) ac_cv_c_bigendian=yes fi rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext fi fi rm -f conftest.err conftest.$ac_objext conftest.$ac_ext fi echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5 echo "${ECHO_T}$ac_cv_c_bigendian" >&6 case $ac_cv_c_bigendian in yes) cat >>confdefs.h <<\_ACEOF #define WORDS_BIGENDIAN 1 _ACEOF ;; no) ;; *) { { echo "$as_me:$LINENO: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&5 echo "$as_me: error: unknown endianness presetting ac_cv_c_bigendian=no (or yes) will help" >&2;} { (exit 1); exit 1; }; } ;; esac echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5 echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'` if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then echo $ECHO_N "(cached) $ECHO_C" >&6 else cat >conftest.make <<\_ACEOF all: @echo 'ac_maketemp="$(MAKE)"' _ACEOF # GNU make sometimes prints "make[1]: Entering...", which would confuse us. eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=` if test -n "$ac_maketemp"; then eval ac_cv_prog_make_${ac_make}_set=yes else eval ac_cv_prog_make_${ac_make}_set=no fi rm -f conftest.make fi if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then echo "$as_me:$LINENO: result: yes" >&5 echo "${ECHO_T}yes" >&6 SET_MAKE= else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 SET_MAKE="MAKE=${MAKE-make}" fi if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then echo "$as_me:$LINENO: result: $RANLIB" >&5 echo "${ECHO_T}$RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":" fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5 echo "${ECHO_T}$ac_ct_RANLIB" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi RANLIB=$ac_ct_RANLIB else RANLIB="$ac_cv_prog_RANLIB" fi # Extract the first word of "ar", so it can be a program name with args. set dummy ar; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_AR+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $AR in [\\/]* | ?:[\\/]*) ac_cv_path_AR="$AR" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_AR="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi AR=$ac_cv_path_AR if test -n "$AR"; then echo "$as_me:$LINENO: result: $AR" >&5 echo "${ECHO_T}$AR" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Extract the first word of "javac", so it can be a program name with args. set dummy javac; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_JAVAC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $JAVAC in [\\/]* | ?:[\\/]*) ac_cv_path_JAVAC="$JAVAC" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_JAVAC="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi JAVAC=$ac_cv_path_JAVAC if test -n "$JAVAC"; then echo "$as_me:$LINENO: result: $JAVAC" >&5 echo "${ECHO_T}$JAVAC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi # Extract the first word of "java", so it can be a program name with args. set dummy java; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_path_JAVA+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else case $JAVA in [\\/]* | ?:[\\/]*) ac_cv_path_JAVA="$JAVA" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_JAVA="$as_dir/$ac_word$ac_exec_ext" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done ;; esac fi JAVA=$ac_cv_path_JAVA if test -n "$JAVA"; then echo "$as_me:$LINENO: result: $JAVA" >&5 echo "${ECHO_T}$JAVA" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi for ac_prog in 'bison -y' byacc do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo "$as_me:$LINENO: checking for $ac_word" >&5 echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6 if test "${ac_cv_prog_YACC+set}" = set; then echo $ECHO_N "(cached) $ECHO_C" >&6 else if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_YACC="$ac_prog" echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done fi fi YACC=$ac_cv_prog_YACC if test -n "$YACC"; then echo "$as_me:$LINENO: result: $YACC" >&5 echo "${ECHO_T}$YACC" >&6 else echo "$as_me:$LINENO: result: no" >&5 echo "${ECHO_T}no" >&6 fi test -n "$YACC" && break done test -n "$YACC" || YACC="yacc" F2J_VERSION=0.8.1 # Check whether --with-libbytecode-dir or --without-libbytecode-dir was given. if test "${with_libbytecode_dir+set}" = set; then withval="$with_libbytecode_dir" BYTE_DIR="$with_libbytecode_dir" else BYTE_DIR="$PWD/libbytecode" fi; F2J_PACKAGE_STRING=f2j-0.8.1 ac_config_files="$ac_config_files Makefile src/make.def goto_trans/make.def util/make.def" ac_config_files="$ac_config_files src/f2j-config.h" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, don't put newlines in cache variables' values. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. { (set) 2>&1 | case `(ac_space=' '; set | grep ac_space) 2>&1` in *ac_space=\ *) # `set' does not quote correctly, so add quotes (double-quote # substitution turns \\\\ into \\, and sed turns \\ into \). sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n \ "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p" ;; esac; } | sed ' t clear : clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ : end' >>confcache if diff $cache_file confcache >/dev/null 2>&1; then :; else if test -w $cache_file; then test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file" cat confcache >$cache_file else echo "not updating unwritable cache $cache_file" fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # VPATH may cause trouble with some makes, so we remove $(srcdir), # ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=/{ s/:*\$(srcdir):*/:/; s/:*\${srcdir}:*/:/; s/:*@srcdir@:*/:/; s/^\([^=]*=[ ]*\):*/\1/; s/:*$//; s/^[^=]*=[ ]*$//; }' fi # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then we branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. cat >confdef2opt.sed <<\_ACEOF t clear : clear s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g t quote s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g t quote d : quote s,[ `~#$^&*(){}\\|;'"<>?],\\&,g s,\[,\\&,g s,\],\\&,g s,\$,$$,g p _ACEOF # We use echo to avoid assuming a particular line-breaking character. # The extra dot is to prevent the shell from consuming trailing # line-breaks from the sub-command output. A line-break within # single-quotes doesn't work because, if this script is created in a # platform that uses two characters for line-breaks (e.g., DOS), tr # would break. ac_LF_and_DOT=`echo; echo .` DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'` rm -f confdef2opt.sed ac_libobjs= ac_ltlibobjs= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_i=`echo "$ac_i" | sed 's/\$U\././;s/\.o$//;s/\.obj$//'` # 2. Add them. ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext" ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : ${CONFIG_STATUS=./config.status} ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5 echo "$as_me: creating $CONFIG_STATUS" >&6;} cat >$CONFIG_STATUS <<_ACEOF #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF ## --------------------- ## ## M4sh Initialization. ## ## --------------------- ## # Be Bourne compatible if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then emulate sh NULLCMD=: # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then set -o posix fi DUALCASE=1; export DUALCASE # for MKS sh # Support unset when possible. if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then as_unset=unset else as_unset=false fi # Work around bugs in pre-3.0 UWIN ksh. $as_unset ENV MAIL MAILPATH PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. for as_var in \ LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \ LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \ LC_TELEPHONE LC_TIME do if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then eval $as_var=C; export $as_var else $as_unset $as_var fi done # Required to use basename. if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi # Name of the executable. as_me=`$as_basename "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)$' \| \ . : '\(.\)' 2>/dev/null || echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; } /^X\/\(\/\/\)$/{ s//\1/; q; } /^X\/\(\/\).*/{ s//\1/; q; } s/.*/./; q'` # PATH needs CR, and LINENO needs CR and PATH. # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then echo "#! /bin/sh" >conf$$.sh echo "exit 0" >>conf$$.sh chmod +x conf$$.sh if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then PATH_SEPARATOR=';' else PATH_SEPARATOR=: fi rm -f conf$$.sh fi as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" || { # Find who we are. Look in the path if we contain no path at all # relative or not. case $0 in *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5 echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;} { (exit 1); exit 1; }; } fi case $CONFIG_SHELL in '') as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for as_base in sh bash ksh sh5; do case $as_dir in /*) if ("$as_dir/$as_base" -c ' as_lineno_1=$LINENO as_lineno_2=$LINENO as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null` test "x$as_lineno_1" != "x$as_lineno_2" && test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; } $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; } CONFIG_SHELL=$as_dir/$as_base export CONFIG_SHELL exec "$CONFIG_SHELL" "$0" ${1+"$@"} fi;; esac done done ;; esac # Create $as_me.lineno as a copy of $as_myself, but with $LINENO # uniformly replaced by the line number. The first 'sed' inserts a # line-number line before each line; the second 'sed' does the real # work. The second script uses 'N' to pair each line-number line # with the numbered line, and appends trailing '-' during # substitution so that $LINENO is not a special case at line end. # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-) sed '=' <$as_myself | sed ' N s,$,-, : loop s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3, t loop s,-$,, s,^['$as_cr_digits']*\n,, ' >$as_me.lineno && chmod +x $as_me.lineno || { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5 echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;} { (exit 1); exit 1; }; } # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensible to this). . ./$as_me.lineno # Exit status is that of the last command. exit } case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in *c*,-n*) ECHO_N= ECHO_C=' ' ECHO_T=' ' ;; *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;; *) ECHO_N= ECHO_C='\c' ECHO_T= ;; esac if expr a : '\(a\)' >/dev/null 2>&1; then as_expr=expr else as_expr=false fi rm -f conf$$ conf$$.exe conf$$.file echo >conf$$.file if ln -s conf$$.file conf$$ 2>/dev/null; then # We could just check for DJGPP; but this test a) works b) is more generic # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04). if test -f conf$$.exe; then # Don't use ln at all; we don't have any links as_ln_s='cp -p' else as_ln_s='ln -s' fi elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -p' fi rm -f conf$$ conf$$.exe conf$$.file if mkdir -p . 2>/dev/null; then as_mkdir_p=: else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_executable_p="test -f" # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" # IFS # We need space, tab and new line, in precisely that order. as_nl=' ' IFS=" $as_nl" # CDPATH. $as_unset CDPATH exec 6>&1 # Open the log real soon, to keep \$[0] and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. Logging --version etc. is OK. exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX } >&5 cat >&5 <<_CSEOF This file was extended by f2j $as_me 0.8.1, which was generated by GNU Autoconf 2.59. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ _CSEOF echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5 echo >&5 _ACEOF # Files that config.status was made for. if test -n "$ac_config_files"; then echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS fi if test -n "$ac_config_headers"; then echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS fi if test -n "$ac_config_links"; then echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS fi if test -n "$ac_config_commands"; then echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS fi cat >>$CONFIG_STATUS <<\_ACEOF ac_cs_usage="\ \`$as_me' instantiates files from templates according to the current configuration. Usage: $0 [OPTIONS] [FILE]... -h, --help print this help, then exit -V, --version print version number, then exit -q, --quiet do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to ." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF ac_cs_version="\\ f2j config.status 0.8.1 configured by $0, generated by GNU Autoconf 2.59, with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\" Copyright (C) 2003 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." srcdir=$srcdir _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # If no file are specified by the user, then we need to provide default # value. By we need to know if files were specified by the user. ac_need_defaults=: while test $# != 0 do case $1 in --*=*) ac_option=`expr "x$1" : 'x\([^=]*\)='` ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'` ac_shift=: ;; -*) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; *) # This is not an option, so the user has probably given explicit # arguments. ac_option=$1 ac_need_defaults=false;; esac case $ac_option in # Handling of the options. _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --vers* | -V ) echo "$ac_cs_version"; exit 0 ;; --he | --h) # Conflict between --help and --header { { echo "$as_me:$LINENO: error: ambiguous option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: ambiguous option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; };; --help | --hel | -h ) echo "$ac_cs_usage"; exit 0 ;; --debug | --d* | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift CONFIG_FILES="$CONFIG_FILES $ac_optarg" ac_need_defaults=false;; --header | --heade | --head | --hea ) $ac_shift CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg" ac_need_defaults=false;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1 Try \`$0 --help' for more information." >&5 echo "$as_me: error: unrecognized option: $1 Try \`$0 --help' for more information." >&2;} { (exit 1); exit 1; }; } ;; *) ac_config_targets="$ac_config_targets $1" ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF if \$ac_cs_recheck; then echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6 exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_config_target in $ac_config_targets do case "$ac_config_target" in # Handling of arguments. "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;; "src/make.def" ) CONFIG_FILES="$CONFIG_FILES src/make.def" ;; "goto_trans/make.def" ) CONFIG_FILES="$CONFIG_FILES goto_trans/make.def" ;; "util/make.def" ) CONFIG_FILES="$CONFIG_FILES util/make.def" ;; "src/f2j-config.h" ) CONFIG_FILES="$CONFIG_FILES src/f2j-config.h" ;; *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5 echo "$as_me: error: invalid argument: $ac_config_target" >&2;} { (exit 1); exit 1; }; };; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason to put it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Create a temporary directory, and hook for its removal unless debugging. $debug || { trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0 trap '{ (exit 1); exit 1; }' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" } || { tmp=./confstat$$-$RANDOM (umask 077 && mkdir $tmp) } || { echo "$me: cannot create a temporary directory in ." >&2 { (exit 1); exit 1; } } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF # # CONFIG_FILES section. # # No need to generate the scripts if there are no CONFIG_FILES. # This happens for instance when ./config.status config.h if test -n "\$CONFIG_FILES"; then # Protect against being on the right side of a sed subst in config.status. sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g; s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF s,@SHELL@,$SHELL,;t t s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t s,@exec_prefix@,$exec_prefix,;t t s,@prefix@,$prefix,;t t s,@program_transform_name@,$program_transform_name,;t t s,@bindir@,$bindir,;t t s,@sbindir@,$sbindir,;t t s,@libexecdir@,$libexecdir,;t t s,@datadir@,$datadir,;t t s,@sysconfdir@,$sysconfdir,;t t s,@sharedstatedir@,$sharedstatedir,;t t s,@localstatedir@,$localstatedir,;t t s,@libdir@,$libdir,;t t s,@includedir@,$includedir,;t t s,@oldincludedir@,$oldincludedir,;t t s,@infodir@,$infodir,;t t s,@mandir@,$mandir,;t t s,@build_alias@,$build_alias,;t t s,@host_alias@,$host_alias,;t t s,@target_alias@,$target_alias,;t t s,@DEFS@,$DEFS,;t t s,@ECHO_C@,$ECHO_C,;t t s,@ECHO_N@,$ECHO_N,;t t s,@ECHO_T@,$ECHO_T,;t t s,@LIBS@,$LIBS,;t t s,@F2J_INSTALL_PREFIX@,$F2J_INSTALL_PREFIX,;t t s,@subdirs@,$subdirs,;t t s,@CC@,$CC,;t t s,@CFLAGS@,$CFLAGS,;t t s,@LDFLAGS@,$LDFLAGS,;t t s,@CPPFLAGS@,$CPPFLAGS,;t t s,@ac_ct_CC@,$ac_ct_CC,;t t s,@EXEEXT@,$EXEEXT,;t t s,@OBJEXT@,$OBJEXT,;t t s,@SET_MAKE@,$SET_MAKE,;t t s,@RANLIB@,$RANLIB,;t t s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t s,@AR@,$AR,;t t s,@JAVAC@,$JAVAC,;t t s,@JAVA@,$JAVA,;t t s,@YACC@,$YACC,;t t s,@F2J_VERSION@,$F2J_VERSION,;t t s,@BYTE_DIR@,$BYTE_DIR,;t t s,@F2J_PACKAGE_STRING@,$F2J_PACKAGE_STRING,;t t s,@LIBOBJS@,$LIBOBJS,;t t s,@LTLIBOBJS@,$LTLIBOBJS,;t t CEOF _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF # Split the substitutions into bite-sized pieces for seds with # small command number limits, like on Digital OSF/1 and HP-UX. ac_max_sed_lines=48 ac_sed_frag=1 # Number of current file. ac_beg=1 # First line for current file. ac_end=$ac_max_sed_lines # Line after last line for current file. ac_more_lines=: ac_sed_cmds= while $ac_more_lines; do if test $ac_beg -gt 1; then sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag else sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag fi if test ! -s $tmp/subs.frag; then ac_more_lines=false else # The purpose of the label and of the branching condition is to # speed up the sed processing (if there are no `@' at all, there # is no need to browse any of the substitutions). # These are the two extra sed commands mentioned above. (echo ':t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed if test -z "$ac_sed_cmds"; then ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed" else ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed" fi ac_sed_frag=`expr $ac_sed_frag + 1` ac_beg=$ac_end ac_end=`expr $ac_end + $ac_max_sed_lines` fi done if test -z "$ac_sed_cmds"; then ac_sed_cmds=cat fi fi # test -n "$CONFIG_FILES" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in". case $ac_file in - | *:- | *:-:* ) # input from stdin cat >$tmp/stdin ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'` ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;; * ) ac_file_in=$ac_file.in ;; esac # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories. ac_dir=`(dirname "$ac_file") 2>/dev/null || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac if test x"$ac_file" != x-; then { echo "$as_me:$LINENO: creating $ac_file" >&5 echo "$as_me: creating $ac_file" >&6;} rm -f "$ac_file" fi # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ if test x"$ac_file" = x-; then configure_input= else configure_input="$ac_file. " fi configure_input=$configure_input"Generated from `echo $ac_file_in | sed 's,.*/,,'` by configure." # First look for the input files in the build tree, otherwise in the # src tree. ac_file_inputs=`IFS=: for f in $ac_file_in; do case $f in -) echo $tmp/stdin ;; [\\/$]*) # Absolute (can't be DOS-style, as IFS=:) test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } echo "$f";; *) # Relative if test -f "$f"; then # Build tree echo "$f" elif test -f "$srcdir/$f"; then # Source tree echo "$srcdir/$f" else # /dev/null tree { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5 echo "$as_me: error: cannot find input file: $f" >&2;} { (exit 1); exit 1; }; } fi;; esac done` || { (exit 1); exit 1; } _ACEOF cat >>$CONFIG_STATUS <<_ACEOF sed "$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s,@configure_input@,$configure_input,;t t s,@srcdir@,$ac_srcdir,;t t s,@abs_srcdir@,$ac_abs_srcdir,;t t s,@top_srcdir@,$ac_top_srcdir,;t t s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t s,@builddir@,$ac_builddir,;t t s,@abs_builddir@,$ac_abs_builddir,;t t s,@top_builddir@,$ac_top_builddir,;t t s,@abs_top_builddir@,$ac_abs_top_builddir,;t t " $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out rm -f $tmp/stdin if test x"$ac_file" != x-; then mv $tmp/out $ac_file else cat $tmp/out rm -f $tmp/out fi done _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF { (exit 0); exit 0; } _ACEOF chmod +x $CONFIG_STATUS ac_clean_files=$ac_clean_files_save # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || { (exit 1); exit 1; } fi # # CONFIG_SUBDIRS section. # if test "$no_recursion" != yes; then # Remove --cache-file and --srcdir arguments so they do not pile up. ac_sub_configure_args= ac_prev= for ac_arg in $ac_configure_args; do if test -n "$ac_prev"; then ac_prev= continue fi case $ac_arg in -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* \ | --c=*) ;; --config-cache | -C) ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) ;; *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;; esac done # Always prepend --prefix to ensure using the same prefix # in subdir configurations. ac_sub_configure_args="--prefix=$prefix $ac_sub_configure_args" ac_popdir=`pwd` for ac_dir in : $subdirs; do test "x$ac_dir" = x: && continue # Do not complain, so a configure script can configure whichever # parts of a large source tree are present. test -d $srcdir/$ac_dir || continue { echo "$as_me:$LINENO: configuring in $ac_dir" >&5 echo "$as_me: configuring in $ac_dir" >&6;} { if $as_mkdir_p; then mkdir -p "$ac_dir" else as_dir="$ac_dir" as_dirs= while test ! -d "$as_dir"; do as_dirs="$as_dir $as_dirs" as_dir=`(dirname "$as_dir") 2>/dev/null || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| \ . : '\(.\)' 2>/dev/null || echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; } /^X\(\/\/\)[^/].*/{ s//\1/; q; } /^X\(\/\/\)$/{ s//\1/; q; } /^X\(\/\).*/{ s//\1/; q; } s/.*/./; q'` done test ! -n "$as_dirs" || mkdir $as_dirs fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5 echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;} { (exit 1); exit 1; }; }; } ac_builddir=. if test "$ac_dir" != .; then ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'` # A "../" for each directory in $ac_dir_suffix. ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'` else ac_dir_suffix= ac_top_builddir= fi case $srcdir in .) # No --srcdir option. We are building in place. ac_srcdir=. if test -z "$ac_top_builddir"; then ac_top_srcdir=. else ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'` fi ;; [\\/]* | ?:[\\/]* ) # Absolute path. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ;; *) # Relative path. ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_builddir$srcdir ;; esac # Do not use `cd foo && pwd` to compute absolute paths, because # the directories may not exist. case `pwd` in .) ac_abs_builddir="$ac_dir";; *) case "$ac_dir" in .) ac_abs_builddir=`pwd`;; [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";; *) ac_abs_builddir=`pwd`/"$ac_dir";; esac;; esac case $ac_abs_builddir in .) ac_abs_top_builddir=${ac_top_builddir}.;; *) case ${ac_top_builddir}. in .) ac_abs_top_builddir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;; *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;; esac;; esac case $ac_abs_builddir in .) ac_abs_srcdir=$ac_srcdir;; *) case $ac_srcdir in .) ac_abs_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;; *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;; esac;; esac case $ac_abs_builddir in .) ac_abs_top_srcdir=$ac_top_srcdir;; *) case $ac_top_srcdir in .) ac_abs_top_srcdir=$ac_abs_builddir;; [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;; *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;; esac;; esac cd $ac_dir # Check for guested configure; otherwise get Cygnus style configure. if test -f $ac_srcdir/configure.gnu; then ac_sub_configure="$SHELL '$ac_srcdir/configure.gnu'" elif test -f $ac_srcdir/configure; then ac_sub_configure="$SHELL '$ac_srcdir/configure'" elif test -f $ac_srcdir/configure.in; then ac_sub_configure=$ac_configure else { echo "$as_me:$LINENO: WARNING: no configuration information is in $ac_dir" >&5 echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2;} ac_sub_configure= fi # The recursion is here. if test -n "$ac_sub_configure"; then # Make the cache file name correct relative to the subdirectory. case $cache_file in [\\/]* | ?:[\\/]* ) ac_sub_cache_file=$cache_file ;; *) # Relative path. ac_sub_cache_file=$ac_top_builddir$cache_file ;; esac { echo "$as_me:$LINENO: running $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir" >&5 echo "$as_me: running $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir" >&6;} # The eval makes quoting arguments work. eval $ac_sub_configure $ac_sub_configure_args \ --cache-file=$ac_sub_cache_file --srcdir=$ac_srcdir || { { echo "$as_me:$LINENO: error: $ac_sub_configure failed for $ac_dir" >&5 echo "$as_me: error: $ac_sub_configure failed for $ac_dir" >&2;} { (exit 1); exit 1; }; } fi cd $ac_popdir done fi f2j-0.8.1/configure.in0000600000077700002310000000170111031241067014556 0ustar seymourgraduateAC_INIT(f2j, 0.8.1, [f2j@cs.utk.edu]) AC_REVISION([$Revision: 1.5 $]) AC_CONFIG_SRCDIR(f2j_TODO.txt) if test "x$prefix" != xNONE; then F2J_INSTALL_PREFIX=${prefix} else F2J_INSTALL_PREFIX=`pwd` fi AC_SUBST(F2J_INSTALL_PREFIX) prefix=$F2J_INSTALL_PREFIX AC_CONFIG_SUBDIRS(libbytecode) AC_PROG_CC(gcc cc ecc xlc) AC_C_BIGENDIAN AC_PROG_MAKE_SET AC_PROG_RANLIB AC_PATH_PROG(AR, ar) AC_SUBST(AR) AC_PATH_PROG(JAVAC, javac) AC_SUBST(JAVAC) AC_PATH_PROG(JAVA, java) AC_SUBST(JAVA) AC_PROG_YACC F2J_VERSION=AC_PACKAGE_VERSION AC_SUBST(F2J_VERSION) AC_ARG_WITH(libbytecode-dir, [ --with-libbytecode-dir=dir directory containing bytecode library], [BYTE_DIR="$with_libbytecode_dir"], [BYTE_DIR="$PWD/libbytecode"]) AC_SUBST(BYTE_DIR) F2J_PACKAGE_STRING=AC_PACKAGE_NAME-AC_PACKAGE_VERSION AC_SUBST(F2J_PACKAGE_STRING) AC_CONFIG_FILES(Makefile src/make.def goto_trans/make.def util/make.def) AC_OUTPUT(src/f2j-config.h) f2j-0.8.1/f2j_TODO.txt0000600000077700002310000000450111031241067014315 0ustar seymourgraduateRelatively high priority modifications. (not necessarily listed in order of priority) -Isolate the WRITE/FORMAT code in the lexer into a subroutine. -Work on front-end The front-end of f2j is sufficient for BLAS/LAPACK code, but to handle any other code it will have to be extended. I think the best way to go would be to graft a full f77 parser from another compiler or tool (such as FTNCHEK) onto f2j. This is no small task since it could alter the structure of the syntax tree, thus requiring all subsequent stages of the translator to be modified. -Port fortran I/O library to java I have a BSD fortran I/O library somewhere (written in C) that would make translating READ,WRITE,FORMAT statements much easier - if only it was converted to Java. It's around 6000 lines of C code, if I remember correctly. [UPDATE: as of version 0.8, this is done to a certain extent, but not from a C port. I integrated a hacked version of Jocelyn Paine's Formatter package into f2j.] -Threadsafe version One or two people have asked about this. It's not a bad idea, but it would change the user interface and code generation. The code that generates static initializers would need to be changed. -Support more data types Having support for complex numbers would be nice, but it will require a lot of changes in the code generator. -More translator optimizations Might be interesting to see if we can optimize the array indexing since it gets so cumbersome in the translation. The java compiler probably optimizes the index expressions - however, even if it turns out that there is no speed improvement, it would still help the readability of the resulting source code a lot. If we end up translating directly to Jasmin or bytecode, then we should definitely try to optimize some of this. Also string operations (accessing a single character, substring, etc) may leave some room for optimization. -Create AST documentation It would help to have a chart of the structure of each kind of node in the abstract syntax tree. -Create API documentation Write some API documentation - something a little more extensive than the current javadoc pages. There is a standard link generated by javadoc, "API Users Guide", that should be linked to the API docs whenever complete. f2j-0.8.1/Makefile.in0000600000077700002310000000373011031241067014316 0ustar seymourgraduate# Top level makefile for the f2j system. # $Author: keithseymour $ # $Date: 2008/06/24 21:03:43 $ # $Source: /cvsroot/f2j/f2j/Makefile.in,v $ # $Revision: 1.10 $ F2J_PACKAGE_NAME=@F2J_PACKAGE_STRING@ all: f2java javab install: cd util; $(MAKE) install cd goto_trans; $(MAKE) install cd libbytecode; $(MAKE) install cd src; $(MAKE) install libbytecode/libbytecode.a: cd libbytecode; $(MAKE) util/f2jutil.jar: cd util; $(MAKE) f2java: libbytecode/libbytecode.a util/f2jutil.jar cd src; $(MAKE) javab: cd goto_trans; $(MAKE) srcdist: srcdist_common zip -r $(F2J_PACKAGE_NAME).zip $(F2J_PACKAGE_NAME) tar cvf - $(F2J_PACKAGE_NAME) | gzip > $(F2J_PACKAGE_NAME).tgz srcdist_common: cd src; $(MAKE) y.tab.c mkdir -p $(F2J_PACKAGE_NAME)/bin mkdir -p $(F2J_PACKAGE_NAME)/src mkdir -p $(F2J_PACKAGE_NAME)/doc mkdir -p $(F2J_PACKAGE_NAME)/goto_trans mkdir -p $(F2J_PACKAGE_NAME)/libbytecode mkdir -p $(F2J_PACKAGE_NAME)/util/org/netlib/util cd goto_trans; cp *.[ch] make.def.in README LICENSE Makefile ../$(F2J_PACKAGE_NAME)/goto_trans cd libbytecode; cp *.[ch] *.in configure ../$(F2J_PACKAGE_NAME)/libbytecode cd src; cp *.[chy] make.def.in LICENSE Makefile f2j-config.h.in ../$(F2J_PACKAGE_NAME)/src cd util; cp make.def.in Makefile ../$(F2J_PACKAGE_NAME)/util cd util; cp -r org ../$(F2J_PACKAGE_NAME)/util cd doc; $(MAKE) f2j_ug.pdf; $(MAKE) almost_clean cp doc/Makefile doc/*.tex doc/f2j_ug.pdf $(F2J_PACKAGE_NAME)/doc cp README CHANGES install-sh configure configure.in f2j_TODO.txt Makefile.in $(F2J_PACKAGE_NAME) clean: /bin/rm -rf $(F2J_PACKAGE_NAME) $(F2J_PACKAGE_NAME).zip $(F2J_PACKAGE_NAME).tgz f2jsrc.tgz f2jsrc.zip cd goto_trans; $(MAKE) realclean cd libbytecode; $(MAKE) clean cd src; $(MAKE) clean cd util; $(MAKE) clean cd doc; $(MAKE) clean configclean: clean cd libbytecode; $(MAKE) configclean /bin/rm -rf autom4te.cache /bin/rm -f config.log config.status config.cache Makefile src/make.def /bin/rm -f configure goto_trans/make.def util/make.def