/* $Id: iut_driver.c 56 2005-05-02 20:03:33Z wgeorge $ This is the IMPI test interpreter for the system under test. */ /* This software was developed at the National Institute of Standards and Technology by employees of the Federal Government in the course of their official duties. Pursuant to title 17 Section 105 of the United States Code this software is not subject to copyright protection and is in the public domain. This is an experimental system. NIST assumes no responsibility whatsoever for its use by other parties, and makes no guarantees, expressed or implied, about its quality, reliability, or any other characteristic. We would appreciate acknowledgement if the software is used. */ /* Derived from: $Id: iut_driver.c 56 2005-05-02 20:03:33Z wgeorge $ */ # include # include # include # include # include # include "mpi.h" /** $Id: impi_interp.h 56 2005-05-02 20:03:33Z wgeorge $ */ /* This software was developed at the National Institute of Standards and Technology by employees of the Federal Government in the course of their official duties. Pursuant to title 17 Section 105 of the United States Code this software is not subject to copyright protection and is in the public domain. This is an experimental system. NIST assumes no responsibility whatsoever for its use by other parties, and makes no guarantees, expressed or implied, about its quality, reliability, or any other characteristic. We would appreciate acknowledgement if the software is used. */ /* Datum Types */ /* Storage types: */ typedef struct datum_struct { int type; /* INT, SHORT, LONG, FLOAT, DOUBLE, LONGLONG or REFERENCE (WLG) */ int constant; /* true or false */ int storage_type; /* */ char name[128]; /* can be zero-length for temporaries or constants */ /* One of these is used if it is a constant or variable scalar. */ char schar; int sint; short sshort; long slong; long long llong; /* WLG */ unsigned char uchar; unsigned int uint; unsigned short ushort; unsigned long ulong; char str[128]; MPI_Request mpi_request; MPI_Group mpi_group; MPI_Comm mpi_comm; float flt; double dble; long double ldble; /* One of these is used if it is an array or a scalar reference. */ void *ptr; /* note that we could put all of the scalar values and the array pointers into a union to save space. */ /* used only for arrays */ int array_length; /* used only for REFERENCES */ struct datum_struct *ref; /* used only for FUNCTIONs */ int (*func)(); } Datum; typedef struct { int (*operation) (); Datum d; /* needed only for some operations */ long inst_loc[8]; /* indices to other instructions; only needed for branching ops */ long source_line; } Instruction; typedef struct { struct interpreter_state *interpreter; Instruction i[10000]; long next_compiled_instruction; /* instruction counter to be used during compilation */ long pc; /* program counter to be used during execution */ } Instruction_Store; typedef struct { struct interpreter_state *interpreter; Datum d[1024]; Datum *top; int top_index; } Data_Stack; typedef struct { struct interpreter_state *interpreter; Datum symbol[1000]; int num_symbols; } Symbol_Store; typedef struct { struct interpreter_state *interpreter; char *script_buffer; char *curr_script_pos; char *eof_script_pos; } Script; /* This data structure is used to preserve the state of the interpreter within a single thread. So there must be a unique one of these in each thread. */ typedef struct interpreter_state { Instruction_Store program; Data_Stack stack; Symbol_Store symbols; Script script; int mpiRank; int mpiNumProcs; int verbose; int iAmMaster; int masterRank; MPI_Comm mpi_comm_world; } Interpreter_State; int Num_MPI_Procs = -1; int My_MPI_Rank = -1; int Controlling_Rank = -1; int iAmMaster = 0; char *progname; int log_error (); /* This routine takes the place of the gettxt routine this is used to retrieve messages from a message database. It is provided here for systems on which it not available. */ char *gettxt (const char *msgid, const char *dflt_str) { return (char *)dflt_str; } /* end of gettxt */ /** $Id: impi_interp.c 56 2005-05-02 20:03:33Z wgeorge $ */ /* This is an interpreter for a simple C-like language. It is intended to be used for the client side of the IMPI test tool. Current features of the language: Generally C style syntax: statements end with ";", statements are grouped with { }. Data types: char short int long unsigned char unsigned short unsigned int unsigned long float double long double C style declarations, except only one per statement. Scalars and arrays are supported. C style comments except that they can be nested. If first character in a line is '`' then the line is regarded as a comment. The following operators are supported: + - * / > < >= <= == != && || unary- unary! Flow control: C style if, if-else, while, for, except that the for cannot have an empty condition. Assignment is, of course, supported. Array subscripting Pre-defined MPI constants. return; - When this is executed, control is passed back to the driver program. Calling pre-defined functions: print - prints out a single data item printf - similar to C printf. All numeric values are converted to long double, so you need to use something like %Lf to print out everything. Note that this is the only place where quoted strings are used. exit - just like C exit (more to come) Future features: Character and string constants. Calling MPI functions. Adaptation to MPI test environment: Initialize MPI and establish communication with test driver. Get source from test driver Parse source code from memory rather than stdin Features that will NOT be implemented: User-defined functions ++ or -- operators pointers in any way shape or form ---------------------- Comments on Implementation This implementation uses some ideas from "The Unix Programming Environment" by Brian Kernighan and Rob Pike. The source code is tokenized according to a lex specification. It recognizes: float point constants integer constants symbols (alphanumeric identifiers keywords like if, else, while, for, int, double, etc. operators like +, <=, etc. comments as described above Except for the comments, it returns each token with enough information so that the stream of tokens can be easily parsed. The lex-generated code does not itself manipulate any long-term data structures. This is left to the parser. Program parsing and execution are based on a simple stack-based machine that is modelled within this code. There is no attempt made to make this efficient in either space or time. Important data structures: Datum: describes an individual variable, constant, or function Instruction: describes a single machine instruction Symbol_Store: Datums describing the collection of declared variables and pre-defined functions Data_Stack: Stack of Datums (the machine stack) Instruction_Store: list of machine instructions; includes pointers to next instruction to be compiled and a program counter for execution. Note that the state of the machine is represented by the symbol store, the instruction store, and the stack. There is no reason why there can't be multiple machines going at the same time. This implementation does not fully encasulate a machine state into a single data structure, but it would be relatively simple to do so. It should be noted that each Instruction contains a Datum. The Datum is used by only some of the instructions: push the Datum contains the thing to be pushed. binop the Datum indicates which binary operation is to be done unop the Datum indicates which unary operation is to be done To simplify the implementation of the numerical operations, the operands are promoted to long, unsigned long, or long double as appropriate. < more to come > The yacc Specification and the Productions Need to say something about the way that the productions track the indices into the instruction store and the way that the flow control operations use these indices. */ # include # include # include /** $Id: impi_interp.h 56 2005-05-02 20:03:33Z wgeorge $ */ /* This software was developed at the National Institute of Standards and Technology by employees of the Federal Government in the course of their official duties. Pursuant to title 17 Section 105 of the United States Code this software is not subject to copyright protection and is in the public domain. This is an experimental system. NIST assumes no responsibility whatsoever for its use by other parties, and makes no guarantees, expressed or implied, about its quality, reliability, or any other characteristic. We would appreciate acknowledgement if the software is used. */ int pop (); int call_func (); int subscript (); int assign (); int if_op (); int while_op (); int for_op (); int binary_op (); int unary_op (); long add_inst (); long add_inst_pushsym (); long add_inst_pushstring (); long add_inst_pushlval (); long add_inst_pushllval (); long add_inst_pushdval (); long add_inst_binop (); long add_inst_unop (); long add_inst_return (); long set_if_branches (); long set_while_branches (); long set_for_branches (); long create_scalar (); long create_array (); /* Linux uses flex instead of lex (lex is usually linked to flex) and flex does not support yylineno. */ extern int yylineno; long double ldble (); double dble (); float flt (); long slong (); long long llong (); unsigned long unlong (); void send_report_inner ( Interpreter_State *, int, int, char *, char *); int T = 1; /* never changes; a kludge to avoid compiler warnings */ /* These four globals are used only during lex/yacc execution. The lex/yacc code can't be made thread safe except by enforcing sequential execution. These globals are set at the start of and are assumed to be preserved throughout the lex/yacc execution of a single thread. */ Instruction_Store *LY_Program; Symbol_Store *LY_Symbols; Script *LY_Script; int lineno = 1; /* We don't care about preserving Verbose across threads. We should, but we don't. */ int Verbose = 1; Datum Long_Zero; /** $Id: impi_interp_y.y,v 1.6 1999/07/22 18:24:45 wgeorge Exp $ */ /* header C code */ /* POUND include "impi.h" */ typedef union { long lval; long long llval; double dval; char sym[128]; long operator; } YYSTYPE; extern int yychar; extern int yyerrflag; YYSTYPE yylval, yyval; typedef int yytabelem; yytabelem yyexca[] ={ -1, 1, 0, -1, -2, 0, -1, 53, 61, 17, -2, 20, -1, 62, 61, 18, -2, 45, }; yytabelem yyact[]={ 12, 117, 49, 86, 87, 88, 89, 125, 48, 100, 95, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 124, 86, 87, 88, 89, 42, 129, 126, 43, 122, 119, 97, 12, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 61, 132, 86, 87, 88, 89, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 61, 128, 72, 86, 87, 88, 89, 74, 75, 76, 77, 78, 79, 80, 81, 74, 75, 76, 77, 44, 86, 87, 88, 89, 76, 77, 40, 61, 86, 87, 88, 89, 61, 39, 73, 86, 87, 88, 89, 61, 38, 93, 135, 133, 94, 99, 70, 96, 47, 46, 45, 51, 3, 10, 18, 120, 2, 9, 8, 16, 7, 6, 17, 15, 1, 41, 13, 63, 0, 0, 123, 0, 0, 0, 14, 0, 0, 20, 0, 22, 21, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 130, 50, 0, 134, 0, 0, 0, 136, 137, 0, 138, 0, 0, 14, 0, 0, 20, 11, 22, 21, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 0, 0, 0, 0, 0, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 11, 86, 87, 88, 89, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 19, 0, 0, 0, 0, 60, 5, 0, 0, 0, 0, 0, 0, 0, 0, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 0, 86, 87, 88, 89, 0, 0, 0, 0, 0, 54, 56, 55, 53, 19, 0, 0, 0, 0, 0, 5, 0, 57, 4, 0, 0, 54, 56, 55, 53, 0, 0, 0, 0, 0, 0, 58, 0, 67, 0, 0, 0, 0, 0, 0, 0, 0, 59, 0, 0, 0, 0, 58, 54, 56, 55, 53, 0, 54, 56, 55, 53, 64, 59, 4, 54, 56, 55, 53, 19, 0, 0, 19, 0, 0, 5, 0, 0, 5, 58, 0, 0, 0, 0, 58, 69, 71, 0, 0, 0, 59, 58, 0, 0, 0, 59, 0, 0, 19, 0, 68, 19, 59, 0, 5, 19, 19, 5, 19, 98, 0, 5, 5, 0, 5, 0, 0, 0, 0, 4, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 121, 0, 0, 0, 0, 0, 0, 52, 65, 66, 0, 0, 4, 0, 0, 4, 0, 0, 0, 4, 4, 0, 4, 90, 91, 127, 92, 0, 0, 131, 0, 0, 0, 0, 0, 0, 0, 0, 0, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 0, 0, 0, 0, 118 }; yytabelem yypact[]={ -88,-10000000,-10000000,-10000000, 44, 37,-10000000,-10000000,-10000000,-10000000, -10000000, 30,-10000000, -33, -9, 73, 72, 71, -252,-10000000, -10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000, -10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000,-10000000, -10000000, -123, 62, 55, 62, 62, 50, 62, 6,-10000000, -10000000,-10000000, -271, -9,-10000000,-10000000,-10000000,-10000000, 62, 62, -10000000, 62,-10000000, 63,-10000000, -271, -83, 69, -271, -25, 62, 67,-10000000, -248, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, 62, -292, -292, -40,-10000000, 62,-10000000, -88, 62, -27, -88, -70, -197, -197, -292, -292, -204, -204, -204, -204, -212, -212, -229, -246, -271, -271, -271, -271,-10000000, -271, -257, -10000000, -29, 23,-10000000, -30, -88, 7, 65, -88,-10000000, -10000000, 64, -88, -88,-10000000, -88,-10000000,-10000000,-10000000 }; yytabelem yypgo[]={ 0, 130, 354, 276, 129, 118, 128, 232, 226, 114, 127, 126, 125, 124, 123, 122, 121, 120, 292, 33, 117, 116 }; yytabelem yyr1[]={ 0, 10, 10, 9, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 7, 8, 4, 4, 3, 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, 1, 1, 1, 18, 19, 11, 13, 14, 12, 17, 15, 16, 16, 16, 16, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 20, 21, 21 }; yytabelem yyr2[]={ 0, 3, 3, 7, 5, 5, 3, 3, 3, 3, 3, 3, 5, 1, 4, 9, 9, 3, 2, 7, 3, 3, 3, 3, 3, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 5, 5, 3, 7, 3, 1, 3, 3, 7, 3, 3, 3, 11, 15, 3, 11, 3, 19, 17, 17, 15, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 7, 13 }; yytabelem yychk[]={ -10000000, -10, -5, -9, -3, -7, -13, -14, -16, -17, -21, 299, 123, -4, 260, -11, -15, -12, -20, -8, 263, 266, 265, 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, 59, 59, 59, -6, 61, 40, 91, 40, 40, 40, 260, 125, -5, -9, -2, 260, 257, 259, 258, -3, 283, 294, -7, 40, -8, -1, 261, -2, -2, -18, -2, -18, 59, -18, 59, 91, 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, 295, 296, 297, 298, -2, -2, -2, 41, 44, 93, 41, 59, -18, 41, 257, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, 41, -2, -19, -5, -18, 59, -19, 93, 264, 59, -18, 41, 59, -19, -18, 41, 41, -19, 41, -19, -19, -19 }; yytabelem yydef[]={ 0, -2, 1, 2, 0, 0, 7, 8, 9, 10, 11, 0, 13, 0, 17, 0, 0, 0, 0, 18, 52, 57, 55, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 4, 5, 12, 0, 0, 46, 0, 0, 0, 0, 0, 3, 14, 6, 19, -2, 21, 22, 23, 24, 0, 0, 43, 0, -2, 0, 47, 48, 0, 0, 50, 0, 0, 0, 77, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 41, 42, 0, 15, 0, 16, 0, 0, 0, 0, 0, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 44, 49, 53, 51, 0, 0, 56, 0, 0, 0, 0, 0, 78, 54, 0, 0, 0, 61, 0, 60, 59, 58 }; typedef struct { char *t_name; int t_val; } yytoktype; /* @(#)27 1.7.1.4 src/bos/usr/ccs/bin/yacc/yaccpar, cmdlang, bos520 11/28/95 13:48:59 */ /* * COMPONENT_NAME: (CMDLANG) Language Utilities * * FUNCTIONS: yyparse * ORIGINS: 3 */ /* ** Skeleton parser driver for yacc output */ /* ** yacc user known macros and defines */ /* ** user known globals */ int yydebug; /* set to 1 to get debugging */ /* ** driver internal defines */ /* ** global variables used by the parser */ YYSTYPE yyv[ 150 ]; /* value stack */ int yys[ 150 ]; /* state stack */ YYSTYPE *yypv; /* top of value stack */ YYSTYPE *yypvt; /* top of value stack for $vars */ int *yyps; /* top of state stack */ int yystate; /* current state */ int yytmp; /* extra var (lasts between blocks) */ int yynerrs; /* number of errors */ int yyerrflag; /* error recovery flag */ int yychar; /* current input token number */ /* ** yyparse - return 0 if worked, 1 if syntax error not recovered from */ int yyparse() { /* ** Initialize externals - yyparse may be called more than once */ yypv = &yyv[-1]; yyps = &yys[-1]; yystate = 0; yytmp = 0; yynerrs = 0; yyerrflag = 0; yychar = -1; goto yystack; { register YYSTYPE *yy_pv; /* top of value stack */ register int *yy_ps; /* top of state stack */ register int yy_state; /* current state */ register int yy_n; /* internal state number info */ /* ** get globals into registers. ** branch to here only if YYBACKUP was called. */ yynewstate: yy_pv = yypv; yy_ps = yyps; yy_state = yystate; goto yy_newstate; /* ** get globals into registers. ** either we just started, or we just finished a reduction */ yystack: yy_pv = yypv; yy_ps = yyps; yy_state = yystate; /* ** top of for (;;) loop while no reductions done */ yy_stack: /* ** put a state and value onto the stacks */ if ( ++yy_ps >= &yys[ 150 ] ) /* room on stack? */ { yyerror( "yacc stack overflow" ); return(1); } *yy_ps = yy_state; *++yy_pv = yyval; /* ** we have a new state - find out what to do */ yy_newstate: if ( ( yy_n = yypact[ yy_state ] ) <= (-10000000) ) goto yydefault; /* simple state */ if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) ) yychar = 0; /* reached EOF */ if ( ( ( yy_n += yychar ) < 0 ) || ( yy_n >= 450 ) ) goto yydefault; if ( yychk[ yy_n = yyact[ yy_n ] ] == yychar ) /*valid shift*/ { yychar = -1; yyval = yylval; yy_state = yy_n; if ( yyerrflag > 0 ) yyerrflag--; goto yy_stack; } yydefault: if ( ( yy_n = yydef[ yy_state ] ) == -2 ) { if ( ( yychar < 0 ) && ( ( yychar = yylex() ) < 0 ) ) yychar = 0; /* reached EOF */ /* ** look through exception table */ { register int *yyxi = yyexca; while ( ( *yyxi != -1 ) || ( yyxi[1] != yy_state ) ) { yyxi += 2; } while ( ( *(yyxi += 2) >= 0 ) && ( *yyxi != yychar ) ) ; if ( ( yy_n = yyxi[1] ) < 0 ) return(0); } } /* ** check for syntax error */ if ( yy_n == 0 ) /* have an error */ { /* no worry about speed here! */ switch ( yyerrflag ) { case 0: /* new error */ yyerror( "syntax error" ); goto skip_init; yyerrlab: /* ** get globals into registers. ** we have a user generated syntax type error */ yy_pv = yypv; yy_ps = yyps; yy_state = yystate; yynerrs++; skip_init: case 1: case 2: /* incompletely recovered error */ /* try again... */ yyerrflag = 3; /* ** find state where "error" is a legal ** shift action */ while ( yy_ps >= yys ) { yy_n = yypact[ *yy_ps ] + 256; if ( yy_n >= 0 && yy_n < 450 && yychk[yyact[yy_n]] == 256) { /* ** simulate shift of "error" */ yy_state = yyact[ yy_n ]; goto yy_stack; } /* ** current state has no shift on ** "error", pop stack */ yy_ps--; yy_pv--; } /* ** there is no state on stack with "error" as ** a valid shift. give up. */ return(1); case 3: /* no shift yet; eat a token */ if ( yychar == 0 ) /* reached EOF. quit */ return(1); yychar = -1; goto yy_newstate; } }/* end if ( yy_n == 0 ) */ /* ** reduction by production yy_n ** put stack tops, etc. so things right after switch */ yytmp = yy_n; /* value to switch over */ yypvt = yy_pv; /* $vars top of value stack */ /* ** Look in goto table for next state ** Sorry about using yy_state here as temporary ** register variable, but why not, if it works... ** If yyr2[ yy_n ] doesn't have the low order bit ** set, then there is no action to be done for ** this reduction. So, no saving & unsaving of ** registers done. The only difference between the ** code just after the if and the body of the if is ** the goto yy_stack in the body. This way the test ** can be made before the choice of what to do is needed. */ { /* length of production doubled with extra bit */ register int yy_len = yyr2[ yy_n ]; if ( !( yy_len & 01 ) ) { yy_len >>= 1; yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */ yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] + *( yy_ps -= yy_len ) + 1; if ( yy_state >= 450 || yychk[ yy_state = yyact[ yy_state ] ] != -yy_n ) { yy_state = yyact[ yypgo[ yy_n ] ]; } goto yy_stack; } yy_len >>= 1; yyval = ( yy_pv -= yy_len )[1]; /* $$ = $1 */ yy_state = yypgo[ yy_n = yyr1[ yy_n ] ] + *( yy_ps -= yy_len ) + 1; if ( yy_state >= 450 || yychk[ yy_state = yyact[ yy_state ] ] != -yy_n ) { yy_state = yyact[ yypgo[ yy_n ] ]; } } /* save until reenter driver code */ yystate = yy_state; yyps = yy_ps; yypv = yy_pv; } /* ** code supplied by user is placed in this switch */ switch(yytmp){ case 1:{ yyval.lval = yypvt[-0].lval; if(T)return 0;} /*NOTREACHED*/ break; case 2:{ yyval.lval = yypvt[-0].lval; if(T)return 0;} /*NOTREACHED*/ break; case 3:{ yyval.lval = yypvt[-1].lval; pr("stmtblock", yyval.lval); } /*NOTREACHED*/ break; case 4:{ add_inst (LY_Program, pop); /* add_inst (LY_Program, NULL); */ yyval.lval = yypvt[-1].lval; pr("stmt: assign", yyval.lval);} /*NOTREACHED*/ break; case 5:{ add_inst (LY_Program, pop); /* add_inst (LY_Program, NULL); */ yyval.lval = yypvt[-1].lval; pr("stmt: func_call", yyval.lval); } /*NOTREACHED*/ break; case 6:{ yyval.lval = yypvt[-0].lval; pr("stmt: stmtblock", yyval.lval); } /*NOTREACHED*/ break; case 7:{ yyval.lval = yypvt[-0].lval; pr("stmt: if_stmt", yyval.lval); } /*NOTREACHED*/ break; case 8:{ yyval.lval = yypvt[-0].lval; pr("stmt: if_else_stmt", yyval.lval); } /*NOTREACHED*/ break; case 9:{ yyval.lval = yypvt[-0].lval; pr("stmt: for_stmt", yyval.lval); } /*NOTREACHED*/ break; case 10:{ yyval.lval = yypvt[-0].lval; pr("stmt: while_stmt", yyval.lval); } /*NOTREACHED*/ break; case 11:{ ; } /*NOTREACHED*/ break; case 12:{ yyval.lval = add_inst_return (LY_Program); pr ("RETURN", yyval.lval); } /*NOTREACHED*/ break; case 13:{ yyval.lval = LY_Program->next_compiled_instruction; pr("stmtlist", yyval.lval); } /*NOTREACHED*/ break; case 15:{ yyval.lval = add_inst_pushlval (LY_Program, yypvt[-1].lval); add_inst_pushsym (LY_Program, yypvt[-3].sym); add_inst (LY_Program, call_func); pr("func_call", yyval.lval); } /*NOTREACHED*/ break; case 16:{ yyval.lval = yypvt[-1].lval; add_inst_pushsym (LY_Program, yypvt[-3].sym); add_inst (LY_Program, subscript); pr("subscripted", yyval.lval); } /*NOTREACHED*/ break; case 17:{ yyval.lval = add_inst_pushsym (LY_Program, yypvt[-0].sym); pr("assignable: symbol", yyval.lval); } /*NOTREACHED*/ break; case 19:{ yyval.lval = yypvt[-2].lval; add_inst (LY_Program, assign); pr("assign", yyval.lval); } /*NOTREACHED*/ break; case 20:{ yyval.lval = add_inst_pushsym (LY_Program, yypvt[-0].sym); pr("expr: SYMBOL", yyval.lval); } /*NOTREACHED*/ break; case 21:{ yyval.lval = add_inst_pushlval (LY_Program, yypvt[-0].lval); pr("expr: LONG", yyval.lval); } /*NOTREACHED*/ break; case 22:{ yyval.lval = add_inst_pushllval (LY_Program, yypvt[-0].llval); pr("expr: LONG LONG", yyval.lval); } /*NOTREACHED*/ break; case 23:{ yyval.lval = add_inst_pushdval (LY_Program, yypvt[-0].dval); pr("expr: DOUBLE", yyval.lval); } /*NOTREACHED*/ break; case 24:{ yyval.lval = yypvt[-0].lval; pr("expr: assign", yyval.lval); } /*NOTREACHED*/ break; case 25:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 282); pr("expr: add", yyval.lval); } /*NOTREACHED*/ break; case 26:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 283); pr("expr: subtract", yyval.lval); } /*NOTREACHED*/ break; case 27:{ yyval.lval = yypvt[-2].lval; add_inst_binop(LY_Program,284); pr("expr: multiply", yyval.lval); } /*NOTREACHED*/ break; case 28:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 285); pr("expr: divide", yyval.lval); } /*NOTREACHED*/ break; case 29:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 286); pr("expr: gt", yyval.lval); } /*NOTREACHED*/ break; case 30:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 287); pr("expr: lt", yyval.lval); } /*NOTREACHED*/ break; case 31:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 288); pr("expr: ge", yyval.lval); } /*NOTREACHED*/ break; case 32:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 289); pr("expr: le", yyval.lval); } /*NOTREACHED*/ break; case 33:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 290); pr("expr: eq", yyval.lval); } /*NOTREACHED*/ break; case 34:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 291); pr("expr: ne", yyval.lval); } /*NOTREACHED*/ break; case 35:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 292); pr("expr: and", yyval.lval); } /*NOTREACHED*/ break; case 36:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 293); pr("expr: or", yyval.lval); } /*NOTREACHED*/ break; case 37:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 295); pr("expr: band", yyval.lval); } /*NOTREACHED*/ break; case 38:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 296); pr("expr: bor", yyval.lval); } /*NOTREACHED*/ break; case 39:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 297); pr("expr: bxor", yyval.lval); } /*NOTREACHED*/ break; case 40:{ yyval.lval = yypvt[-2].lval; add_inst_binop (LY_Program, 298); pr("expr: mod", yyval.lval); } /*NOTREACHED*/ break; case 41:{ yyval.lval = yypvt[-1].lval; add_inst_unop (LY_Program, 283); pr("expr: unary minus", yyval.lval); } /*NOTREACHED*/ break; case 42:{ yyval.lval = yypvt[-1].lval; add_inst_unop (LY_Program, 294); pr("expr: unary not", yyval.lval); } /*NOTREACHED*/ break; case 43:{ yyval.lval = yypvt[-0].lval; pr("expr: func_call", yyval.lval); } /*NOTREACHED*/ break; case 44:{ yyval.lval = yypvt[-1].lval; pr("expr: (expr)", yyval.lval); } /*NOTREACHED*/ break; case 45:{ yyval.lval = yypvt[-0].lval; pr("expr: subscripted", yyval.lval); } /*NOTREACHED*/ break; case 46:{ yyval.lval = 0; pr("arg_list: empty", yyval.lval); } /*NOTREACHED*/ break; case 47:{ yyval.lval = 1; add_inst_pushstring (LY_Program, yypvt[-0].sym); pr("arg_list: string", yyval.lval); } /*NOTREACHED*/ break; case 48:{ yyval.lval = 1; pr("arg_list: expr", yyval.lval); } /*NOTREACHED*/ break; case 49:{ yyval.lval = yyval.lval + 1; pr("arg_list: , expr", yyval.lval); } /*NOTREACHED*/ break; case 50:{ add_inst (LY_Program, NULL); yyval.lval = yypvt[-0].lval; pr("expr_seg", yyval.lval); } /*NOTREACHED*/ break; case 51:{ add_inst (LY_Program, NULL); yyval.lval = yypvt[-0].lval; pr("stmt_seg", yyval.lval); } /*NOTREACHED*/ break; case 52:{ yyval.lval = add_inst (LY_Program, if_op); pr("if", yyval.lval); } /*NOTREACHED*/ break; case 53:{ set_if_branches (LY_Program, yypvt[-4].lval, yypvt[-2].lval, yypvt[-0].lval, -1); yyval.lval = yypvt[-4].lval; pr("if_stmt", yyval.lval); } /*NOTREACHED*/ break; case 54:{ set_if_branches (LY_Program, yypvt[-6].lval, yypvt[-4].lval, yypvt[-2].lval, yypvt[-0].lval); yyval.lval = yypvt[-6].lval; pr("if_else_stmt", yyval.lval); } /*NOTREACHED*/ break; case 55:{yyval.lval = add_inst (LY_Program, while_op); pr("while", yyval.lval); } /*NOTREACHED*/ break; case 56:{ set_while_branches (LY_Program, yypvt[-4].lval, yypvt[-2].lval, yypvt[-0].lval); yyval.lval = yypvt[-4].lval; pr("while_stmt", yyval.lval); } /*NOTREACHED*/ break; case 57:{ yyval.lval = add_inst (LY_Program, for_op); pr("for", yyval.lval); } /*NOTREACHED*/ break; case 58:{ set_for_branches (LY_Program, yypvt[-8].lval, yypvt[-6].lval, yypvt[-4].lval, yypvt[-2].lval, yypvt[-0].lval); yyval.lval = yypvt[-8].lval; pr("for_stmt", yyval.lval); } /*NOTREACHED*/ break; case 59:{ set_for_branches (LY_Program, yypvt[-7].lval, -1, yypvt[-4].lval, yypvt[-2].lval, yypvt[-0].lval); yyval.lval = yypvt[-7].lval; pr("for_stmt", yyval.lval); } /*NOTREACHED*/ break; case 60:{ set_for_branches (LY_Program, yypvt[-7].lval, yypvt[-5].lval, yypvt[-3].lval, -1, yypvt[-0].lval); yyval.lval = yypvt[-7].lval; pr("for_stmt", yyval.lval); } /*NOTREACHED*/ break; case 61:{ set_for_branches (LY_Program, yypvt[-6].lval, -1, yypvt[-3].lval, -1, yypvt[-0].lval); yyval.lval = yypvt[-6].lval; pr("for_stmt", yyval.lval); } /*NOTREACHED*/ break; case 62:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 63:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 64:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 65:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 66:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 67:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 68:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 69:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 70:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 71:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 72:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 73:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 74:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 75:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 76:{ yyval.lval = yypvt[-0].lval; } /*NOTREACHED*/ break; case 77:{ yyval.lval = create_scalar (yypvt[-2].lval, yypvt[-1].sym); } /*NOTREACHED*/ break; case 78:{ yyval.lval = create_array (yypvt[-5].lval,yypvt[-4].sym,yypvt[-2].lval);} /*NOTREACHED*/ break; } goto yystack; /* reset registers in driver code */ } FILE *yyin = NULL, *yyout = NULL; int yyleng; extern char yytext[]; int yywleng; extern wchar_t yywtext[]; int yymorfg; int yymbcurmax = -1; int __once_yylex = 1; extern unsigned char *yysptr, yysbuf[]; int yytchar; extern int yylineno; struct yywork; struct yysvf { struct yywork *yystoff; struct yysvf *yyother; int *yystops;}; struct yysvf *yyestate; extern struct yysvf yysvec[], *yybgin; /** $Id: impi_interp_l.l,v 1.6 1999/07/22 18:24:45 wgeorge Exp $ */ /* int Line_Number = 1; */ int comment_level = 0; char yytext[2000]; int yyback(int *yyp, int yym); int yywinput(); void yywoutput(int yyc); void yywunput(int yyc); int yywreturn(int yyr); int yyinput(); void yyoutput(int yyc); void yyunput(int yyc); int yymbinput(); void yymboutput(int yyc); void yymbunput(int yyc); int yymbreturn(int yyx); int yylex(){ int yynstr; extern int yyprevious; if (__once_yylex) { setlocale(LC_ALL,""); if (yyin == NULL) yyin = stdin; if (yyout == NULL) yyout = stdout; __once_yylex = 0; } if(yymbcurmax<=0) yymbcurmax=MB_CUR_MAX; while((yynstr = yylook()) >= 0) yyfussy: switch(yynstr){ case 0: if(yywrap()) return(0); break; case 1: { ; } /*NOTREACHED*/ break; case 2: { sscanf (yytext, "%lld", &(yylval.llval)); if(T)return 259; } /*NOTREACHED*/ break; case 3: { sscanf (yytext, "%ld", &(yylval.lval)); if(T)return 257; } /*NOTREACHED*/ break; case 4: {sscanf (yytext, "%lf", &(yylval.dval)); if(T)return 258; } /*NOTREACHED*/ break; case 5: { yylval.lval = 263; if(T)return 263; } /*NOTREACHED*/ break; case 6: { yylval.lval = 264; if(T)return 264; } /*NOTREACHED*/ break; case 7: { yylval.lval = 265; if(T)return 265; } /*NOTREACHED*/ break; case 8: { yylval.lval = 266; if(T)return 266; } /*NOTREACHED*/ break; case 9: { yylval.lval = 282; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 10: { yylval.lval = 283; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 11: { yylval.lval = 284; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 12: { yylval.lval = 285; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 13: { yylval.lval = 298; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 14: { yylval.lval = 296; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 15: { yylval.lval = 295; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 16: { yylval.lval = 297; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 17: { yylval.lval = 286; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 18: { yylval.lval = 287; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 19: { yylval.lval = 288; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 20: { yylval.lval = 289; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 21: { yylval.lval = 290; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 22: { yylval.lval = 291; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 23: { yylval.lval = 292; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 24: { yylval.lval = 293; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 25: { yylval.lval = 294; if(T)return yylval.lval; } /*NOTREACHED*/ break; case 26: { yylval.lval = 267; if(T)return 267; } /*NOTREACHED*/ break; case 27: { yylval.lval = 268; if(T)return 268; } /*NOTREACHED*/ break; case 28: { yylval.lval = 269; if(T)return 269; } /*NOTREACHED*/ break; case 29: { yylval.lval = 271; if(T)return 271; } /*NOTREACHED*/ break; case 30: { yylval.lval = 270; if(T)return 270; } /*NOTREACHED*/ break; case 31: { yylval.lval = 272; if(T)return 272; } /*NOTREACHED*/ break; case 32: { yylval.lval = 273; if(T)return 273; } /*NOTREACHED*/ break; case 33: { yylval.lval = 274; if(T)return 274; } /*NOTREACHED*/ break; case 34: { yylval.lval = 275; if(T)return 275; } /*NOTREACHED*/ break; case 35: { yylval.lval = 276; if(T)return 276; } /*NOTREACHED*/ break; case 36: { yylval.lval = 277; if(T)return 277; } /*NOTREACHED*/ break; case 37: { yylval.lval = 278; if(T)return 278; } /*NOTREACHED*/ break; case 38: { yylval.lval = 279; if(T)return 279; } /*NOTREACHED*/ break; case 39: { yylval.lval = 280; if(T)return 280; } /*NOTREACHED*/ break; case 40: { yylval.lval = 281; if(T)return 281; } /*NOTREACHED*/ break; case 41: { yylval.lval = 299; if(T)return 299; } /*NOTREACHED*/ break; case 42: { strncpy (yylval.sym, yytext+1, strlen(yytext)-2); yylval.sym[strlen(yytext)-2] = 0; if(T)return 261; printf ("string = <%s>\n", yylval.sym); } /*NOTREACHED*/ break; case 43: { strcpy (yylval.sym, yytext); if(T)return 260; } /*NOTREACHED*/ break; case 44: { comment_level++; yybgin = yysvec + 1 + 2; } /*NOTREACHED*/ break; case 45: { ; } /*NOTREACHED*/ break; case 46: { if (--comment_level == 0) yybgin = yysvec + 1 + 0; } /*NOTREACHED*/ break; case 47: { ; } /*NOTREACHED*/ break; case 48: { lineno++; } /*NOTREACHED*/ break; case 49: { if(T)return yytext[0]; } /*NOTREACHED*/ break; case -1: break; default: fprintf(yyout,"bad switch yylook %d",yynstr); } return(0); } /* end of yylex */ int yyvstop[] = { 0, 49, 0, 1, 49, 0, 48, 0, 25, 49, 0, 49, 0, 13, 49, 0, 15, 49, 0, 11, 49, 0, 9, 49, 0, 10, 49, 0, 49, 0, 12, 49, 0, 3, 49, 0, 18, 49, 0, 49, 0, 17, 49, 0, 43, 49, 0, 43, 49, 0, 16, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 43, 49, 0, 14, 49, 0, 49, -47, 0, 45, 0, 45, 0, 45, 0, 45, -47, 0, 22, 0, 42, 0, 23, 0, 4, 0, 44, 0, 4, 0, 3, 0, 2, 0, 20, 0, 21, 0, 19, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 5, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 24, 0, -47, 0, 47, 0, 46, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 8, 43, 0, 28, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 26, 43, 0, 43, 0, 6, 43, 0, 43, 0, 30, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 35, 43, 0, 43, 0, 27, 43, 0, 43, 0, 7, 43, 0, 43, 0, 43, 0, 43, 0, 36, 43, 0, 41, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 43, 0, 40, 43, 0, 43, 0, 43, 0, 43, 0, 39, 43, 0, 43, 0, 29, 0, 43, 0, 38, 43, 0, 37, 0, 33, 0, 31, 0, 34, 0, 32, 0, 0}; struct yywork { unsigned char verify, advance; } yycrank[] = { 0,0, 0,0, 1,5, 0,0, 3,36, 0,0, 0,0, 9,41, 0,0, 0,0, 1,6, 1,7, 3,36, 3,7, 0,0, 9,41, 9,41, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 87,97, 1,8, 1,9, 121,126, 3,36, 1,10, 1,11, 9,42, 11,43, 0,0, 1,12, 1,13, 3,37, 1,14, 1,15, 1,16, 1,17, 3,38, 3,36, 16,45, 4,37, 9,41, 37,69, 0,0, 0,0, 4,38, 0,0, 2,8, 1,18, 1,19, 1,20, 2,10, 2,11, 1,21, 8,40, 3,36, 2,12, 2,13, 9,41, 2,14, 2,15, 2,16, 18,49, 19,50, 20,51, 1,22, 53,70, 0,0, 22,53, 82,92, 0,0, 0,0, 0,0, 82,93, 2,18, 2,19, 2,20, 0,0, 0,0, 0,0, 0,0, 0,0, 1,23, 70,82, 82,94, 54,71, 72,84, 1,24, 1,25, 1,26, 1,27, 2,22, 24,54, 1,28, 4,39, 30,62, 1,29, 26,56, 27,57, 25,55, 29,61, 27,58, 1,30, 1,31, 31,63, 1,32, 32,64, 1,33, 2,23, 28,59, 2,35, 33,65, 1,34, 2,24, 2,25, 2,26, 2,27, 28,60, 34,66, 2,28, 55,72, 56,73, 2,29, 57,74, 58,75, 60,76, 61,77, 62,78, 2,30, 2,31, 63,79, 2,32, 64,80, 2,33, 65,81, 71,83, 73,85, 74,86, 2,34, 15,44, 15,44, 15,44, 15,44, 15,44, 15,44, 15,44, 15,44, 15,44, 15,44, 17,46, 77,87, 17,47, 17,47, 17,47, 17,47, 17,47, 17,47, 17,47, 17,47, 17,47, 17,47, 78,88, 79,89, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 80,90, 81,91, 84,95, 86,96, 88,98, 89,99, 17,48, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 90,100, 91,101, 92,102, 93,103, 21,52, 94,104, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 21,52, 35,67, 95,105, 98,108, 100,109, 102,110, 103,111, 104,112, 106,113, 35,67, 35,68, 46,46, 46,46, 46,46, 46,46, 46,46, 46,46, 46,46, 46,46, 46,46, 46,46, 97,106, 107,114, 109,115, 110,116, 111,117, 112,118, 113,119, 114,120, 97,107, 115,121, 117,122, 118,123, 119,124, 35,67, 120,125, 123,127, 124,128, 126,129, 127,133, 128,134, 129,135, 130,136, 131,137, 126,130, 132,138, 135,139, 126,131, 35,67, 136,140, 137,141, 138,142, 139,143, 141,144, 126,132, 142,145, 145,146, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 0,0, 35,67, 0,0}; struct yywwork { wchar_t wch; unsigned int wnext; unsigned char wverify, wadvance;} yywcrank[] = { 0,0,0,0}; struct yysvf yysvec[] = { 0, 0, 0, yycrank+-1, 0, 0, yycrank+-27, yysvec+1, 0, yycrank+-3, 0, 0, yycrank+-11, yysvec+3, 0, yycrank+0, 0, yyvstop+1, yycrank+0, 0, yyvstop+3, yycrank+0, 0, yyvstop+6, yycrank+6, 0, yyvstop+8, yycrank+-6, 0, yyvstop+11, yycrank+0, 0, yyvstop+13, yycrank+3, 0, yyvstop+16, yycrank+0, 0, yyvstop+19, yycrank+0, 0, yyvstop+22, yycrank+0, 0, yyvstop+25, yycrank+104, 0, yyvstop+28, yycrank+10, 0, yyvstop+30, yycrank+116, 0, yyvstop+33, yycrank+14, 0, yyvstop+36, yycrank+15, 0, yyvstop+39, yycrank+16, 0, yyvstop+41, yycrank+128, 0, yyvstop+44, yycrank+1, yysvec+21, yyvstop+47, yycrank+0, 0, yyvstop+50, yycrank+1, yysvec+21, yyvstop+53, yycrank+1, yysvec+21, yyvstop+56, yycrank+2, yysvec+21, yyvstop+59, yycrank+3, yysvec+21, yyvstop+62, yycrank+20, yysvec+21, yyvstop+65, yycrank+2, yysvec+21, yyvstop+68, yycrank+7, yysvec+21, yyvstop+71, yycrank+13, yysvec+21, yyvstop+74, yycrank+9, yysvec+21, yyvstop+77, yycrank+20, yysvec+21, yyvstop+80, yycrank+7, 0, yyvstop+83, yycrank+-250, 0, yyvstop+86, yycrank+0, 0, yyvstop+89, yycrank+8, 0, yyvstop+91, yycrank+0, yysvec+16, yyvstop+93, yycrank+0, yysvec+35, yyvstop+95, yycrank+0, 0, yyvstop+98, yycrank+0, yysvec+9, 0, yycrank+0, 0, yyvstop+100, yycrank+0, 0, yyvstop+102, yycrank+0, yysvec+15, yyvstop+104, yycrank+0, 0, yyvstop+106, yycrank+213, 0, yyvstop+108, yycrank+0, yysvec+17, yyvstop+110, yycrank+0, 0, yyvstop+112, yycrank+0, 0, yyvstop+114, yycrank+0, 0, yyvstop+116, yycrank+0, 0, yyvstop+118, yycrank+0, yysvec+21, yyvstop+120, yycrank+6, yysvec+21, yyvstop+122, yycrank+1, yysvec+21, yyvstop+124, yycrank+16, yysvec+21, yyvstop+126, yycrank+19, yysvec+21, yyvstop+128, yycrank+25, yysvec+21, yyvstop+130, yycrank+23, yysvec+21, yyvstop+132, yycrank+0, yysvec+21, yyvstop+134, yycrank+22, yysvec+21, yyvstop+137, yycrank+29, yysvec+21, yyvstop+139, yycrank+24, yysvec+21, yyvstop+141, yycrank+32, yysvec+21, yyvstop+143, yycrank+30, yysvec+21, yyvstop+145, yycrank+42, yysvec+21, yyvstop+147, yycrank+0, 0, yyvstop+149, yycrank+0, yysvec+35, yyvstop+151, yycrank+0, 0, yyvstop+153, yycrank+0, 0, yyvstop+155, yycrank+1, yysvec+21, yyvstop+157, yycrank+34, yysvec+21, yyvstop+159, yycrank+1, yysvec+21, yyvstop+161, yycrank+48, yysvec+21, yyvstop+163, yycrank+53, yysvec+21, yyvstop+165, yycrank+0, yysvec+21, yyvstop+167, yycrank+0, yysvec+21, yyvstop+170, yycrank+60, yysvec+21, yyvstop+173, yycrank+57, yysvec+21, yyvstop+175, yycrank+61, yysvec+21, yyvstop+177, yycrank+81, yysvec+21, yyvstop+179, yycrank+79, yysvec+21, yyvstop+181, yycrank+15, yysvec+21, yyvstop+183, yycrank+0, yysvec+21, yyvstop+185, yycrank+80, yysvec+21, yyvstop+188, yycrank+0, yysvec+21, yyvstop+190, yycrank+73, yysvec+21, yyvstop+193, yycrank+1, yysvec+21, yyvstop+195, yycrank+76, yysvec+21, yyvstop+198, yycrank+75, yysvec+21, yyvstop+200, yycrank+116, yysvec+21, yyvstop+202, yycrank+119, yysvec+21, yyvstop+204, yycrank+110, yysvec+21, yyvstop+206, yycrank+108, yysvec+21, yyvstop+208, yycrank+123, yysvec+21, yyvstop+210, yycrank+151, yysvec+21, yyvstop+212, yycrank+0, yysvec+21, yyvstop+214, yycrank+171, 0, 0, yycrank+143, yysvec+21, yyvstop+217, yycrank+0, yysvec+21, yyvstop+219, yycrank+144, yysvec+21, yyvstop+222, yycrank+0, yysvec+21, yyvstop+224, yycrank+146, yysvec+21, yyvstop+227, yycrank+145, yysvec+21, yyvstop+229, yycrank+144, yysvec+21, yyvstop+231, yycrank+0, yysvec+21, yyvstop+233, yycrank+147, 0, 0, yycrank+161, 0, 0, yycrank+0, yysvec+21, yyvstop+236, yycrank+172, yysvec+21, yyvstop+239, yycrank+165, yysvec+21, yyvstop+241, yycrank+158, yysvec+21, yyvstop+243, yycrank+159, yysvec+21, yyvstop+245, yycrank+160, 0, 0, yycrank+168, 0, 0, yycrank+180, yysvec+21, yyvstop+247, yycrank+0, yysvec+21, yyvstop+249, yycrank+169, yysvec+21, yyvstop+252, yycrank+181, yysvec+21, yyvstop+254, yycrank+185, 0, 0, yycrank+182, 0, 0, yycrank+4, yysvec+21, yyvstop+256, yycrank+0, yysvec+21, yyvstop+258, yycrank+171, yysvec+21, yyvstop+261, yycrank+179, 0, 0, yycrank+0, 0, yyvstop+263, yycrank+189, 0, 0, yycrank+173, yysvec+21, yyvstop+265, yycrank+189, 0, 0, yycrank+187, 0, 0, yycrank+182, 0, 0, yycrank+182, 0, 0, yycrank+191, 0, 0, yycrank+0, yysvec+21, yyvstop+267, yycrank+0, 0, yyvstop+270, yycrank+199, 0, 0, yycrank+183, 0, 0, yycrank+190, 0, 0, yycrank+190, 0, 0, yycrank+188, 0, 0, yycrank+0, 0, yyvstop+272, yycrank+200, 0, 0, yycrank+191, 0, 0, yycrank+0, 0, yyvstop+274, yycrank+0, 0, yyvstop+276, yycrank+190, 0, 0, yycrank+0, 0, yyvstop+278, 0, 0, 0}; struct yywork *yytop = yycrank+315; struct yysvf *yybgin = yysvec+1; unsigned char yymatch[] = { 00 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,011 ,012 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 011 ,01 ,'"' ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , '0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' ,'0' , '0' ,'0' ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,'A' , 01 ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' ,'A' , 'A' ,'A' ,'A' ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 01 ,01 ,01 ,01 ,01 ,01 ,01 ,01 , 0}; unsigned char yyextra[] = { 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,1, 0,0,0,0,0,0,0,0, 0}; /* @(#)44 1.9.2.7 src/bos/usr/ccs/lib/libl/ncform, libl, bos520 3/24/99 08:02:37";*/ /* * COMPONENT_NAME: (LIBL) Lex Libraries * * FUNCTIONS: yylook, yyhlook, yyback, yyinput, yyoutput, yyunput, * yymbinput, yymboutput, yymbunput, yymbreturn * yywinput, yywoutput, yywunput, yywreturn * * ORIGINS: 3 * */ int yylineno =1; wchar_t yywtext[2000]; wchar_t yywbuf[2000]; unsigned char yytbuf[2000]; unsigned char *yytbp; int yytbi; wchar_t yytwc; struct yysvf *yylstate [2000], **yylsp, **yyolsp; unsigned char yysbuf[2000]; unsigned char *yysptr = yysbuf; int *yyfnd; extern struct yysvf *yyestate; int yyprevious = 10; yylook() { register struct yysvf *yystate, **yytlsp; register struct yywork *yyt; struct yysvf *yyz; int yywch, yyfirst, yyw; struct yywork *yyr; wchar_t *yywlastch; /* * start off machines */ yyfirst=1; if (!yymorfg) yywlastch = yywtext; else { yymorfg=0; yywlastch = &(yywtext[yywleng]); } for(;;) { yytlsp = yylstate; yyestate = yystate = yybgin; if (yyprevious==10) yystate++; for (;;) { yyt = yystate->yystoff; if(yyt == yycrank && !yyfirst) /* may not be any transitions */ { yyz = yystate->yyother; if(yyz == 0) break; if(yyz->yystoff == yycrank) break; } yywch = yywinput(); if( (yywlastch - yywtext) < 2000 -1) *yywlastch++ = yywch; else { fprintf(yyout,"LEX Error: input string too long to fit in yywtext[].\n\ Increase the array size by defining YYLMAX to be a higher value\n"); exit(1); } yyfirst=0; tryagain: yyr = yyt; if ( (long)yyt > (long)yycrank) { if (yywch < 4096) /* 8-bit */ { yyt = yyr + yywch; if (yyt <= yytop && yyt->verify+yysvec == yystate) { if(yyt->advance+yysvec == yysvec) /* error transitions */ { yywunput(*--yywlastch); break; } *yytlsp++ = yystate = yyt->advance+yysvec; goto contin; } } } else if ((long)yyt < (long)yycrank) /* r < yycrank */ { yyt = yyr = yycrank+(yycrank-yyt); if (yywch < 4096) /* 8-bit */ { yyt = yyt + yywch; if(yyt <= yytop && yyt->verify+yysvec == yystate) { if(yyt->advance+yysvec == yysvec) /* error transitions */ { yywunput(*--yywlastch); break; } *yytlsp++ = yystate = yyt->advance+yysvec; goto contin; } yyt = yyr + yymatch[yywch]; if(yyt <= yytop && yyt->verify+yysvec == yystate) { if(yyt->advance+yysvec == yysvec) /* error transition */ { yywunput(*--yywlastch); break; } *yytlsp++ = yystate = yyt->advance+yysvec; goto contin; } } } /* r < yycrank */ if ((yystate = yystate->yyother) && (yyt= yystate->yystoff) != yycrank) { goto tryagain; } else { yywunput(*--yywlastch); break; } contin: ; /* contin: */ } /* for(;;) */ while (yytlsp-- > yylstate) { *yywlastch-- = 0; if (*yytlsp != 0 && (yyfnd= (*yytlsp)->yystops) && *yyfnd > 0) { yyolsp = yytlsp; if(yyextra[*yyfnd]) /* must backup */ { while(yyback((*yytlsp)->yystops,-*yyfnd) != 1 && yytlsp > yylstate) { yytlsp--; yywunput(*yywlastch--); } } yyprevious = *yywlastch; yylsp = yytlsp; yywleng = yywlastch-yywtext+1; yywtext[yywleng] = 0; return(yywreturn(*yyfnd++)); } yywunput(*yywlastch); } if (yywtext[0] == 0 /* && feof(yyin) */) { yysptr=yysbuf; return(yywreturn(0)); } yyprevious = yywtext[0] = yywinput(); if (yyprevious>0) yywoutput(yyprevious); yywlastch=yywtext; } /* for (;;) */ return(yywreturn(0)); } int yyback(int *yyp, int yym) { if (yyp==0) return(0); while (*yyp) { if (*yyp++ == yym) return(1); } return(0); } /* * The following are the multi-byte renditions of input, unput, and * output. They are referenced through the winput, wunput, and woutput macros * resepectively. * * A (-1) is returned if the character input is invalid. */ int yywinput() { yytbi=0; do { yytbuf[yytbi++]=(((yytchar=yysptr>yysbuf?((*--yysptr)&0377):script_getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar); yytbuf[yytbi]=0; } while(mbsinvalid((const char *) yytbuf)&&(yytbi0;yytbi--) putc(*yytbp++,yyout); } void yywunput(int yyc) { for(yytbi=wctomb((char *)yytbuf,(wchar_t)yyc)-1;yytbi>=0;yytbi--) {yytchar= (yytbuf[yytbi]);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}; } /* * Convert yywtext to yytext prior to returning from yylook. It is referenced * through the wreturn macro. */ int yywreturn(int yyr) { yyleng=wcstombs((char *)yytext,yywtext,2000); if(yyleng<0) { yyleng=0; yytext[0]=0; } return(yyr); } /* * the following are only used in the lex library */ int yyinput() { return((((yytchar=yysptr>yysbuf?((*--yysptr)&0377):script_getc(yyin))==10?(yylineno++,yytchar):yytchar)==EOF?0:yytchar)); } void yyoutput(int yyc) { putc(yyc,yyout); } void yyunput(int yyc) { {yytchar= (yyc);if(yytchar=='\n')yylineno--;*yysptr++=yytchar;}; } int yymbinput() { return(yywinput()); } void yymboutput(int yyc) { yywoutput(yyc); } void yymbunput(int yyc) { yywunput(yyc); } int yymbreturn(int yyx) { return(yywreturn(yyx)); } /* A little print routine used for debugging. */ pr (name, val) char *name; long val; { if (Verbose) printf ("value of production %s = %ld in line %d \n", name, val, lineno); return 0; } /* Execute the program with the given intepreter state. */ int execute (state) Interpreter_State *state; { return execute_inner ( &(state->program), &(state->stack) ); } /* end of execute */ /* Execute the program with the given stack. */ int execute_inner (program, stack) Instruction_Store *program; Data_Stack *stack; { if (program->pc == -1) { return 0; } /* Execute until you hit a null operation. */ while (program->i[program->pc].operation != NULL) { if (Verbose) printf ( "pc = %ld top = %ld source line %ld\n", program->pc, (long)(stack->top - stack->d), program->i[program->pc].source_line); /* This is where it all happens. Call the routine that executes this instruction. */ (program->i[program->pc].operation)(program, stack); (program->pc)++; } /* printf("execute_inner returning %d\n", program->i[program->pc].d.slong); */ return program->i[program->pc].d.slong; } /* end of execute_inner */ /* Find datum with given name in the symbol list. */ Datum * find_symbol (symbol_list, name) Symbol_Store *symbol_list; char *name; { int i; for (i = 0; i < symbol_list->num_symbols; i++) { if (strcmp (name, symbol_list->symbol[i].name) == 0) { return &(symbol_list->symbol[i]); } } fprintf (stderr, "Unable to find symbol <%s>\n", name); return NULL; } /* end of find_symbol */ /* Add an instruction to the program. */ long add_inst (program, op) Instruction_Store *program; int (*op)(); { long rtn = program->next_compiled_instruction; if (Verbose) printf ("adding instruction at %ld (source line %d)\n", rtn, lineno); /* Note that we track the source line number */ program->i[program->next_compiled_instruction].source_line = lineno; /* add the function pointer to the instruction. */ program->i[program->next_compiled_instruction++].operation = op; return rtn; } /* end of add_inst */ /* Add a binary operation to the program. */ long add_inst_binop (program, op) Instruction_Store *program; int op; { long rtn = program->next_compiled_instruction; if (Verbose) printf ("adding unop instruction %d at %ld\n", op, rtn); program->i[program->next_compiled_instruction].source_line = lineno; /* The function binary_op does all of the binary operations. */ program->i[program->next_compiled_instruction].operation = binary_op; /* This indicates which binary operation is to be performed. */ program->i[program->next_compiled_instruction].d.slong = op; program->next_compiled_instruction++; return rtn; } /* end of add_inst_unop */ /* Add a unary operation. */ long add_inst_unop (program, op) Instruction_Store *program; int op; { long rtn = program->next_compiled_instruction; if (Verbose) printf ("adding binop instruction %d at %ld\n", op, rtn); program->i[program->next_compiled_instruction].source_line = lineno; /* The function unary_op does all of the unary operations. */ program->i[program->next_compiled_instruction].operation = unary_op; /* Indicates which unary operation is to be performed. */ program->i[program->next_compiled_instruction].d.slong = op; program->next_compiled_instruction++; return rtn; } /* end of add_inst_unop */ /* Adds the instruction to terminate the execution of the program. */ /* int xxxadd_program_termination (state) Interpreter_State *state; { return (int) add_inst (&(state->program), NULL); } */ /* Add a return instruction. The operation pointer is set to NULL, which causes the routine execute to return. The return value of execute is taken from the datum slong field. */ long add_inst_return (program) Instruction_Store *program; { long rtn = program->next_compiled_instruction; if (Verbose) printf ("adding return instruction at %ld\n", rtn); program->i[program->next_compiled_instruction].source_line = lineno; /* The function binary_op does all of the binary operations. */ program->i[program->next_compiled_instruction].operation = NULL; /* This indicates which binary operation is to be performed. */ program->i[program->next_compiled_instruction].d.slong = 1; program->next_compiled_instruction++; return rtn; } /* end of add_inst_return */ /* Add a return instruction. The operation pointer is set to NULL, which causes the routine execute to return. The return value of execute is taken from the datum slong field. */ long add_inst_execution_done (state) Interpreter_State *state; { long rtn = state->program.next_compiled_instruction; if (Verbose) printf ("adding execution done instruction at %ld\n", rtn); state->program.i[state->program.next_compiled_instruction].source_line = lineno; /* The function binary_op does all of the binary operations. */ state->program.i[state->program.next_compiled_instruction].operation = NULL; /* This indicates which binary operation is to be performed. */ state->program.i[state->program.next_compiled_instruction].d.slong = 1; state->program.next_compiled_instruction++; return rtn; } /* end of add_inst_execution_done */ /* Initialize the machine: clear the program and the stack, prepare to parse. */ int reset_interpreter_machine (state) Interpreter_State *state; { int rtn; yylineno = 1; rtn = reinitialize_symbol_store (state, state->mpiNumProcs, state->mpiRank); Verbose = state->verbose; /* Verbose = 1; */ /* printf ("In reset_ Verbose = %d\n", Verbose); */ if (Verbose) printf("reset_interpreter_machine called **********************\n"); state->program.next_compiled_instruction = 0; state->program.pc = 0; state->stack.top = state->stack.d; state->stack.top_index = 0; LY_Program = &(state->program); LY_Symbols = &(state->symbols); LY_Script = &(state->script); return rtn; } /* Dereference a Datum. A datum may be a reference to another datum. This routine follows the chain of references to a datum that is not a reference. */ Datum * dereference (d) Datum *d; { Datum *base; base = d; while (base->type == -6) { base = base->ref; } return base; } /* end of dereference*/ /* This routine executes the push instruction. It pushs the datum that is at the current program instruction onto the top of the the stack. */ int push (program, stack) Instruction_Store *program; Data_Stack *stack; { if (Verbose) printf ("push\n"); if (stack->top == NULL) { stack->top = stack->d; } else { stack->top++; } stack->top->type = -6; stack->top->ref = &(program->i[program->pc].d); return 0; } /* end of push */ /* Adds an instruction to the program that pushs a symbol. */ long add_inst_pushsym (program, name) Instruction_Store *program; char *name; { Datum *d; long rtn; rtn = program->next_compiled_instruction; if (Verbose) printf ("adding instruction at %ld\n", rtn); if (Verbose) printf ("pushing symbol <%s>\n", name); /* finds datum for the symbol name */ d = find_symbol (LY_Symbols, name); if (d == NULL) { fprintf (stderr, "Unable to find symbol < %s >.\n", name); fprintf (stderr, " Substituting scalar value 0."); d = &Long_Zero; } /* puts reference to that symbol into the instruction */ program->i[program->next_compiled_instruction].d.ref = d; program->i[program->next_compiled_instruction].d.type = -6; program->i[program->next_compiled_instruction].source_line = lineno; program->i[program->next_compiled_instruction++].operation = push; return rtn; } /* Adds an instruction to the program that pushs a character string. */ long add_inst_pushstring (program, str) Instruction_Store *program; char *str; { long rtn; rtn = program->next_compiled_instruction; if (Verbose) printf ("adding instruction at %ld\n", rtn); if (Verbose) printf ("pushing string <%s>\n", str); /* Put the string into the datum at this instruction */ make_string_datum (str, "", &(program->i[program->next_compiled_instruction].d) ); program->i[program->next_compiled_instruction].source_line = lineno; program->i[program->next_compiled_instruction].operation = push; program->next_compiled_instruction++; return rtn; } /* Adds an instruction to the program that pushs a long. */ long add_inst_pushlval (program, l) Instruction_Store *program; long l; { long rtn; rtn = program->next_compiled_instruction; if (Verbose) printf ("adding instruction at %ld\n", rtn); if (Verbose) printf ("pushing long value %ld\n", l); /* Put the long value into the datum at this instruction. */ make_long_datum (l, "", &(program->i[program->next_compiled_instruction].d) ); program->i[program->next_compiled_instruction].source_line = lineno; program->i[program->next_compiled_instruction++].operation = push; return rtn; } /* Adds an instruction to the program that pushs a long long. */ long add_inst_pushllval (program, l) Instruction_Store *program; long long l; { long rtn; rtn = program->next_compiled_instruction; if (Verbose) printf ("adding instruction at %ld\n", rtn); if (Verbose) printf ("pushing long long value %lld\n", l); /* Put the long long value into the datum at this instruction. */ make_long_long_datum (l, "", &(program->i[program->next_compiled_instruction].d) ); program->i[program->next_compiled_instruction].source_line = lineno; program->i[program->next_compiled_instruction++].operation = push; return rtn; } /* Adds an instruction to the program that pushs a double. */ long add_inst_pushdval (program, d) Instruction_Store *program; double d; { long rtn; rtn = program->next_compiled_instruction; if (Verbose) printf ("adding instruction at %ld\n", rtn); if (Verbose) printf ("pushing double value %lf\n", d); /* Put the double value into the datum at this instruction. */ make_double_datum (d, "", &(program->i[program->next_compiled_instruction].d) ); program->i[program->next_compiled_instruction].source_line = lineno; program->i[program->next_compiled_instruction++].operation = push; return rtn; } /* Execute the assign instruction. */ int assign (program, stack) Instruction_Store *program; Data_Stack *stack; { Datum *target, *source; int i; void *tp, *sp; if (Verbose) printf ("assign\n"); source = stack->top; target = stack->top - 1; /* dereference */ while (target->type == -6) { target = target->ref; } if (target->constant) { fprintf (stderr, "Illegal assignment to a constant.\n"); return -1; } /* dereference */ while (source->type == -6) { source = source->ref; } /* This is wildly inefficient. */ if ((target->storage_type == 3) && (source->storage_type == 3)) { /* Do assignment array to array */ if (target->array_length != source->array_length) { fprintf (stderr, "Illegal assignment of arrays of different lengths.\n"); return -1; } for (i = 0; i < target->array_length; i++) { get_data_primitive_address (target, i, &tp); get_data_primitive_address (source, i, &sp); assign_by_type (tp, target->type, sp, source->type); } } else if (target->storage_type == 3) { /* scalar to array */ get_data_primitive_address (source, 0, &sp); for (i = 0; i < target->array_length; i++) { get_data_primitive_address (target, i, &tp); assign_by_type (tp, target->type, sp, source->type); } } else { /* scalar to scalar */ get_data_primitive_address (target, 0, &tp); get_data_primitive_address (source, 0, &sp); assign_by_type (tp, target->type, sp, source->type); } /* Fix the stack */ stack->top--; stack->top->type = -6; stack->top->ref = target; return 0; } /* Execute the subscript instruction. */ int subscript (program, stack) Instruction_Store *program; Data_Stack *stack; { Datum *a, *b; long index; void *bp; void *ap; if (Verbose) printf ("subscript\n"); /* Get top two data items from stack */ if (get_two_operands (stack, &a, &b)) { fprintf (stderr, "Error getting operands for subscript.\n"); return (-1); } /* b is the subscript; a is the object to be subscripted. */ if (b->storage_type == 3) { fprintf (stderr, "Can't use an array as a subscript.\n"); stack->top--; return (-1); } if (!(a->storage_type == 3)) { fprintf (stderr, "Attempted to subscript a non-array.\n"); stack->top--; return (-1); } /* convert b to a long */ get_data_primitive_address (b, 0, &bp); assign_by_type (&index, 270, bp, b->type); /* check if it exceeds array bounds */ if (index >= a->array_length || index < 0) { fprintf (stderr, "Array index %ld is out of bounds.\n", index); stack->top--; return (-1); } /* Get the b'th element of a */ get_data_primitive_address (a, index, &ap); stack->top--; /* Put it on the top of the stack */ /* Note that the datum on the stack is a pointer to the subscripted element. */ stack->top->type = a->type; stack->top->constant = a->constant; stack->top->storage_type = 2; sprintf (stack->top->name, "%s [ %ld ]", a->name, index); stack->top->ptr = ap; return 0; } /* end of subscript */ /* Executes the function call instruction. Note that only predefined functions are available. The user cannot define his or her own functions. */ int call_func (program, stack) Instruction_Store *program; Data_Stack *stack; { long int func_rtn; Datum *d; if (Verbose) printf ("call_func\n"); /* The top element of the stack should indicate the function to be called. */ d = dereference (stack->top); if (d == NULL) { fprintf (stderr, "Unable to find symbol < %s >. \n", stack->top->name); stack->top = stack->top - (dereference(stack->top-1)->slong + 1); make_long_datum (0L, "", stack->top); return (-1); } if (d->type != -7) { fprintf (stderr, "Symbol < %s > is being used as a function name" , d->name); fprintf (stderr, " but is not a function.\n"); stack->top = stack->top - (dereference(stack->top-1)->slong + 1); make_long_datum (0L, "", stack->top); return (-1); } /* Call the function. All such functions are passed the stack. They are responsible for getting necessary info from the stack. All functions return a long which is put onto the stack. */ func_rtn = (d->func)(stack); /* Roll back the stack to remove the function args */ /* Note that stack->top-1 contains the number of arguments to the function. The number of items on the stack associated with this function call is the number of arguments + 2 (one for the entry indicating the number of args and one for the pointer to the function itself). We roll back one fewer than this so that top will point to a free element for the function return value. */ stack->top = stack->top - (dereference(stack->top-1)->slong + 1); /* Top is now pointing at the first free entry. Put the function return value there. */ make_long_datum (func_rtn, "", stack->top); return 0; } /* This is the function that corresponds to the "print" function. It prints the top thing on the stack before the arg count. */ int print_wrapper (stack) Data_Stack *stack; { Datum *a; a = dereference (stack->top - 2); brief_dump_datum (a); return 1; } /* end of print_wrapper */ int sleep_wrapper (stack) Data_Stack *stack; { sleep (3); return 0; } /* This is the function that corresponds to the "printf" function. It sends the argument list to printf, all numeric args are changed to doubles. */ int printf_wrapper (stack) Data_Stack *stack; { Datum *arg, *f; int i; int nargs; /* int total_args; */ /* long double a[10]; */ double a[10]; /* float a[10]; */ char *fmt_str; int rtn; int arg_index; /* stack->top-1 is the number of args: N stack->top-2 is the Nth arg stack->top-3 is the N-1th arg etc. */ /* total_args = dereference(stack->top-1)->slong; */ /* Get the number of arguments; but we'll only handle up to 10 */ nargs = (((10)<(dereference(stack->top-1)->slong))?(10):(dereference(stack->top-1)->slong)); if (nargs == 0) { printf ("\n"); return 0; } /* first argument: should be the format string */ arg = (stack->top-1) - dereference(stack->top-1)->slong; arg_index = 1 + dereference(stack->top-1)->slong; f = dereference (arg); if (f->type != 261) { fprintf (stderr, "Error: first argument to printf must be a string.\n"); return (-1); } fmt_str = f->str; /* Get numeric values for subsequent args */ for (i = 0; i < nargs-1; i++) { arg = stack->top - (--arg_index); arg = dereference (arg); a[i] = ldble (arg); } /* Now call printf with the appropriate number of args */ switch (nargs) { case 1: rtn = printf (fmt_str); break; case 2: rtn = printf (fmt_str, a[0]); break; case 3: rtn = printf (fmt_str, a[0], a[1]); break; case 4: rtn = printf (fmt_str, a[0], a[1], a[2]); break; case 5: rtn = printf (fmt_str, a[0], a[1], a[2], a[3]); break; case 6: rtn = printf (fmt_str, a[0], a[1], a[2], a[3], a[4]); break; case 7: rtn = printf (fmt_str, a[0], a[1], a[2], a[3], a[4], a[5]); break; case 8: rtn = printf (fmt_str, a[0], a[1], a[2], a[3], a[4], a[5], a[6]); break; case 9: rtn = printf (fmt_str, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7]); break; case 10: rtn = printf (fmt_str, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); break; } return rtn; } /* end of printf_wrapper */ void send_report (stack, level) Data_Stack *stack; int level; { Datum *rr; int rank; char msg[256]; sprintf_interp (msg, stack); rr = find_symbol (&(stack->interpreter->symbols), "__mpiRank__"); if (rr == NULL) { rank = -1; } else { rank = slong (rr); } send_report_inner (stack->interpreter, level, rank, msg, NULL); } /* end of send_report */ /* This is the function that reports that the test passed. */ int report_pass (stack) Data_Stack *stack; { send_report (stack, 0); return 0; } /* end of report_pass */ int report_fail (stack) Data_Stack *stack; { send_report (stack, 4); return 0; } /* end of report_fail */ int report_indeterminate (stack) Data_Stack *stack; { send_report (stack, 3); return 0; } /* end of report_indeterminate */ int report_info (stack) Data_Stack *stack; { send_report (stack, 0); return 0; } /* end of report_info */ int report_error (stack) Data_Stack *stack; { send_report (stack, 4); return 0; } /* end of report_error */ int sprintf_interp (msg, stack) char *msg; Data_Stack *stack; { Datum *arg, *f; int i; int nargs; /* int total_args; */ /* long double a[10]; */ double a[10]; /* float a[10]; */ char *fmt_str; int rtn; int arg_index; /* stack->top-1 is the number of args: N stack->top-2 is the Nth arg stack->top-3 is the N-1th arg etc. */ /* total_args = dereference(stack->top-1)->slong; */ /* Get the number of arguments; but we'll only handle up to 10 */ nargs = (((10)<(dereference(stack->top-1)->slong))?(10):(dereference(stack->top-1)->slong)); if (nargs == 0) { msg[0] = 0; return 0; } /* first argument: should be the format string */ arg = (stack->top-1) - dereference(stack->top-1)->slong; arg_index = 1 + dereference(stack->top-1)->slong; f = dereference (arg); if (f->type != 261) { fprintf (stderr, "Error: first argument to sprintf must be a string.\n"); return (-1); } fmt_str = f->str; /* Get numeric values for subsequent args */ for (i = 0; i < nargs-1; i++) { arg = stack->top - (--arg_index); arg = dereference (arg); a[i] = ldble (arg); } /* Now call printf with the appropriate number of args */ switch (nargs) { case 1: rtn = sprintf (msg, fmt_str); break; case 2: rtn = sprintf (msg, fmt_str, a[0]); break; case 3: rtn = sprintf (msg, fmt_str, a[0], a[1]); break; case 4: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2]); break; case 5: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2], a[3]); break; case 6: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2], a[3], a[4]); break; case 7: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2], a[3], a[4], a[5]); break; case 8: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2], a[3], a[4], a[5], a[6]); break; case 9: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7]); break; case 10: rtn = sprintf (msg, fmt_str, a[0], a[1], a[2], a[3], a[4], a[5], a[6], a[7], a[8]); break; } return rtn; } /* end of printf_wrapper */ /* Executes the pop instruction. */ int pop (program, stack) Instruction_Store *program; Data_Stack *stack; { if (Verbose) printf ("pop\n"); stack->top--; return 0; } /* This is the error function called from the yacc-generated code. */ int yyerror (char *s) { fprintf (stderr, "Yacc error at line %d : < %s >\n", lineno, s); return 0; } /* Converts a pointer to a numeric to a double value. */ double to_double (p, type) void *p; int type; { double result; switch (type) { case 269: result = *((int *)p); break; case 268: result = *((short *)p); break; case 270: result = *((long *)p); break; case 271: result = *((long long*)p); break; case 276: result = *((float *)p); break; case 277: result = *((double *)p); break; default: fprintf (stderr, "Invalid data type found. Zero value substituted.\n"); result = 0.0; break; } return result; } /* end of to_double */ /* Converts a datum to a double. */ double datum_to_double (d) Datum *d; { void *dp; d = dereference (d); get_data_primitive_address (d, 0, &dp); return to_double (dp, d->type); } /* end of datum_to_double */ /* Calculates a pointer to a single primitive data item indicated by a Datum and an index. If the Datum is a scalar, the index must be zero. */ int get_data_primitive_address (b, index, bp) Datum *b; int index; void **bp; { b = dereference (b); if ( (b->storage_type == 1) || (b->storage_type == 2) ) { if (index != 0) { fprintf (stderr, "Index %d is not valid for scalar data item %s\n", index, b->name); fprintf (stderr, " Scalar value will be used.\n"); } } if (b->storage_type == 1) { switch (b->type) { case 267: *bp = &(b->schar); break; case 269: *bp = &(b->sint); break; case 268: *bp = &(b->sshort); break; case 270: *bp = &(b->slong); break; case 271: *bp = &(b->llong); break; case 272: *bp = &(b->uchar); break; case 274: *bp = &(b->uint); break; case 273: *bp = &(b->ushort); break; case 275: *bp = &(b->ulong); break; case 276: *bp = &(b->flt); break; case 277: *bp = &(b->dble); break; case 278: *bp = &(b->ldble); break; case 261: *bp = (b->str); break; case 279: *bp = &(b->mpi_request); break; case 280: *bp = &(b->mpi_group); break; case 281: *bp = &(b->mpi_comm); break; default: fprintf (stderr, "Invalid data type.\n"); *bp = NULL; return (-1); } } else { switch (b->type) { case 267: *bp = ((char *)b->ptr) + index; break; case 269: *bp = ((int *)b->ptr) + index; break; case 268: *bp = ((short *)b->ptr) + index; break; case 270: *bp = ((long *)b->ptr) + index; break; case 271: *bp = ((long long *)b->ptr) + index; break; case 272: *bp = ((unsigned char *)b->ptr) + index; break; case 274: *bp = ((unsigned int *)b->ptr) + index; break; case 273: *bp = ((unsigned short *)b->ptr) + index; break; case 275: *bp = ((unsigned long *)b->ptr) + index; break; case 276: *bp = ((float *)b->ptr) + index; break; case 277: *bp = ((double *)b->ptr) + index; break; case 278: *bp = ((long double *)b->ptr) + index; break; case 279: *bp = ((MPI_Request *)b->ptr) + index; break; case 280: *bp = ((MPI_Group *)b->ptr) + index; break; case 281: *bp = ((MPI_Comm *)b->ptr) + index; break; default: fprintf (stderr, "Invalid data type.\n"); *bp = NULL; return (-1); } } return 1; } /* end of get_data_primitive_address */ /* Creates a scalar datum of the indicated type and name. Numeric types are given a value 0; strings are given a value of an empty string. */ int make_scalar_datum (state, d, type, name) Interpreter_State *state; Datum *d; int type; char *name; { d->type = type; d->constant = 0; d->storage_type = 1; d->ptr = NULL; strcpy (d->name, name); switch (type) { case 267: d->schar = 0; break; case 269: d->sint = 0; break; case 268: d->sshort = 0; break; case 270: d->slong = 0; break; case 271: d->llong = 0; break; case 272: d->uchar = 0; break; case 274: d->uint = 0; break; case 273: d->ushort = 0; break; case 275: d->ulong = 0; break; case 276: d->flt = 0; break; case 277: d->dble = 0; break; case 278:d->ldble = 0; break; case 261: d->str[0] = 0; break; case 279: break; case 280: d->mpi_group = MPI_GROUP_NULL; break; case 281: d->mpi_comm = MPI_COMM_NULL; break; } return 0; } /* end of make_scalar_datum */ /* Creates a scalar datum of the indicated type, name, and length. Can't create arrays of anything but numerics. */ int make_array_datum (state, d, type, name, length) Interpreter_State *state; Datum *d; int type; char *name; long length; { int item_size; int i; d->type = type; d->constant = 0; d->storage_type = 3; strcpy (d->name, name); d->array_length = length; switch (type) { case 267: item_size = sizeof(char); break; case 269: item_size = sizeof(int); break; case 268: item_size = sizeof(short); break; case 270: item_size = sizeof(long); break; case 271: item_size = sizeof(long long); break; case 272: item_size = sizeof(unsigned char); break; case 274: item_size = sizeof(unsigned int); break; case 273: item_size = sizeof(unsigned short); break; case 275: item_size = sizeof(unsigned long); break; case 276: item_size = sizeof(float); break; case 277: item_size = sizeof(double); break; case 278:item_size = sizeof(long double); break; case 279:item_size = sizeof(MPI_Request); break; case 280: item_size = sizeof(MPI_Group); break; case 281: item_size = sizeof(MPI_Comm); break; case 261: d->ptr = NULL; fprintf (stderr, "Error: Cannot allocate string array.\n"); return (-1); } d->ptr = (void *) malloc (length*item_size); if (d->ptr == NULL) { return 1; } return 0; } /* end of make_array_datum */ /* Make a double Datum with a given name and value. */ int make_double_datum (dval, name, d) double dval; char *name; Datum *d; { d->type = 277; d->constant = 0; d->storage_type = 1; strcpy (d->name, name); d->dble = dval; return 0; } /* end of make_double_datum */ /* Make a long Datum with a given name and value. */ int make_long_datum (lval, name, d) long lval; char *name; Datum *d; { d->type = 270; d->constant = 0; d->storage_type = 1; strcpy (d->name, name); d->slong = lval; return 0; } /* end of make_long_datum */ /* Make a long long Datum with a given name and value. */ int make_long_long_datum (llval, name, d) long long llval; char *name; Datum *d; { d->type = 271; d->constant = 0; d->storage_type = 1; strcpy (d->name, name); d->llong = llval; return 0; } /* end of make_long_long_datum */ /* Make a MPI_Group Datum with a given name and value. */ int make_mpigroup_datum (llval, name, d) MPI_Group llval; char *name; Datum *d; { d->type = 280; d->constant = 0; d->storage_type = 1; strcpy (d->name, name); d->mpi_group = llval; return 0; } /* end of make_mpigroup_datum */ /* Make a MPI_Comm Datum with a given name and value. */ int make_mpicomm_datum (llval, name, d) MPI_Comm llval; char *name; Datum *d; { d->type = 281; d->constant = 0; d->storage_type = 1; strcpy (d->name, name); d->mpi_comm = llval; return 0; } /* end of make_mpicomm_datum */ /* Make a string Datum with a given name and value. */ int make_string_datum (str, name, d) char *str; char *name; Datum *d; { char *targ, *src; d->type = 261; d->constant = 1; /* currently all strings are constants */ d->storage_type = 1; strcpy (d->name, name); /* strcpy (d->str, str); */ targ = d->str; src = str; /* transfer the string. Handle stuff like \n */ while (*src) { if (*src != '\\') { *targ++ = *src++; } else { src++; switch (*src) { case 'n': *targ++ = '\n'; break; case 't': *targ++ = '\t'; break; case 'b': *targ++ = '\b'; break; case 'r': *targ++ = '\r'; break; case 'f': *targ++ = '\f'; break; case '\\': *targ++ = '\\'; break; default: *targ++ = '\\'; *targ++ = *src; } src++; } } *targ = 0; return 0; } /* end of make_string_datum */ /* Make a function Datum with a given name and function pointer. */ int make_func_datum (func, name, d) int (*func)(); char *name; Datum *d; { d->type = -7; d->constant = 1; strcpy (d->name, name); d->func = func; return 0; } /* end of make_func_datum */ /* Get the top two elements of the stack, fully dereferenced. Does not change stack pointer. */ int get_two_operands (stack, a, b) Data_Stack *stack; Datum **a; Datum **b; { *a = dereference (stack->top); *b = dereference (stack->top - 1); return 0; } /* end of get_two_operands */ /* Assign a primitive data item of one type to a primitive data item of another type. */ int assign_by_type(target, target_type, source, source_type) void *target; int target_type; void *source; int source_type; { long long ll; unsigned long u; long double d; long double str_d; if (Verbose) printf ( "assignment: target at %p of type %d = source at %p of type %d\n", target, target_type, source, source_type); if (source_type == 261) { sscanf (source, "%Lf", &str_d); source = &str_d; source_type = 278; } /* To simplify things, we promote the source to long, unsigned long, or long double depending on the type of the target. We then assign this promoted value to the target. */ switch (target_type) { case 267: case 268: case 269: case 270: case 271: switch (source_type) { case 267: ll = *((char *) source); break; case 268: ll = *((short *) source); break; case 269: ll = *((int *) source); break; case 270: ll = *((long *) source); break; case 271: ll = *((long long *) source); break; case 272: ll = *((unsigned char *) source); break; case 273: ll = *((unsigned short *) source); break; case 274: ll = *((unsigned int *) source); break; case 275: ll = *((unsigned long *) source); break; case 276: ll = *((float *) source); break; case 277: ll = *((double *) source); break; case 278: ll = *((long double *) source); break; } break; case 272: case 273: case 274: case 275: switch (source_type) { case 267: u = *((char *) source); break; case 268: u = *((short *) source); break; case 269: u = *((int *) source); break; case 270: u = *((long *) source); break; case 271: u = *((long long *) source); break; case 272: u = *((unsigned char *) source); break; case 273: u = *((unsigned short *) source); break; case 274: u = *((unsigned int *) source); break; case 275: u = *((unsigned long *) source); break; case 276: u = *((float *) source); break; case 277: u = *((double *) source); break; case 278: u = *((long double *) source); break; } break; case 276: case 277: case 278: switch (source_type) { case 267: d = *((char *) source); break; case 268: d = *((short *) source); break; case 269: d = *((int *) source); break; case 270: d = *((long *) source); break; case 271: d = *((long long *) source); break; case 272: d = *((unsigned char *) source); break; case 273: d = *((unsigned short *) source); break; case 274: d = *((unsigned int *) source); break; case 275: d = *((unsigned long *) source); break; case 276: d = *((float *) source); break; case 277: d = *((double *) source); break; case 278: d = *((long double *) source); break; } break; } /* now assign to target */ switch (target_type) { case 267: *((char *) target) = ll; break; case 268: *((short *) target) = ll; break; case 269: *((int *) target) = ll; break; case 270: *((long *) target) = ll; break; case 271: *((long long*) target) = ll; break; case 272: *((unsigned char *) target) = u; break; case 273: *((unsigned short *) target) = u; break; case 274: *((unsigned int *) target) = u; break; case 275: *((unsigned long *) target) = u; break; case 276: *((float *) target) = d; break; case 277: *((double *) target) = d; break; case 278: *((long double *) target) = d; break; case 280: if (source_type == 280) { *((MPI_Group *) target) = *((MPI_Group *) source); } break; case 281: if (source_type == 281) { *((MPI_Comm *) target) = *((MPI_Comm *) source); } break; } return 0; } /* end of assign_by_type */ initialize_interpreter_state (Interpreter_State *state, int verbose, int mpiNumProcs, int mpiRank, MPI_Comm mpi_comm_world) { if (verbose) { printf ("Entered initialize_interpreter_state\n"); } state->verbose = verbose; state->mpi_comm_world = mpi_comm_world; /* We need to be able to get back to the interpreter state from each of the components. This would not be necessary if I had coded with multi-threading in mind from the start. */ state->stack.interpreter = state; state->program.interpreter = state; state->symbols.interpreter = state; state->script.interpreter = state; state->mpiRank = mpiRank; state->mpiNumProcs = mpiNumProcs; if (make_scalar_datum (state, &Long_Zero, 270, "")) { return -1; } if (verbose) { printf ( "initialize_interpreter_state: about to init symbol store.\n"); } return initialize_symbol_store (state, mpiNumProcs, mpiRank, mpi_comm_world); } /* end of initialize_interpreter_state */ /* Set up the pre-defined symbols. These include : All predefined functions like printf and exit All MPI constants like MPI_SUCCESS */ initialize_symbol_store (Interpreter_State *state, int mpiNumProcs, int mpiRank, MPI_Comm mpi_comm_world) { /* long lval; */ /* double dval; */ /* char name[128]; */ Datum *sym; int log_error (); if (state->verbose) { printf ("initialize_symbol_store: start\n"); } state->symbols.num_symbols = 0; /* We will make all single letter, lower-case names be scalar variables, with types either long or double according to fortran naming conventions */ /* lval = 0; */ /* dval = 0.0; */ /* name[1] = 0; */ /* add all of the MPI symbols */ initialize_mpi_symbols (&(state->symbols), (long)mpiNumProcs, (long)mpiRank, mpi_comm_world); if (state->verbose) { printf ("initialize_symbol_store: done with mpi_symbols\n"); } /* Now we will add the functions */ /* print (d) */ sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "print"); sym->func = print_wrapper; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "printf"); sym->func = printf_wrapper; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "sleep"); sym->func = sleep_wrapper; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "report_pass"); sym->func = report_pass; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "report_fail"); sym->func = report_fail; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "report_indeterminate"); sym->func = report_indeterminate; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "report_info"); sym->func = report_info; sym = &(state->symbols.symbol[(state->symbols.num_symbols)++]); sym->type = -7; sym->constant = 1; strcpy (sym->name, "report_error"); sym->func = report_error; if (state->verbose) { printf ("initialize_symbol_store: done \n"); } /* THAT'S ALL FOR NOW */ return 0; } /* end of initialize_symbol_store */ void dealloc_symbol_store (symbol_store) Symbol_Store *symbol_store; { int i; Datum *sym; sym = symbol_store->symbol; for (i = 0; i < symbol_store->num_symbols; i++) { sym = &(symbol_store->symbol[i]); if ((sym->storage_type == 3) && (sym->name[0] != 0)) { if (sym->ptr != NULL) { free (sym->ptr); } } } symbol_store->num_symbols = 0; } /* end of dealloc_symbol_store */ int reinitialize_symbol_store (Interpreter_State *state, int mpiNumProcs, int mpiRank) { dealloc_symbol_store (&(state->symbols)); return initialize_symbol_store (state, mpiNumProcs, mpiRank, state->mpi_comm_world); } /* end of reinitialize_symbol_store */ /* This function prints out a complete description of a Datum. It is intended for debugging. */ int dump_datum (d) Datum *d; { int i; void *p; char arr_fmt[80]; char scalar_fmt[80]; printf ("Datum at %p: name = <%s>\n", (void *)d, d->name); if ( (d->type != -6) && (d->type != -7)) { printf ("\tconstant = %s\n", d->constant ? "TRUE" : "FALSE"); switch (d->storage_type) { case 1: printf ("\tstorage_type = SCALAR_VALUE\n"); break; case 2: printf ("\tstorage_type = SCALAR_REFERENCE\n"); break; case 3: printf ("\tstorage_type = ARRAY\n"); printf ("\tarray_length = %d\n", d->array_length); break; default: printf ("\tstorage_type = UNKNOWN -- ERROR!! \n"); break; } } switch (d->type) { case 267: printf ("\ttype = CHAR\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%d"); sprintf (scalar_fmt, "\t value = %s\n", "%d"); break; case 269: printf ("\ttype = INT\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%d"); sprintf (scalar_fmt, "\t value = %s\n", "%d"); break; case 268: printf ("\ttype = SHORT\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%d"); sprintf (scalar_fmt, "\t value = %s\n", "%d"); break; case 270: printf ("\ttype = LONG\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%ld"); sprintf (scalar_fmt, "\t value = %s\n", "%ld"); break; case 271: printf ("\ttype = LONG LONG\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%lld"); sprintf (scalar_fmt, "\t value = %s\n", "%lld"); break; case 272: printf ("\ttype = UCHAR\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%u"); sprintf (scalar_fmt, "\t value = %s\n", "%u"); break; case 274: printf ("\ttype = UINT\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%u"); sprintf (scalar_fmt, "\t value = %s\n", "%u"); break; case 273: printf ("\ttype = USHORT\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%u"); sprintf (scalar_fmt, "\t value = %s\n", "%u"); break; case 275: printf ("\ttype = ULONG\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%lu"); sprintf (scalar_fmt, "\t value = %s\n", "%lu"); break; case 276: printf ("\ttype = FLOAT\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%f"); sprintf (scalar_fmt, "\t value = %s\n", "%f"); break; case 277: printf ("\ttype = DOUBLE\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%lf"); sprintf (scalar_fmt, "\t value = %s\n", "%lf"); break; case 278: printf ("\ttype = LONGDOUBLE\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%Lf"); sprintf (scalar_fmt, "\t value = %s\n", "%Lf"); break; case 279: printf ("\ttype = MPIREQUEST\n"); sprintf (arr_fmt, "\t[%%d] loc = %s\n", "%p"); sprintf (scalar_fmt, "\t loc = %s\n", "%p"); break; case 280: printf ("\ttype = MPIGROUP\n"); sprintf (arr_fmt, "\t[%%d] loc = %s\n", "%p"); sprintf (scalar_fmt, "\t loc = %s\n", "%p"); break; case 281: printf ("\ttype = MPICOMM\n"); sprintf (arr_fmt, "\t[%%d] loc = %s\n", "%p"); sprintf (scalar_fmt, "\t loc = %s\n", "%p"); break; case 261: printf ("\ttype = STRING\n"); sprintf (arr_fmt, "\t[%%d] = %s\n", "%s"); sprintf (scalar_fmt, "\t value = %s\n", "%s"); break; } get_data_primitive_address (d, 0, &p); if (d->storage_type == 3) { printf ("\tarray values starting at %p:\n", (void *)d->ptr); } else if ( (d->storage_type == 1) || (d->storage_type == 2) ) { printf ("\tvalue at address %p\n", p); } switch (d->type) { case 267: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((char *)p)[i]); } } else { printf (scalar_fmt, *((char *)p)); } break; case 269: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((int *)p)[i]); } } else { printf (scalar_fmt, *((int *)p)); } break; case 268: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((short *)p)[i]); } } else { printf (scalar_fmt, *((short *)p)); } break; case 270: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((long *)p)[i]); } } else { printf (scalar_fmt, *((long *)p)); } break; case 271: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((long long *)p)[i]); } } else { printf (scalar_fmt, *((long long *)p)); } break; case 272: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((unsigned char *)p)[i]); } } else { printf (scalar_fmt, *((unsigned char *)p)); } break; case 274: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((unsigned int *)p)[i]); } } else { printf (scalar_fmt, *((unsigned int *)p)); } break; case 273: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((unsigned short *)p)[i]); } } else { printf (scalar_fmt, *((unsigned short *)p)); } break; case 275: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((unsigned long *)p)[i]); } } else { printf (scalar_fmt, *((unsigned long *)p)); } break; case 276: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((float *)p)[i]); } } else { printf (scalar_fmt, *((float *)p)); } break; case 277: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((double *)p)[i]); } } else { printf (scalar_fmt, *((double *)p)); } break; case 278: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, (double)((long double *)p)[i]); } } else { printf (scalar_fmt, (double)*((long double *)p)); } break; case 279: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, &(((MPI_Request *)p)[i])); } } else { printf(scalar_fmt, i, p); } break; case 280: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, (((MPI_Group *)p)[i])); } } else { printf(scalar_fmt, i, *((MPI_Group *)p)); } break; case 281: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, (((MPI_Comm *)p)[i])); } } else { printf(scalar_fmt, i, *((MPI_Comm *)p)); } break; case 261: if (d->storage_type == 3) { for (i = 0; i < d->array_length; i++) { printf(arr_fmt, i, ((char *)p)+i); } } else { printf (scalar_fmt, (char *)p); } break; case -6: printf ("\ttype = REFERENCE to datum:\n"); dump_datum (d->ref); break; case -7: printf ("\ttype = FUNCTION at %p\n", (void *)d->func); break; default: printf ("\t type = UNKNOWN -- ERROR!!\n"); break; } printf ("End of datum at %p: name = <%s>\n", (void *)d, d->name); return 0; } /* end of dump_datum */ /* This function prints out a very brief description of a datum. It is used by the "print" function. */ int brief_dump_datum (d) Datum *d; { int i; void *p; d = dereference (d); if (d->name[0]) { printf ("%s = ", d->name); } get_data_primitive_address (d, 0, &p); switch (d->type) { case 267: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %d\n", i, ((char *)p)[i]); } } else { printf ("%d \n", *((char *)p)); } break; case 269: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %d\n", i, ((int *)p)[i]); } } else { printf ("%d \n", *((int *)p)); } break; case 268: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %d\n", i, ((short *)p)[i]); } } else { printf ("%d \n", *((short *)p)); } break; case 270: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %ld\n", i, ((long *)p)[i]); } } else { printf ("%ld \n", *((long *)p)); } break; case 271: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %lld\n", i, ((long long *)p)[i]); } } else { printf ("%lld \n", *((long long *)p)); } break; case 272: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %d\n", i, ((unsigned char *)p)[i]); } } else { printf ("%d \n", *((unsigned char *)p)); } break; case 274: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %d\n", i, ((unsigned int *)p)[i]); } } else { printf ("%d \n", *((unsigned int *)p)); } break; case 273: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %d\n", i, ((unsigned short *)p)[i]); } } else { printf ("%d \n", *((unsigned short *)p)); } break; case 275: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %ld\n", i, ((unsigned long *)p)[i]); } } else { printf ("%ld \n", *((unsigned long *)p)); } break; case 276: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %f\n", i, ((float *)p)[i]); } } else { printf ("%f \n", *((float *)p)); } break; case 277: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %lf\n", i, ((double *)p)[i]); } } else { printf ("%lf \n", *((double *)p)); } break; case 278: if (d->storage_type == 3) { printf ("\n"); for (i = 0; i < d->array_length; i++) { printf("\t[%d] = %lf\n", i, (double)((long double *)p)[i]); } } else { printf ("%lf \n", (double)*((long double *)p)); } break; case 279: if (d->storage_type == 3) { printf ("\n"); printf ("\tMPI_Request array of length %d at %p\n", d->array_length, p); } else { printf ("\tMPI_Request at %p\n", p); } break; case 280: if (d->storage_type == 3) { printf ("\n"); printf ("\tMPI_Group array of length %d at %p\n", d->array_length, p); } else { printf ("\tMPI_Group at %p\n", p); } break; case 281: if (d->storage_type == 3) { printf ("\n"); printf ("\tMPI_Comm array of length %d at %p\n", d->array_length, p); } else { printf ("\tMPI_Comm at %p\n", p); } break; case 261: printf ("%s\n", d->str); case -7: printf ("FUNCTION at %p\n", (void *)d->func); break; default: printf ("UNKNOWN -- ERROR!!\n"); break; } return 0; } /* end of brief_dump_datum */ /* This routine prints out a description of each Datum in the symbol store. It is intended only for debugging. */ int dump_symbol_store (symbol_store) Symbol_Store *symbol_store; { int i; Datum *sym; printf ("Symbol store at %p has %d symbols:\n", (void *)symbol_store, symbol_store->num_symbols); sym = symbol_store->symbol; for (i = 0; i < symbol_store->num_symbols; i++) { printf ("Symbol %d:\n", i); dump_datum (sym++); } return 0; } /* end of dump_symbol_store */ /* Returns tru if the value of the datum is non-zero, false if it is zero. */ int datum_true (d) Datum *d; { Datum *dd; void *p; double dval; dd = dereference (d); get_data_primitive_address (dd, 0, &p); dval = to_double (p, dd->type); return (dval != 0.0); } /* end of datum_true */ /* During "compilation" of the program, this routine fills in the instruction locations for the code corresponding to the if condition, the if body and the else body. These instruction locations are stored in the if instruction. */ long set_if_branches (program, if_inst, cond, if_body, else_body) Instruction_Store *program; long if_inst; long cond; long if_body; long else_body; { if (Verbose) { printf ("set_if_branches: if_inst = %ld \n", if_inst); printf (" next = %ld cond = %ld \n", program->next_compiled_instruction, cond); printf (" if_body = %ld else_body = %ld\n", if_body, else_body); } program->i[if_inst].inst_loc[0] = program->next_compiled_instruction; program->i[if_inst].inst_loc[1] = cond; program->i[if_inst].inst_loc[2] = if_body; program->i[if_inst].inst_loc[3] = else_body; return if_inst; } /* end of set_if_branches */ /* This routine executes the if instruction. It evaluates the condition, then executes the if body or the else body depending on the results. Note that each of these sections of code are terminated by a NULL instruction, which causes "execute" to return. */ int if_op (program, stack) Instruction_Store *program; Data_Stack *stack; { Instruction *if_inst; Datum *d; if_inst = &(program->i[program->pc]); if (Verbose) { printf ("if_op \n"); printf ( "if_op branches: if_body= %ld else_body= %ld next = %ld\n", if_inst->inst_loc[2], if_inst->inst_loc[3], if_inst->inst_loc[0]); } /* Jump to the code for evaluating the condition */ program->pc = if_inst->inst_loc[1]; execute_inner (program, stack); d = dereference (stack->top); if (Verbose) { printf ("if_op condition = \n"); dump_datum (d); } pop (program, stack); if (datum_true(d)) { /* If the condition is true, jump to the the if body */ if (if_inst->inst_loc[2] >= 0) { if (Verbose) printf ("taking if body branch at %ld\n", if_inst->inst_loc[2] ); program->pc = if_inst->inst_loc[2]; execute_inner (program, stack); } } else { /* If the condition is false, jump to the the else body */ if (if_inst->inst_loc[3] >= 0) { if (Verbose) printf("taking else body branch at %ld\n", if_inst->inst_loc[3] ); program->pc = if_inst->inst_loc[3]; execute_inner (program, stack); } } /* Mote that we have to give it the location of the next instruction MINUS 1 because we are returning to execute which is about to increment the program counter. */ program->pc = if_inst->inst_loc[0]-1; return 0; } /* end of if_op */ /* During "compilation" of the program, this routine fills in the instruction locations for the code corresponding to the while condition, and the while body. These instruction locations are stored in the while instruction. */ long set_while_branches (program, while_inst, cond, while_body) Instruction_Store *program; long while_inst; long cond; long while_body; { if (Verbose) { printf ("set_while_branches: while_inst = %ld \n", while_inst); printf (" next = %ld cond = %ld \n", program->next_compiled_instruction, cond); printf (" while_body = %ld \n", while_body ); } program->i[while_inst].inst_loc[0] = program->next_compiled_instruction; program->i[while_inst].inst_loc[1] = cond; program->i[while_inst].inst_loc[2] = while_body; return while_inst; } /* end of set_while_branches */ /* This routine executes the while instruction. It evaluates the condition, then executes the while body depending on the results. It then loops back to evaluate the condition again, continuing until the condition is false. Note that each of the condition code and the while body code are terminated by a NULL instruction, which causes "execute" to return. */ int while_op (program, stack) Instruction_Store *program; Data_Stack *stack; { Instruction *while_inst; Datum *d; while_inst = &(program->i[program->pc]); if (Verbose) { printf ("while_op \n"); printf ( "while_op branches: while_body= %ld next = %ld\n", while_inst->inst_loc[2], while_inst->inst_loc[0]); } while (1) /* do until the contition is false */ { /* jump to the while condition */ program->pc = while_inst->inst_loc[1]; execute_inner (program, stack); d = dereference (stack->top); if (Verbose) { printf ("while_op condition = \n"); dump_datum (d); } pop (program, stack); /* if the result of the condition is true */ if (datum_true(d)) { /* execute the while body */ if (while_inst->inst_loc[2] >= 0) { if (Verbose) { printf("taking while body branch at %ld\n", while_inst->inst_loc[2] ); } program->pc = while_inst->inst_loc[2]; execute_inner (program, stack); } } else /* condition is false */ { break; /* break out of the while loop */ } } /* end of while */ /* Mote that we have to give it the location of the next instruction MINUS 1 because we are returning to execute which is about to increment the program counter. */ program->pc = while_inst->inst_loc[0]-1; return 0; } /* end of while_op */ /* During "compilation" of the program, this routine fills in the instruction locations for the code corresponding to the for initilization, condition, iteration, and the for body. These instruction locations are stored in the for instruction. */ long set_for_branches (program, for_inst, init, cond, iter, for_body) Instruction_Store *program; long for_inst; long init; long cond; long iter; long for_body; { if (Verbose) { printf ("set_for_branches: for_inst = %ld \n", for_inst); printf (" init= %ld cond = %ld iter = %ld\n", init, cond, iter); printf (" next = %ld cond = %ld \n", program->next_compiled_instruction, cond); printf (" for_body = %ld \n", for_body); } program->i[for_inst].inst_loc[0] = program->next_compiled_instruction; program->i[for_inst].inst_loc[1] = cond; program->i[for_inst].inst_loc[3] = init; program->i[for_inst].inst_loc[4] = iter; program->i[for_inst].inst_loc[2] = for_body; return for_inst; } /* end of set_for_branches */ /* This routine executes the for instruction. */ int for_op (program, stack) Instruction_Store *program; Data_Stack *stack; { Instruction *for_inst; Datum *d; for_inst = &(program->i[program->pc]); if (Verbose) { printf ("for_op \n"); printf ( "for_op branches: for_body= %ld next = %ld\n", for_inst->inst_loc[2], for_inst->inst_loc[0]); } /* jump to the for initialization */ program->pc = for_inst->inst_loc[3]; execute_inner (program, stack); pop (program, stack); while (1) /* do util the condition if false */ { /* evaluate the condition */ program->pc = for_inst->inst_loc[1]; execute_inner (program, stack); d = dereference (stack->top); if (Verbose) { printf ("for_op condition = \n"); dump_datum (d); } pop (program, stack); /* if the condition is true, execute the for body */ if (datum_true(d)) { if (for_inst->inst_loc[2] >= 0) { if (Verbose) { printf ("taking for body branch at %ld\n", for_inst->inst_loc[2] ); } program->pc = for_inst->inst_loc[2]; execute_inner (program, stack); } } else { break; /* if cond is not true, break out */ } /* execute the iter part of the for */ program->pc = for_inst->inst_loc[4]; execute_inner (program, stack); pop (program, stack); } /* Mote that we have to give it the location of the next instruction MINUS 1 because we are returning to execute which is about to increment the program counter. */ program->pc = for_inst->inst_loc[0]-1; return 0; } /* end of for_op */ /* This function creates a scalar datum of a given name and puts it into the symbol store. This is called when a scalar variable is declared. */ long create_scalar (type, name) long type; char *name; { Datum *sym; /* printf ("Creating type %ld scalar %s\n", type, name); */ sym = &(LY_Symbols->symbol[LY_Symbols->num_symbols++]); if (make_scalar_datum (LY_Symbols->interpreter, sym, (int)type, name)) { fprintf (stderr, "Unable to create scalar %s\n", name); return (-1); } return 0; } /* This function creates an array datum of a given name and length, and puts it into the symbol store. This is called when an array variable is declared. */ long create_array (type, name, length) long type; char *name; long length; { Datum *sym; /* printf ("Creating type %ld array %s of length %ld\n", type, name, length); */ sym = &(LY_Symbols->symbol[LY_Symbols->num_symbols++]); if (make_array_datum (LY_Symbols->interpreter, sym, (int)type, name, length)) { fprintf (stderr, "Unable to create array %s\n", name); return (-1); } return 0; } /*****************************************************************/ /* These routines handle the execution of the binary and unary operation. */ /* Is the operation an arithmetical operation? */ int is_arith_op (op) int op; { switch (op) { case 292: case 293: case 294: return 0; default: return 1; } } /* end of is_arith_op */ /* Is the operation a logical operation? */ int is_logical_op (op) int op; { return ! is_arith_op (op); } /* Execute a unary operation on top element of stack. Replace top element with result. */ int unary_op (program, stack) Instruction_Store *program; Data_Stack *stack; { Instruction *inst; Datum result; Datum *d; long do_unary_op (); inst = &(program->i[program->pc]); /* get top of stack */ d = dereference (stack->top); /* operation is actually performed here. */ if (do_unary_op (inst->d.slong, d, &result) ) { fprintf (stderr, "Error in unary operation at line %ld.\n", inst->source_line); return (-1); } /* stack->top--; */ /* put result on top of stack */ return assign_scalar_data (stack->top, &result); } /* end of unary_op */ /* Perform the unary operation on the given Datum */ long do_unary_op (op, d, result) int op; Datum *d; Datum *result; { long rtn; d = dereference (d); /* break out according to the type of unary op */ if (is_arith_op(op)) { rtn = arith_unary_op (op, d, result); } else if (is_logical_op(op)) { rtn = logical_unary_op (op, d, result); } else { fprintf (stderr, "Error in unary operation \n"); rtn = -1; } return rtn; } /* Perform an arithmetic unary op */ int arith_unary_op (op, d, result) int op; Datum *d; Datum *result; { int c_type; /* get the largest type similar to operand type */ c_type = expand_type (d->type); make_scalar_datum ((Interpreter_State *)NULL, result, c_type, ""); /* perform the operation */ switch (op) { case 283: switch (c_type) { case 275: result->ulong = - unlong(d); break; case 270: result->slong = - slong(d); break; case 271: result->llong = - llong(d); break; case 278: result->ldble = - ldble(d); break; } break; } return 0; } /* end of arith_unary_op */ /* Perform a logical unary op. */ int logical_unary_op (op, d, result) int op; Datum *d; Datum *result; { int d_t; /* determine if operand is logically true */ d_t = datum_true (d); /* result is always long */ make_scalar_datum ((Interpreter_State *)NULL, result, 270, ""); /* perform logical op */ switch (op) { case 294: result->slong = ! d_t; break; } return 0; } /* end of logical_unary_op */ /* Execute a binary operation on the top two elements on the stack. Pop those two and put the result on the top of the stack. */ int binary_op (program, stack) Instruction_Store *program; Data_Stack *stack; { Instruction *inst; Datum result; Datum *left, *right; long do_binary_op (); inst = &(program->i[program->pc]); /* Get top two elements on stack */ if (get_two_operands (stack, &right, &left)) { fprintf (stderr, "Error getting operands for binary operation at line %ld.\n", inst->source_line); stack->top--; return (-1); } /* do the binary op on thse two items */ if (do_binary_op (inst->d.slong, left, right, &result) ) { fprintf (stderr, "Error in binary operation at line %ld.\n", inst->source_line); } /* pop off top element */ stack->top--; /* replace top of stack with result */ return assign_scalar_data (stack->top, &result); } /* end of binary_op */ /* Makes target Datum type and value identical to source scalar Datum. */ int assign_scalar_data (target, source) Datum *target; Datum *source; { int rtn; rtn = 0; make_scalar_datum ((Interpreter_State *)NULL, target, source->type, ""); switch (source->type) { case 267: target->schar = source->schar; break; case 268: target->sshort = source->sshort; break; case 269: target->sint = source->sint; break; case 270: target->slong = source->slong; break; case 271: target->llong = source->llong; break; case 272: target->uchar = source->uchar; break; case 273: target->ushort = source->ushort; break; case 274: target->uint = source->uint; break; case 275: target->ulong = source->ulong; break; case 276: target->flt = source->flt; break; case 277: target->dble = source->dble; break; case 278: target->ldble = source->ldble; break; case 261: strcpy (target->str, source->str); break; case 279: fprintf(stderr, "Cannot assign MPI_Requests.\n"); rtn = 1; break; case 280: target->mpi_group = source->mpi_group; break; case 281: target->mpi_comm = source->mpi_comm; break; default: rtn = 1; } return rtn; } /* end of assign_scalar_data */ /* Perform a binary operation on the given operands. */ long do_binary_op (op, left, right, result) int op; Datum *left; Datum *right; Datum *result; { long rtn; left = dereference (left); right = dereference (right); /* Break out the arithmetic and the logical ops */ if (is_arith_op(op)) { rtn = arith_binary_op (op, left, right, result); } else if (is_logical_op(op)) { rtn = logical_binary_op (op, left, right, result); } else { fprintf (stderr, "Error in binary operation; setting result to 0. \n"); make_scalar_datum ((Interpreter_State *)NULL, result, 270, ""); rtn = (-1); } return rtn; } /* JGH Special case conversions for MPI_Comm and MPI_Group (and MPI_Request?) */ long long cvtToLL (void *c, int sz) { long long ll; int i, len; char *s, *d; /* If the sizeof MPI_Comm is equal to the size of any of the standard integer types, then cast to that type and assign to ll. If not, then copy bytes from the MPI_Comm to ll, filling with zeros if necessary. */ if (sz == sizeof (char)) { ll = (*(char *)c); } else if (sz == sizeof (short)) { ll = (*(short *)c); } else if (sz == sizeof (int)) { ll = (*(int *)c); } else if (sz == sizeof (long)) { ll = (*(long *)c); } else if (sz == sizeof (long long)) { ll = (*(long long *)c); } else { len = (((sizeof (long long))<(sz))?(sizeof (long long)):(sz)); s = (char *)c; d = (char *)≪ for (i = 0; i < len; i++) { *(d++) = *(s++); } for ( ; i < sizeof (long long); i++) { *(d++) = 0; } } return ll; } /* end of cvtToLL */ long long mpiCommToLL (MPI_Comm c) { int sz; sz = sizeof (MPI_Comm); return cvtToLL ((void *)&c, sz); } /* end of mpiCommToLL */ long long mpiGroupToLL (MPI_Group g) { int sz; sz = sizeof (MPI_Group); return cvtToLL ((void *)&g, sz); } /* end of mpiGroupToLL */ /* Converts a datum to a signed long value. */ long slong (d) Datum *d; { void *p; d = dereference (d); get_data_primitive_address (d, 0, &p); switch (d->type) { case 267: return (long) *( (char *) p ); case 268: return (long) *( (short *) p ); case 269: return (long) *( (int *) p ); case 270: return (long) *( (long *) p ); case 271: return (long) *( (long long *) p ); case 272: return (long) *( (unsigned char *) p ); case 273: return (long) *( (unsigned short *) p ); case 274: return (long) *( (unsigned int *) p ); case 275: return (long) *( (unsigned long *) p ); case 276: return (long) *( (float *) p ); case 277: return (long) *( (double *) p ); case 278: return (long) *( (long double *) p ); case 281: return (long) mpiCommToLL ( * (MPI_Comm *) p ); case 280: return (long) mpiGroupToLL ( * (MPI_Group *) p ); default: fprintf(stderr, "(slong) Error converting type %d\n", d->type); } return 0; } /* end of slong */ /* Converts a datum to a unsigned long value. */ unsigned long unlong (d) Datum *d; { void *p; d = dereference (d); get_data_primitive_address (d, 0, &p); switch (d->type) { case 267: return (unsigned long) *( (char *) p ); case 268: return (unsigned long) *( (short *) p ); case 269: return (unsigned long) *( (int *) p ); case 270: return (unsigned long) *( (long *) p ); case 271: return (unsigned long) *( (long long *) p ); case 272: return (unsigned long) *( (unsigned char *) p ); case 273: return (unsigned long) *( (unsigned short *) p ); case 274: return (unsigned long) *( (unsigned int *) p ); case 275: return (unsigned long) *( (unsigned long *) p ); case 276: return (unsigned long) *( (float *) p ); case 277: return (unsigned long) *( (double *) p ); case 278: return (unsigned long) *( (long double *) p ); case 281: return (unsigned long) mpiCommToLL ( * (MPI_Comm *) p ); case 280: return (unsigned long) mpiGroupToLL ( * (MPI_Group *) p ); default: fprintf(stderr, "(unlong) Error converting type %d\n", d->type); } return 0; } /* end of unlong */ /* Converts a datum to a long long value. */ long long llong (d) Datum *d; { void *p; d = dereference (d); get_data_primitive_address (d, 0, &p); switch (d->type) { case 267: return (long long) *( (char *) p ); case 268: return (long long) *( (short *) p ); case 269: return (long long) *( (int *) p ); case 270: return (long long) *( (long *) p ); case 271: return (long long) *( (long long *) p ); case 272: return (long long) *( (unsigned char *) p ); case 273: return (long long) *( (unsigned short *) p ); case 274: return (long long) *( (unsigned int *) p ); case 275: return (long long) *( (unsigned long *) p ); case 276: return (long long) *( (float *) p ); case 277: return (long long) *( (double *) p ); case 278: return (long long) *( (long double *) p ); case 281: return (long long) mpiCommToLL ( * (MPI_Comm *) p ); case 280: return (long long) mpiGroupToLL ( * (MPI_Group *) p ); default: fprintf(stderr, "(llong) Error converting type %d\n", d->type); } return 0; } /* end of slong */ MPI_Group mpigroup (Datum *d) { void *p; d = dereference (d); get_data_primitive_address (d, 0, &p); if (d->type != 280) { return MPI_GROUP_NULL; } return *((MPI_Group *)p); } /* end of mpigroup */ MPI_Comm mpicomm (Datum *d) { void *p; d = dereference (d); get_data_primitive_address (d, 0, &p); if (d->type != 281) { return MPI_COMM_NULL; } return *((MPI_Comm *)p); } /* end of mpigroup */ void print_test_ldbl() { long double l; l = 555.0; printf ("print_test_ldbl = %Lf\n", l); } /* Converts a datum to a float value. */ float flt (d) Datum *d; { return (float) ldble(d); } /* Converts a datum to a double value. */ double dble (d) Datum *d; { return (double) ldble(d); } /* Converts a datum to a long double value. */ long double ldble (d) Datum *d; { void *p; d = dereference (d); get_data_primitive_address (d, 0, &p); switch (d->type) { case 267: return (long double) *( (char *) p ); case 268: return (long double) *( (short *) p ); case 269: return (long double) *( (int *) p ); case 270: return (long double) *( (long *) p ); case 271: return (long double) *( (long long *) p ); case 272: return (long double) *( (unsigned char *) p ); case 273: return (long double) *( (unsigned short *) p ); case 274: return (long double) *( (unsigned int *) p ); case 275: return (long double) *( (unsigned long *) p ); case 276: return (long double) *( (float *) p ); case 277: return (long double) *( (double *) p ); case 278: return (long double) *( (long double *) p ); case 281: return (long double) mpiCommToLL ( * (MPI_Comm *) p ); case 280: return (long double) mpiGroupToLL ( * (MPI_Group *) p ); default: fprintf(stderr, "(ldble) Error converting type %d\n", d->type); } return 0; } /* end of ldble */ /* For a given data type, returns the largest data type of a similar kind. This returns only LONG, ULONG, or LONGDOUBLE. */ int expand_type (type) int type; { switch (type) { case 267: case 268: case 269: case 270: case 271: return 271; case 272: case 273: case 274: case 275: return 275; case 276: case 277: case 278: return 278; } return 278; } /* For two data types, returns the data type appropriate for the result of a binary operation combining those two data types. Note that there are promotions that may seem unnecessary. */ int common_type (a, b) Datum *a; Datum *b; { int at, bt; a = dereference (a); b = dereference (b); at = expand_type (a->type); bt = expand_type (b->type); if ( (at == 278) || (bt == 278) ) { return 278; } if ( (at == 271) || (bt == 271) ) { return 271; } if ( (at == 270) || (bt == 270) ) { return 270; } return 275; } /* end of common_type */ /* Is the operation a comparison? */ int comparison_op (op) int op; { switch (op) { case 286: case 288: case 287: case 289: case 290: case 291: return 1; } return 0; } /* end of comparison_op */ /* Perform an arithmetic binary operation. */ int arith_binary_op (op, l, r, result) int op; Datum *l; Datum *r; Datum *result; { int c_type; /* find the common data type for the result */ c_type = common_type (l, r); /* make the result Datum */ if (comparison_op (op)) { /* But comparisions always result in longs (logicals) */ make_scalar_datum ((Interpreter_State *)NULL, result, 270, ""); } else { make_scalar_datum ((Interpreter_State *)NULL, result, c_type, ""); } /* do the operation */ switch (op) { case 282: switch (c_type) { case 275: result->ulong = unlong(l) + unlong(r); break; case 270: result->slong = slong(l) + slong(r); break; case 271: result->llong = llong(l) + llong(r); break; case 278: result->ldble = ldble(l) + ldble(r); break; } break; case 283: switch (c_type) { case 275: result->ulong = unlong(l) - unlong(r); break; case 270: result->slong = slong(l) - slong(r); break; case 271: result->llong = llong(l) - llong(r); break; case 278: result->ldble = ldble(l) - ldble(r); break; } break; case 284: switch (c_type) { case 275: result->ulong = unlong(l) * unlong(r); break; case 270: result->slong = slong(l) * slong(r); break; case 271: result->llong = llong(l) * llong(r); break; case 278: result->ldble = ldble(l) * ldble(r); break; } break; case 285: switch (c_type) { case 275: result->ulong = unlong(l) / unlong(r); break; case 270: result->slong = slong(l) / slong(r); break; case 271: result->llong = llong(l) / llong(r); break; case 278: result->ldble = ldble(l) / ldble(r); break; } break; case 298: switch (c_type) { case 275: result->ulong = unlong(l) % unlong(r); break; case 270: result->slong = slong(l) % slong(r); break; case 271: result->llong = llong(l) % llong(r); break; } break; case 295: switch (c_type) { case 275: result->ulong = unlong(l) & unlong(r); break; case 270: result->slong = slong(l) & slong(r); break; case 271: result->llong = llong(l) & llong(r); break; } break; case 296: switch (c_type) { case 275: result->ulong = unlong(l) | unlong(r); break; case 270: result->slong = slong(l) | slong(r); break; case 271: result->llong = llong(l) | llong(r); break; } break; case 297: switch (c_type) { case 275: result->ulong = unlong(l) ^ unlong(r); break; case 270: result->slong = slong(l) ^ slong(r); break; case 271: result->llong = llong(l) ^ llong(r); break; } break; case 286: switch (c_type) { case 275: result->slong = unlong(l) > unlong(r); break; case 270: result->slong = slong(l) > slong(r); break; case 271: result->slong = llong(l) > llong(r); break; case 278: result->slong = ldble(l) > ldble(r); break; } break; case 288: switch (c_type) { case 275: result->slong = unlong(l) >= unlong(r); break; case 270: result->slong = slong(l) >= slong(r); break; case 271: result->slong = llong(l) >= llong(r); break; case 278: result->slong = ldble(l) >= ldble(r); break; } break; case 287: switch (c_type) { case 275: result->slong = unlong(l) < unlong(r); break; case 270: result->slong = slong(l) < slong(r); break; case 271: result->slong = llong(l) < llong(r); break; case 278: result->slong = ldble(l) < ldble(r); break; } break; case 289: switch (c_type) { case 275: result->slong = unlong(l) <= unlong(r); break; case 270: result->slong = slong(l) <= slong(r); break; case 271: result->slong = llong(l) <= llong(r); break; case 278: result->slong = ldble(l) <= ldble(r); break; } break; case 290: switch (c_type) { case 275: result->slong = unlong(l) == unlong(r); break; case 270: result->slong = slong(l) == slong(r); break; case 271: result->slong = llong(l) == llong(r); break; case 278: result->slong = ldble(l) == ldble(r); break; } break; case 291: switch (c_type) { case 275: result->slong = unlong(l) != unlong(r); break; case 270: result->slong = slong(l) != slong(r); break; case 271: result->slong = llong(l) != llong(r); break; case 278: result->slong = ldble(l) != ldble(r); break; } break; } return 0; } /* end of arith_binary_op */ /* Do a logical binary op. */ int logical_binary_op (op, l, r, result) int op; Datum *l; Datum *r; Datum *result; { int l_t, r_t; /* determine truth of the operands */ l_t = datum_true (l); r_t = datum_true (r); /* make the result */ make_scalar_datum ((Interpreter_State *)NULL, result, 270, ""); /* do the op */ switch (op) { case 292: result->slong = l_t && r_t; break; case 293: result->slong = l_t || r_t; break; } return 0; } /* end of logical_binary_op */ /** $Id: mpi_syms.c 56 2005-05-02 20:03:33Z wgeorge $ This code initializes the interpreter's symbol table to include the MPI objects like MPI_COMM_WORLD, and all of the constants like MPI_SUCCESS. */ MPI_Datatype impi_to_mpi_dt[22+1]; void setup_impi_to_mpi_datatype () { impi_to_mpi_dt[0 ] = MPI_DATATYPE_NULL; impi_to_mpi_dt[1 ] = MPI_BYTE ; impi_to_mpi_dt[2 ] = MPI_PACKED ; impi_to_mpi_dt[3 ] = MPI_CHAR ; impi_to_mpi_dt[4 ] = MPI_SHORT; impi_to_mpi_dt[5 ] = MPI_INT ; impi_to_mpi_dt[6 ] = MPI_LONG ; impi_to_mpi_dt[7 ] = MPI_FLOAT ; impi_to_mpi_dt[8 ] = MPI_DOUBLE ; impi_to_mpi_dt[9 ] = MPI_LONG_DOUBLE ; impi_to_mpi_dt[10 ] = MPI_UNSIGNED_CHAR ; impi_to_mpi_dt[11 ] = MPI_UNSIGNED_SHORT ; impi_to_mpi_dt[12 ] = MPI_UNSIGNED_LONG ; impi_to_mpi_dt[13 ] = MPI_UNSIGNED ; impi_to_mpi_dt[15 ] = MPI_FLOAT_INT ; impi_to_mpi_dt[16 ] = MPI_DOUBLE_INT ; impi_to_mpi_dt[17 ] = MPI_LONG_INT ; impi_to_mpi_dt[18 ] = MPI_SHORT_INT ; impi_to_mpi_dt[20 ] = MPI_2INT ; impi_to_mpi_dt[21 ] = MPI_UB ; impi_to_mpi_dt[22 ] = MPI_LB ; } MPI_Datatype impi_to_mpi_datatype (long impi_dt) { return impi_to_mpi_dt [impi_dt]; } /* end of impi_to_mpi_datatype */ MPI_Op impi_to_mpi_op[13+1]; void setup_impi_to_mpi_op () { MPI_Op noncomm; impi_to_mpi_op[0] = MPI_OP_NULL; impi_to_mpi_op[1] = MPI_MAX; impi_to_mpi_op[2] = MPI_MIN; impi_to_mpi_op[3] = MPI_SUM; impi_to_mpi_op[4] = MPI_PROD; impi_to_mpi_op[5] = MPI_LAND; impi_to_mpi_op[6] = MPI_BAND; impi_to_mpi_op[7] = MPI_LOR; impi_to_mpi_op[8] = MPI_BOR; impi_to_mpi_op[9] = MPI_LXOR; impi_to_mpi_op[10] = MPI_BXOR; impi_to_mpi_op[11] = MPI_MAXLOC; impi_to_mpi_op[12] = MPI_MINLOC; get_nonComm_op (&noncomm); impi_to_mpi_op[13] = noncomm; } MPI_Op impi_to_mpi_operation (long impi_op) { return impi_to_mpi_op[impi_op]; } /* We're done with the translation tables, now we initialize a portion of the interpreter symbol table to contain the MPI constants, objects, and functions. */ initialize_mpi_symbols (sym_store, mpiNumProcs, mpiRank, mpi_comm_world) Symbol_Store *sym_store; long mpiNumProcs; long mpiRank; MPI_Comm mpi_comm_world; { setup_impi_to_mpi_datatype (); setup_impi_to_mpi_op (); make_long_datum (mpiNumProcs, "__mpiNumProcs__", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum (mpiRank, "__mpiRank__", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_SUCCESS, "MPI_SUCCESS", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_BUFFER, "MPI_ERR_BUFFER", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_COUNT, "MPI_ERR_COUNT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_TYPE , "MPI_ERR_TYPE ", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_TAG, "MPI_ERR_TAG", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_COMM, "MPI_ERR_COMM", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_RANK, "MPI_ERR_RANK", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_REQUEST, "MPI_ERR_REQUEST", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_ROOT, "MPI_ERR_ROOT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_GROUP, "MPI_ERR_GROUP", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_OP, "MPI_ERR_OP", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_TOPOLOGY, "MPI_ERR_TOPOLOGY", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_DIMS, "MPI_ERR_DIMS", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_ARG, "MPI_ERR_ARG", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_UNKNOWN, "MPI_ERR_UNKNOWN", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_TRUNCATE, "MPI_ERR_TRUNCATE", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_OTHER, "MPI_ERR_OTHER", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_INTERN, "MPI_ERR_INTERN", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_PENDING, "MPI_ERR_PENDING", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_IN_STATUS, "MPI_ERR_IN_STATUS", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERR_LASTCODE, "MPI_ERR_LASTCODE", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_BOTTOM, "MPI_BOTTOM", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_PROC_NULL, "MPI_PROC_NULL", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ANY_SOURCE, "MPI_ANY_SOURCE", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ANY_TAG, "MPI_ANY_TAG", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_UNDEFINED, "MPI_UNDEFINED", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_BSEND_OVERHEAD, "MPI_BSEND_OVERHEAD", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_KEYVAL_INVALID, "MPI_KEYVAL_INVALID", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERRORS_ARE_FATAL, "MPI_ERRORS_ARE_FATAL", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERRORS_RETURN, "MPI_ERRORS_RETURN", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_MAX_PROCESSOR_NAME, "MPI_MAX_PROCESSOR_NAME", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_MAX_ERROR_STRING, "MPI_MAX_ERROR_STRING", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)3, "MPI_CHAR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)4, "MPI_SHORT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)5, "MPI_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)6, "MPI_LONG", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)10, "MPI_UNSIGNED_CHAR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)11, "MPI_UNSIGNED_SHORT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)13, "MPI_UNSIGNED", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)12, "MPI_UNSIGNED_LONG", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)7, "MPI_FLOAT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)8, "MPI_DOUBLE", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)9, "MPI_LONG_DOUBLE", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)1, "MPI_BYTE", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)2, "MPI_PACKED", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)15, "MPI_FLOAT_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)16, "MPI_DOUBLE_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)17, "MPI_LONG_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)20, "MPI_2INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)18, "MPI_SHORT_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)19, "MPI_LONG_DOUBLE_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)14, "MPI_LONG_LONG_INT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)21, "MPI_UB", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)22, "MPI_LB", &sym_store->symbol[sym_store->num_symbols++]); make_mpicomm_datum ((MPI_Comm)mpi_comm_world, "MPI_COMM_WORLD", &sym_store->symbol[sym_store->num_symbols++]); make_mpicomm_datum ((MPI_Comm)MPI_COMM_SELF, "MPI_COMM_SELF", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_IDENT, "MPI_IDENT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_CONGRUENT, "MPI_CONGRUENT", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_SIMILAR, "MPI_SIMILAR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_UNEQUAL, "MPI_UNEQUAL", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_TAG_UB, "MPI_TAG_UB", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_IO, "MPI_IO", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_HOST, "MPI_HOST", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_WTIME_IS_GLOBAL, "MPI_WTIME_IS_GLOBAL", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)1, "MPI_MAX", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)2, "MPI_MIN", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)3, "MPI_SUM", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)4, "MPI_PROD", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)11, "MPI_MAXLOC", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)12, "MPI_MINLOC", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)6, "MPI_BAND", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)8, "MPI_BOR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)10, "MPI_BXOR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)5, "MPI_LAND", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)7, "MPI_LOR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)9, "MPI_LXOR", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)13, "IMPI_NONCOMM_OP", &sym_store->symbol[sym_store->num_symbols++]); make_mpigroup_datum ((MPI_Comm)MPI_GROUP_NULL, "MPI_GROUP_NULL", &sym_store->symbol[sym_store->num_symbols++]); make_mpicomm_datum ((MPI_Comm)MPI_COMM_NULL, "MPI_COMM_NULL", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)0, "MPI_DATATYPE_NULL", &sym_store->symbol[sym_store->num_symbols++]); /* make_long_datum ((long)IMPI_REQUEST_NULL, "MPI_REQUEST_NULL", &sym_store->symbol[sym_store->num_symbols++]); */ make_long_datum ((long)0, "MPI_OP_NULL", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_ERRHANDLER_NULL, "MPI_ERRHANDLER_NULL", &sym_store->symbol[sym_store->num_symbols++]); make_mpigroup_datum ((MPI_Group)MPI_GROUP_EMPTY, "MPI_GROUP_EMPTY", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_GRAPH, "MPI_GRAPH", &sym_store->symbol[sym_store->num_symbols++]); make_long_datum ((long)MPI_CART, "MPI_CART", &sym_store->symbol[sym_store->num_symbols++]); /* now set up the functions in the symbol table */ make_mpi_func_syms (sym_store); return 0; } /* end of initialize_mpi_symbols */ /** This code is automatically generated. It sets up the mpi function wrappers in the interpreter symbol table. */ make_mpi_func_syms (Symbol_Store *sym_store) { int MPI_Send_w (); int MPI_Recv_w (); int MPI_Get_count_w (); int MPI_Bsend_w (); int MPI_Ssend_w (); int MPI_Rsend_w (); int MPI_Buffer_attach_w (); int MPI_Buffer_detach_w (); int MPI_Isend_w (); int MPI_Ibsend_w (); int MPI_Issend_w (); int MPI_Irsend_w (); int MPI_Irecv_w (); int MPI_Wait_w (); int MPI_Test_w (); int MPI_Request_free_w (); int MPI_Waitany_w (); int MPI_Testany_w (); int MPI_Waitall_w (); int MPI_Testall_w (); int MPI_Waitsome_w (); int MPI_Testsome_w (); int MPI_Iprobe_w (); int MPI_Probe_w (); int MPI_Cancel_w (); int MPI_Test_cancelled_w (); int MPI_Send_init_w (); int MPI_Bsend_init_w (); int MPI_Ssend_init_w (); int MPI_Rsend_init_w (); int MPI_Recv_init_w (); int MPI_Start_w (); int MPI_Startall_w (); int MPI_Sendrecv_w (); int MPI_Sendrecv_replace_w (); int MPI_Type_contiguous_w (); int MPI_Type_vector_w (); int MPI_Type_hvector_w (); int MPI_Type_indexed_w (); int MPI_Type_hindexed_w (); int MPI_Type_struct_w (); int MPI_Address_w (); int MPI_Type_extent_w (); int MPI_Type_size_w (); int MPI_Type_lb_w (); int MPI_Type_ub_w (); int MPI_Type_commit_w (); int MPI_Type_free_w (); int MPI_Get_elements_w (); int MPI_Pack_w (); int MPI_Unpack_w (); int MPI_Pack_size_w (); int MPI_Barrier_w (); int MPI_Bcast_w (); int MPI_Gather_w (); int MPI_Gatherv_w (); int MPI_Scatter_w (); int MPI_Scatterv_w (); int MPI_Allgather_w (); int MPI_Allgatherv_w (); int MPI_Alltoall_w (); int MPI_Alltoallv_w (); int MPI_Reduce_w (); int MPI_Op_create_w (); int MPI_Op_free_w (); int MPI_Allreduce_w (); int MPI_Reduce_scatter_w (); int MPI_Scan_w (); int MPI_Group_size_w (); int MPI_Group_rank_w (); int MPI_Group_translate_ranks_w (); int MPI_Group_compare_w (); int MPI_Comm_group_w (); int MPI_Group_union_w (); int MPI_Group_intersection_w (); int MPI_Group_difference_w (); int MPI_Group_incl_w (); int MPI_Group_excl_w (); int MPI_Group_range_incl_w (); int MPI_Group_range_excl_w (); int MPI_Group_free_w (); int MPI_Comm_size_w (); int MPI_Comm_rank_w (); int MPI_Comm_compare_w (); int MPI_Comm_dup_w (); int MPI_Comm_create_w (); int MPI_Comm_split_w (); int MPI_Comm_free_w (); int MPI_Comm_test_inter_w (); int MPI_Comm_remote_size_w (); int MPI_Comm_remote_group_w (); int MPI_Intercomm_create_w (); int MPI_Intercomm_merge_w (); int MPI_Keyval_create_w (); int MPI_Keyval_free_w (); int MPI_Attr_put_w (); int MPI_Attr_get_w (); int MPI_Attr_delete_w (); int MPI_Cart_create_w (); int MPI_Dims_create_w (); int MPI_Graph_create_w (); int MPI_Topo_test_w (); int MPI_Graphdims_get_w (); int MPI_Graph_get_w (); int MPI_Cartdim_get_w (); int MPI_Cart_get_w (); int MPI_Cart_rank_w (); int MPI_Cart_coords_w (); int MPI_Graph_neighbors_count_w (); int MPI_Graph_neighbors_w (); int MPI_Cart_shift_w (); int MPI_Cart_sub_w (); int MPI_Cart_map_w (); int MPI_Graph_map_w (); int MPI_Get_processor_name_w (); int MPI_Errhandler_create_w (); int MPI_Errhandler_set_w (); int MPI_Errhandler_get_w (); int MPI_Errhandler_free_w (); int MPI_Error_string_w (); int MPI_Error_class_w (); int MPI_Wtime_w (); int MPI_Wtick_w (); int MPI_Init_w (); int MPI_Finalize_w (); int MPI_Initialized_w (); int MPI_Abort_w (); int MPI_Get_version_w (); int MPI_Finalized_w (); make_func_datum (MPI_Send_w, "MPI_Send", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Recv_w, "MPI_Recv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Get_count_w, "MPI_Get_count", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Bsend_w, "MPI_Bsend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Ssend_w, "MPI_Ssend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Rsend_w, "MPI_Rsend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Buffer_attach_w, "MPI_Buffer_attach", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Buffer_detach_w, "MPI_Buffer_detach", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Isend_w, "MPI_Isend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Ibsend_w, "MPI_Ibsend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Issend_w, "MPI_Issend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Irsend_w, "MPI_Irsend", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Irecv_w, "MPI_Irecv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Wait_w, "MPI_Wait", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Test_w, "MPI_Test", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Request_free_w, "MPI_Request_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Waitany_w, "MPI_Waitany", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Testany_w, "MPI_Testany", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Waitall_w, "MPI_Waitall", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Testall_w, "MPI_Testall", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Waitsome_w, "MPI_Waitsome", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Testsome_w, "MPI_Testsome", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Iprobe_w, "MPI_Iprobe", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Probe_w, "MPI_Probe", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cancel_w, "MPI_Cancel", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Test_cancelled_w, "MPI_Test_cancelled", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Send_init_w, "MPI_Send_init", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Bsend_init_w, "MPI_Bsend_init", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Ssend_init_w, "MPI_Ssend_init", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Rsend_init_w, "MPI_Rsend_init", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Recv_init_w, "MPI_Recv_init", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Start_w, "MPI_Start", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Startall_w, "MPI_Startall", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Sendrecv_w, "MPI_Sendrecv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Sendrecv_replace_w, "MPI_Sendrecv_replace", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_contiguous_w, "MPI_Type_contiguous", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_vector_w, "MPI_Type_vector", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_hvector_w, "MPI_Type_hvector", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_indexed_w, "MPI_Type_indexed", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_hindexed_w, "MPI_Type_hindexed", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_struct_w, "MPI_Type_struct", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Address_w, "MPI_Address", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_extent_w, "MPI_Type_extent", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_size_w, "MPI_Type_size", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_lb_w, "MPI_Type_lb", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_ub_w, "MPI_Type_ub", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_commit_w, "MPI_Type_commit", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Type_free_w, "MPI_Type_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Get_elements_w, "MPI_Get_elements", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Pack_w, "MPI_Pack", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Unpack_w, "MPI_Unpack", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Pack_size_w, "MPI_Pack_size", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Barrier_w, "MPI_Barrier", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Bcast_w, "MPI_Bcast", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Gather_w, "MPI_Gather", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Gatherv_w, "MPI_Gatherv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Scatter_w, "MPI_Scatter", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Scatterv_w, "MPI_Scatterv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Allgather_w, "MPI_Allgather", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Allgatherv_w, "MPI_Allgatherv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Alltoall_w, "MPI_Alltoall", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Alltoallv_w, "MPI_Alltoallv", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Reduce_w, "MPI_Reduce", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Op_create_w, "MPI_Op_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Op_free_w, "MPI_Op_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Allreduce_w, "MPI_Allreduce", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Reduce_scatter_w, "MPI_Reduce_scatter", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Scan_w, "MPI_Scan", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_size_w, "MPI_Group_size", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_rank_w, "MPI_Group_rank", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_translate_ranks_w, "MPI_Group_translate_ranks", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_compare_w, "MPI_Group_compare", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_group_w, "MPI_Comm_group", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_union_w, "MPI_Group_union", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_intersection_w, "MPI_Group_intersection", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_difference_w, "MPI_Group_difference", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_incl_w, "MPI_Group_incl", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_excl_w, "MPI_Group_excl", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_range_incl_w, "MPI_Group_range_incl", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_range_excl_w, "MPI_Group_range_excl", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Group_free_w, "MPI_Group_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_size_w, "MPI_Comm_size", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_rank_w, "MPI_Comm_rank", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_compare_w, "MPI_Comm_compare", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_dup_w, "MPI_Comm_dup", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_create_w, "MPI_Comm_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_split_w, "MPI_Comm_split", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_free_w, "MPI_Comm_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_test_inter_w, "MPI_Comm_test_inter", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_remote_size_w, "MPI_Comm_remote_size", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Comm_remote_group_w, "MPI_Comm_remote_group", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Intercomm_create_w, "MPI_Intercomm_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Intercomm_merge_w, "MPI_Intercomm_merge", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Keyval_create_w, "MPI_Keyval_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Keyval_free_w, "MPI_Keyval_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Attr_put_w, "MPI_Attr_put", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Attr_get_w, "MPI_Attr_get", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Attr_delete_w, "MPI_Attr_delete", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_create_w, "MPI_Cart_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Dims_create_w, "MPI_Dims_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Graph_create_w, "MPI_Graph_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Topo_test_w, "MPI_Topo_test", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Graphdims_get_w, "MPI_Graphdims_get", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Graph_get_w, "MPI_Graph_get", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cartdim_get_w, "MPI_Cartdim_get", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_get_w, "MPI_Cart_get", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_rank_w, "MPI_Cart_rank", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_coords_w, "MPI_Cart_coords", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Graph_neighbors_count_w, "MPI_Graph_neighbors_count", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Graph_neighbors_w, "MPI_Graph_neighbors", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_shift_w, "MPI_Cart_shift", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_sub_w, "MPI_Cart_sub", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Cart_map_w, "MPI_Cart_map", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Graph_map_w, "MPI_Graph_map", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Get_processor_name_w, "MPI_Get_processor_name", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Errhandler_create_w, "MPI_Errhandler_create", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Errhandler_set_w, "MPI_Errhandler_set", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Errhandler_get_w, "MPI_Errhandler_get", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Errhandler_free_w, "MPI_Errhandler_free", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Error_string_w, "MPI_Error_string", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Error_class_w, "MPI_Error_class", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Wtime_w, "MPI_Wtime", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Wtick_w, "MPI_Wtick", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Init_w, "MPI_Init", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Finalize_w, "MPI_Finalize", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Initialized_w, "MPI_Initialized", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Abort_w, "MPI_Abort", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Get_version_w, "MPI_Get_version", &sym_store->symbol[sym_store->num_symbols++]); make_func_datum (MPI_Finalized_w, "MPI_Finalized", &sym_store->symbol[sym_store->num_symbols++]); return 0; } /* end of make_mpi_func_syms */ /** $Id: mpi_wrappers_real.c 56 2005-05-02 20:03:33Z wgeorge $ */ /* This software was developed at the National Institute of Standards and Technology by employees of the Federal Government in the course of their official duties. Pursuant to title 17 Section 105 of the United States Code this software is not subject to copyright protection and is in the public domain. This is an experimental system. NIST assumes no responsibility whatsoever for its use by other parties, and makes no guarantees, expressed or implied, about its quality, reliability, or any other characteristic. We would appreciate acknowledgement if the software is used. */ /** mpi_wrappers_real.c This file contains wrappers for the MPI functions that enable them to be called from the interpreted code. Each of the MPI functions are represented, but a few are not fully implemented. Note that there is a corresponding source file called mpi_wrappers_sim.c that contains all of the same wrapper routines, but the implementations call java-based implementations of the MPI functionality. In addition to wrappers for the MPI functions, this file also contains the definition of a non-communtative reduce operation. The relevant routines are at the bottom of this file. */ int MPI_Get_count_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Get_count_w */ int MPI_Bsend_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Bsend_w */ int MPI_Ssend_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Ssend_w */ int MPI_Rsend_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Rsend_w */ int MPI_Buffer_attach_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Buffer_attach_w */ int MPI_Buffer_detach_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Buffer_detach_w */ int datum_to_mpi_request (Datum *req_datum, MPI_Request *request) { req_datum = dereference (req_datum); if ( (req_datum->type != 279) || (req_datum->storage_type == 3) ) { return MPI_ERR_ARG; } if (req_datum->storage_type == 2) { *request = *((MPI_Request *)req_datum->ptr); } else { *request = req_datum->mpi_request; } return 0; } /* end of datum_to_mpi_request */ int mpi_request_to_datum (MPI_Request *request, Datum *req_datum) { req_datum = dereference (req_datum); if ( (req_datum->type != 279) || (req_datum->storage_type == 3) ) { return MPI_ERR_ARG; } if (req_datum->storage_type == 2) { *((MPI_Request *)req_datum->ptr) = *request; } else { req_datum->mpi_request = *request; } return 0; } /* end of mpi_request */ int MPI_Isend_w (stack) Data_Stack *stack; { int rtn; int nargs; Datum *arg1, *d; void *buf; int count; MPI_Datatype datatype; int dest, tag; MPI_Comm comm; MPI_Request request; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 7) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, &buf); count = slong (arg1+1); datatype = impi_to_mpi_datatype (slong (arg1+2)); dest = slong (arg1+3); tag = slong (arg1+4); comm = mpicomm (arg1+5); if (datum_to_mpi_request (arg1+6, &request)) { return MPI_ERR_ARG; } state=stack->interpreter; rtn = MPI_Isend_w_inner (state, buf, count, datatype, dest, tag, comm, &request); if (mpi_request_to_datum (&request, arg1+6)) { return MPI_ERR_ARG; } return rtn; } /* end of MPI_Isend_w */ int MPI_Isend_w_inner ( Interpreter_State *state, void *buf, int count, MPI_Datatype datatype, int dest, int tag, MPI_Comm comm, MPI_Request *request ) { int rtn; rtn = MPI_Isend (buf, count, datatype, dest, tag, comm, request); return rtn; } /* end of MPI_Isend_w_inner */ int MPI_Irecv_w (stack) Data_Stack *stack; { int rtn; int nargs; Datum *arg1; void *buf; Datum *d; int count; MPI_Datatype datatype; int source; int tag; MPI_Comm comm; Interpreter_State *state; MPI_Request request; nargs = dereference(stack->top-1)->slong; if (nargs != 7) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, &buf); count = slong (arg1+1); datatype = impi_to_mpi_datatype (slong (arg1+2)); source = slong (arg1+3); tag = slong (arg1+4); comm = mpicomm (arg1+5); if (datum_to_mpi_request (arg1+6, &request)) { return MPI_ERR_ARG; } /* Do the equivalent of: rtn = MPI_Irecv (buf, count, datatype, source, tag, comm, request); */ state=stack->interpreter; rtn = MPI_Irecv_w_inner ( state, buf, count, datatype, source, tag, comm, &request); if (mpi_request_to_datum (&request, arg1+6)) { return MPI_ERR_ARG; } return rtn; } /* end of MPI_Irecv_w */ int MPI_Irecv_w_inner (Interpreter_State *state, void *buf, int count, MPI_Datatype datatype, int source, int tag, MPI_Comm comm, MPI_Request *request ) { int rtn; rtn = MPI_Irecv (buf, count, datatype, source, tag, comm, request); return rtn; } /* end of MPI_Irecv_w_inner */ int MPI_Ibsend_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Ibsend_w */ int MPI_Issend_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Issend_w */ int MPI_Irsend_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Irsend_w */ int MPI_Wait_w (stack) Data_Stack *stack; { int rtn = 0; int loc_status[5]; MPI_Request request; int nargs; Datum *arg1; Datum *status; void *p; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; if (datum_to_mpi_request (arg1, &request)) { return MPI_ERR_ARG; } status = dereference (arg1+1); if (status->storage_type != 3) { return MPI_ERR_ARG; } rtn = MPI_Wait_w_inner (stack->interpreter, &request, loc_status); if (mpi_request_to_datum (&request, arg1)) { return MPI_ERR_ARG; } /* Now transfer the MPI_Status information to the outgoing array of integers */ get_data_primitive_address (status, 0, &p); assign_by_type (p, status->type, (void *)&loc_status[0], 269); get_data_primitive_address (status, 1, &p); assign_by_type (p, status->type, (void *)&loc_status[1], 269); get_data_primitive_address (status, 2, &p); assign_by_type (p, status->type, (void *)&loc_status[2], 269); return rtn; } /* end of MPI_Wait_w */ int MPI_Wait_w_inner (Interpreter_State *state, MPI_Request *request, int status[5]) { MPI_Status mstatus; int rtn = 0; rtn = MPI_Wait (request, &mstatus); status[0] = mstatus.MPI_SOURCE; status[1] = mstatus.MPI_TAG; status[2] = mstatus.MPI_ERROR; return rtn; } /* end of MPI_Wait_w */ int MPI_Test_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Test_w */ int MPI_Request_free_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Request_free_w */ int MPI_Waitany_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Waitany_w */ int MPI_Testany_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Testany_w */ int MPI_Waitall_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Waitall_w */ int MPI_Testall_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Testall_w */ int MPI_Waitsome_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Waitsome_w */ int MPI_Testsome_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Testsome_w */ int MPI_Iprobe_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; int source; int tag; MPI_Comm comm; Datum *flag; int loc_flag; Datum *status; int loc_status[5]; void *p; Datum *arg1; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 5) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; source = slong (arg1); tag = slong (arg1+1); comm = mpicomm (arg1+2); flag = dereference (arg1+3); status = dereference (arg1+4); if (status->storage_type != 3) { return MPI_ERR_ARG; } state=stack->interpreter; rtn = MPI_Iprobe_w_inner ( state, source, tag, comm, &loc_flag, loc_status); /* Now transfer the MPI_Status information to the outgoing array of integers */ get_data_primitive_address (status, 0, &p); assign_by_type (p, status->type, (void *)&loc_status[0], 269); get_data_primitive_address (status, 1, &p); assign_by_type (p, status->type, (void *)&loc_status[1], 269); get_data_primitive_address (status, 2, &p); assign_by_type (p, status->type, (void *)&loc_status[2], 269); /* Now transfer flag to the output arg */ get_data_primitive_address (flag, 0, &p); assign_by_type (p, flag->type, (void *)&loc_flag, 269); return rtn; } /* end of MPI_Iprobe_w */ int MPI_Iprobe_w_inner (Interpreter_State *state, int source, int tag, MPI_Comm comm, int *flag, int status[5]) { MPI_Status mstatus; int rtn; rtn = MPI_Iprobe (source, tag, comm, flag, &mstatus); status[0] = mstatus.MPI_SOURCE; status[1] = mstatus.MPI_TAG; status[2] = mstatus.MPI_ERROR; return rtn; } /* end of MPI_Iprobe_w */ int MPI_Probe_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; int source; int tag; MPI_Comm comm; Datum *status; int loc_status[5]; void *p; Datum *arg1; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 4) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; source = slong (arg1); tag = slong (arg1+1); comm = mpicomm (arg1+1); status = dereference (arg1+3); if (status->storage_type != 3) { return MPI_ERR_ARG; } state=stack->interpreter; rtn = MPI_Probe_w_inner ( state, source, tag, comm, loc_status); /* Now transfer the MPI_Status information to the outgoing array of integers */ get_data_primitive_address (status, 0, &p); assign_by_type (p, status->type, (void *)&loc_status[0], 269); get_data_primitive_address (status, 1, &p); assign_by_type (p, status->type, (void *)&loc_status[1], 269); get_data_primitive_address (status, 2, &p); assign_by_type (p, status->type, (void *)&loc_status[2], 269); return rtn; } /* end of MPI_Probe_w */ int MPI_Probe_w_inner (Interpreter_State *state, int source, int tag, MPI_Comm comm, int status[5]) { MPI_Status mstatus; int rtn; rtn = MPI_Probe (source, tag, comm, &mstatus); status[0] = mstatus.MPI_SOURCE; status[1] = mstatus.MPI_TAG; status[2] = mstatus.MPI_ERROR; return rtn; } /* end of MPI_Iprobe_w */ int MPI_Cancel_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cancel_w */ int MPI_Test_cancelled_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Test_cancelled_w */ int MPI_Send_init_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Send_init_w */ int MPI_Bsend_init_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Bsend_init_w */ int MPI_Ssend_init_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Ssend_init_w */ int MPI_Rsend_init_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Rsend_init_w */ int MPI_Recv_init_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Recv_init_w */ int MPI_Start_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Start_w */ int MPI_Startall_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Startall_w */ int MPI_Sendrecv_w (stack) Data_Stack *stack; { int rtn; int nargs; Datum *arg1; void *sbuf, *rbuf; Datum *d; int scount, rcount; MPI_Datatype sdatatype, rdatatype; int source, dest; int stag, rtag; MPI_Comm comm; void *p; Interpreter_State *state; int stat_fld; int status[5]; nargs = dereference(stack->top-1)->slong; if (nargs != 12) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, &sbuf); scount = slong (arg1+1); sdatatype = impi_to_mpi_datatype (slong (arg1+2)); dest = slong (arg1+3); stag = slong (arg1+4); d = dereference (arg1+5); get_data_primitive_address (d, 0, &rbuf); rcount = slong (arg1+6); rdatatype = impi_to_mpi_datatype (slong (arg1+7)); source = slong (arg1+8); rtag = slong (arg1+9); comm = mpicomm (arg1+10); /* Do the equivalent of: rtn = MPI_Sendrecv (sbuf, scount, sdatatype, dest, stag, rbuf, rcount, rdatatype, source, rtag, comm, &status); by calling the appropriate java method. */ state=stack->interpreter; rtn = MPI_Sendrecv_w_inner ( state, sbuf, scount, sdatatype, dest, stag, rbuf, rcount, rdatatype, source, rtag, comm, status); /* Now transfer the MPI_Status information to the outgoing array of integers */ d = dereference (arg1+11); /* status */ if (d->storage_type != 3) { rtn = MPI_ERR_ARG; } else { /* move the status array into the output arg */ get_data_primitive_address (d, 0, &p); assign_by_type (p, d->type, (void *)&status[0], 269); get_data_primitive_address (d, 1, &p); assign_by_type (p, d->type, (void *)&status[1], 269); get_data_primitive_address (d, 2, &p); assign_by_type (p, d->type, (void *)&status[2], 269); } return rtn; } /* end of MPI_Sendrecv_w */ int MPI_Sendrecv_w_inner (Interpreter_State *state, void *sbuf, int scount, MPI_Datatype sdatatype, int dest, int stag, void *rbuf, int rcount, MPI_Datatype rdatatype, int source, int rtag, MPI_Comm comm, int status[5] ) { int rtn; MPI_Status mstatus; rtn = MPI_Sendrecv (sbuf, scount, sdatatype, dest, stag, rbuf, rcount, rdatatype, source, rtag, comm, &mstatus); status[0] = mstatus.MPI_SOURCE; status[1] = mstatus.MPI_TAG; status[2] = mstatus.MPI_ERROR; return rtn; } /* end of MPI_Sendrecv_w_inner */ int MPI_Sendrecv_replace_w (stack) Data_Stack *stack; { int rtn; int nargs; Datum *arg1; void *buf; Datum *d; int count; MPI_Datatype datatype; int source, dest; int stag, rtag; MPI_Comm comm; void *p; Interpreter_State *state; int stat_fld; int status[5]; nargs = dereference(stack->top-1)->slong; if (nargs != 9) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, &buf); count = slong (arg1+1); datatype = impi_to_mpi_datatype (slong (arg1+2)); dest = slong (arg1+3); stag = slong (arg1+4); source = slong (arg1+5); rtag = slong (arg1+6); comm = mpicomm (arg1+7); /* Do the equivalent of: rtn = MPI_Sendrecv_replace (buf, count, datatype, dest, stag, source, rtag, comm, &status); by calling the appropriate java method. */ state=stack->interpreter; rtn = MPI_Sendrecv_replace_w_inner ( state, buf, count, datatype, dest, stag, source, rtag, comm, status); /* Now transfer the MPI_Status information to the outgoing array of integers */ d = dereference (arg1+8); /* status */ if (d->storage_type != 3) { rtn = MPI_ERR_ARG; } else { /* move the status array into the output arg */ get_data_primitive_address (d, 0, &p); assign_by_type (p, d->type, (void *)&status[0], 269); get_data_primitive_address (d, 1, &p); assign_by_type (p, d->type, (void *)&status[1], 269); get_data_primitive_address (d, 2, &p); assign_by_type (p, d->type, (void *)&status[2], 269); } return rtn; } /* end of MPI_Sendrecv_replace_w */ int MPI_Sendrecv_replace_w_inner (Interpreter_State *state, void *buf, int count, MPI_Datatype datatype, int dest, int stag, int source, int rtag, MPI_Comm comm, int status[5] ) { int rtn; MPI_Status mstatus; rtn = MPI_Sendrecv_replace (buf, count, datatype, dest, stag, source, rtag, comm, &mstatus); status[0] = mstatus.MPI_SOURCE; status[1] = mstatus.MPI_TAG; status[2] = mstatus.MPI_ERROR; return rtn; } /* end of MPI_Sendrecv_replace_w_inner */ int MPI_Type_contiguous_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_contiguous_w */ int MPI_Type_vector_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_vector_w */ int MPI_Type_hvector_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_hvector_w */ int MPI_Type_indexed_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_indexed_w */ int MPI_Type_hindexed_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_hindexed_w */ int MPI_Type_struct_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_struct_w */ int MPI_Address_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Address_w */ int MPI_Type_extent_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_extent_w */ int MPI_Type_size_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_size_w */ int MPI_Type_lb_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_lb_w */ int MPI_Type_ub_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_ub_w */ int MPI_Type_commit_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_commit_w */ int MPI_Type_free_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Type_free_w */ int MPI_Get_elements_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Get_elements_w */ int MPI_Pack_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Pack_w */ int MPI_Unpack_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Unpack_w */ int MPI_Pack_size_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Pack_size_w */ /* Collectives */ int MPI_Barrier_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; MPI_Comm comm; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 1) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; /* comm = slong (arg1+0); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1); state = stack->interpreter; rtn = MPI_Barrier_w_inner (state, comm); return rtn; } /* end of MPI_Barrier_w */ int MPI_Barrier_w_inner ( Interpreter_State *state, MPI_Comm comm ) { return MPI_Barrier (comm); } /* end of MPI_Barrier_w_inner */ int MPI_Bcast_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; MPI_Comm comm; Interpreter_State *state; void *sendbuf; int sendcount; MPI_Datatype sendtype; int root; nargs = dereference(stack->top-1)->slong; if (nargs != 5) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); root = slong (arg1+3); /* comm = slong (arg1+4); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+4); state = stack->interpreter; rtn = MPI_Bcast_w_inner (state, sendbuf, sendcount, sendtype, root, comm); return rtn; } /* end of MPI_Bcast_w */ int MPI_Bcast_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, int root, MPI_Comm comm ) { return MPI_Bcast (sendbuf, sendcount, sendtype, root, comm); } /* end of MPI_Bcast_w_inner */ int MPI_Gather_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; void *sendbuf; int sendcount; MPI_Datatype sendtype; void *recvbuf; int recvcount; MPI_Datatype recvtype; int root; MPI_Comm comm; nargs = dereference(stack->top-1)->slong; if (nargs != 8) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); d = dereference (arg1+3); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcount = slong (arg1+4); recvtype = impi_to_mpi_datatype (slong (arg1+5)); root = slong (arg1+6); /* comm = slong (arg1+7); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+7); state = stack->interpreter; rtn = MPI_Gather_w_inner (state, sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm); return rtn; } /* end of MPI_Gather_w */ int MPI_Gather_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm ) { return MPI_Gather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm); } /* end of MPI_Gather_w_inner */ int MPI_Gatherv_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; int sendcount; MPI_Datatype sendtype; void *recvbuf; Datum *recvcountsD; int *recvcounts; Datum *displsD; int *displs; MPI_Datatype recvtype; int root; MPI_Comm comm; Interpreter_State *state; int len; nargs = dereference(stack->top-1)->slong; if (nargs != 9) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); d = dereference (arg1+3); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcountsD = dereference (arg1+4); if ((recvcountsD->storage_type != 3) || (recvcountsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (recvcountsD, 0, (void **)&recvcounts); len = recvcountsD->array_length; displsD = dereference (arg1+5); if ((displsD->storage_type != 3) || (displsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (displsD, 0, (void **)&displs); recvtype = impi_to_mpi_datatype (slong (arg1+6)); root = slong (arg1+7); /* comm = slong (arg1+8); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+8); state = stack->interpreter; rtn = MPI_Gatherv_w_inner (state, sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, len, recvtype, root, comm); return rtn; } /* end of MPI_Gather_w */ int MPI_Gatherv_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int *recvcounts, int *displs, int len, MPI_Datatype recvtype, int root, MPI_Comm comm) { return MPI_Gatherv (sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, root, comm); } /* end of MPI_Gatherv_w_inner */ int MPI_Scatter_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; void *sendbuf; int sendcount; MPI_Datatype sendtype; void *recvbuf; int recvcount; MPI_Datatype recvtype; int root; MPI_Comm comm; nargs = dereference(stack->top-1)->slong; if (nargs != 8) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); d = dereference (arg1+3); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcount = slong (arg1+4); recvtype = impi_to_mpi_datatype (slong (arg1+5)); root = slong (arg1+6); /* comm = slong (arg1+7); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+7); state = stack->interpreter; rtn = MPI_Scatter_w_inner (state, sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm); return rtn; } /* end of MPI_Scatter_w */ int MPI_Scatter_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm ) { return MPI_Scatter (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, root, comm); } /* end of MPI_Scatter_w_inner */ int MPI_Scatterv_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; Datum *sendcountsD; int *sendcounts; Datum *displsD; int *displs; MPI_Datatype sendtype; void *recvbuf; int recvcount; MPI_Datatype recvtype; int root; MPI_Comm comm; Interpreter_State *state; int len; nargs = dereference(stack->top-1)->slong; if (nargs != 9) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcountsD = dereference (arg1+1); if ((sendcountsD->storage_type != 3) || (sendcountsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (sendcountsD, 0, (void **)&sendcounts); len = sendcountsD->array_length; displsD = dereference (arg1+2); if ((displsD->storage_type != 3) || (displsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (displsD, 0, (void **)&displs); sendtype = impi_to_mpi_datatype (slong (arg1+3)); d = dereference (arg1+4); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcount = slong (arg1+5); recvtype = impi_to_mpi_datatype (slong (arg1+6)); root = slong (arg1+7); /* comm = slong (arg1+8); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+8); state = stack->interpreter; rtn = MPI_Scatterv_w_inner (state, sendbuf, sendcounts, displs, len, sendtype, recvbuf, recvcount, recvtype, root, comm); return rtn; } /* end of MPI_Scatterv_w */ int MPI_Scatterv_w_inner ( Interpreter_State *state, void *sendbuf, int *sendcounts, int *displs, int len, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, int root, MPI_Comm comm ) { return MPI_Scatterv (sendbuf, sendcounts, displs, sendtype, recvbuf, recvcount, recvtype, root, comm); } /* end of MPI_Scatterv_w_inner */ int MPI_Allgather_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; void *sendbuf; int sendcount; MPI_Datatype sendtype; void *recvbuf; int recvcount; MPI_Datatype recvtype; MPI_Comm comm; nargs = dereference(stack->top-1)->slong; if (nargs != 7) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); d = dereference (arg1+3); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcount = slong (arg1+4); recvtype = impi_to_mpi_datatype (slong (arg1+5)); /* comm = slong (arg1+6); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+6); state = stack->interpreter; rtn = MPI_Allgather_w_inner (state, sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm); return rtn; } /* end of MPI_Allgather_w */ int MPI_Allgather_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm ) { return MPI_Allgather (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm); } /* end of MPI_Allgather_w_inner */ int MPI_Allgatherv_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; int sendcount; MPI_Datatype sendtype; void *recvbuf; Datum *recvcountsD; int *recvcounts; Datum *displsD; int *displs; MPI_Datatype recvtype; MPI_Comm comm; Interpreter_State *state; int len; nargs = dereference(stack->top-1)->slong; if (nargs != 8) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); d = dereference (arg1+3); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcountsD = dereference (arg1+4); if ((recvcountsD->storage_type != 3) || (recvcountsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (recvcountsD, 0, (void **)&recvcounts); len = recvcountsD->array_length; displsD = dereference (arg1+5); if ((displsD->storage_type != 3) || (displsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (displsD, 0, (void **)&displs); recvtype = impi_to_mpi_datatype (slong (arg1+6)); /* comm = slong (arg1+7); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+7); state = stack->interpreter; rtn = MPI_Allgatherv_w_inner (state, sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, len, recvtype, comm); return rtn; } /* end of MPI_Allgather_w */ int MPI_Allgatherv_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int *recvcounts, int *displs, int len, MPI_Datatype recvtype, MPI_Comm comm) { return MPI_Allgatherv (sendbuf, sendcount, sendtype, recvbuf, recvcounts, displs, recvtype, comm); } /* end of MPI_Allgatherv_w_inner */ int MPI_Alltoall_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; void *sendbuf; int sendcount; MPI_Datatype sendtype; void *recvbuf; int recvcount; MPI_Datatype recvtype; MPI_Comm comm; nargs = dereference(stack->top-1)->slong; if (nargs != 7) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcount = slong (arg1+1); sendtype = impi_to_mpi_datatype (slong (arg1+2)); d = dereference (arg1+3); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcount = slong (arg1+4); recvtype = impi_to_mpi_datatype (slong (arg1+5)); /* comm = slong (arg1+6); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+6); state = stack->interpreter; rtn = MPI_Alltoall_w_inner (state, sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm); return rtn; } /* end of MPI_Alltoall_w */ int MPI_Alltoall_w_inner ( Interpreter_State *state, void *sendbuf, int sendcount, MPI_Datatype sendtype, void *recvbuf, int recvcount, MPI_Datatype recvtype, MPI_Comm comm ) { return MPI_Alltoall (sendbuf, sendcount, sendtype, recvbuf, recvcount, recvtype, comm); } /* end of MPI_Alltoall_w_inner */ int MPI_Alltoallv_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; Datum *sendcountsD; int *sendcounts; Datum *sdisplsD; int *sdispls; MPI_Datatype sendtype; void *recvbuf; Datum *recvcountsD; int *recvcounts; Datum *rdisplsD; int *rdispls; MPI_Datatype recvtype; MPI_Comm comm; Interpreter_State *state; int len; nargs = dereference(stack->top-1)->slong; if (nargs != 9) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); sendcountsD = dereference (arg1+1); if ((sendcountsD->storage_type != 3) || (sendcountsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (sendcountsD, 0, (void **)&sendcounts); sdisplsD = dereference (arg1+2); if ((sdisplsD->storage_type != 3) || (sdisplsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (sdisplsD, 0, (void **)&sdispls); sendtype = impi_to_mpi_datatype (slong (arg1+3)); d = dereference (arg1+4); get_data_primitive_address (d, 0, (void **)&recvbuf); recvcountsD = dereference (arg1+5); if ((recvcountsD->storage_type != 3) || (recvcountsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (recvcountsD, 0, (void **)&recvcounts); len = recvcountsD->array_length; rdisplsD = dereference (arg1+6); if ((rdisplsD->storage_type != 3) || (rdisplsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (rdisplsD, 0, (void **)&rdispls); recvtype = impi_to_mpi_datatype (slong (arg1+7)); /* comm = slong (arg1+8); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+8); state = stack->interpreter; rtn = MPI_Alltoallv_w_inner (state, sendbuf, sendcounts, sdispls, sendtype, recvbuf, recvcounts, rdispls, len, recvtype, comm); return rtn; } /* end of MPI_Alltoallv_w */ int MPI_Alltoallv_w_inner ( Interpreter_State *state, void *sendbuf, int *sendcounts, int *sdispls, MPI_Datatype sendtype, void *recvbuf, int *recvcounts, int *rdispls, int len, MPI_Datatype recvtype, MPI_Comm comm) { return MPI_Alltoallv (sendbuf, sendcounts, sdispls, sendtype, recvbuf, recvcounts, rdispls, recvtype, comm); } /* end of MPI_Alltoallv_w_inner */ int MPI_Reduce_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; void *recvbuf; int count; MPI_Datatype datatype; MPI_Op op; int root; MPI_Comm comm; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 7) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&recvbuf); count = slong (arg1+2); datatype = impi_to_mpi_datatype (slong (arg1+3)); op = impi_to_mpi_operation (slong (arg1+4)); root = slong (arg1+5); /* comm = slong (arg1+6); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+6); state = stack->interpreter; rtn = MPI_Reduce_w_inner (state, sendbuf, recvbuf, count, datatype, op, root, comm); return rtn; } /* end of MPI_Reduce_w */ int MPI_Reduce_w_inner ( Interpreter_State *state, void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, int root, MPI_Comm comm ) { int i; long *pl; struct LongInt { long l; int i; } in[30], out[30]; void *sb, *rb; int rtn; if (datatype == MPI_LONG_INT) { if (count > 30) { fprintf (stderr, "%s %s", "Error in MPI_Reduce_w_inner: ", "Count cannot exceed 30 for MPI_LONG_INT\n"); return MPI_ERR_COUNT; } sb = (void *)in; rb = (void *)out; pl = (long *)sendbuf; for (i = 0; i < count; i++) { in[i].l = *pl++; in[i].i = *pl++; } } else { sb = sendbuf; rb = recvbuf; } rtn = MPI_Reduce (sb, rb, count, datatype, op, root, comm); if (datatype == MPI_LONG_INT) { pl = (long *)recvbuf; for (i = 0; i < count; i++) { (*pl++) = out[i].l; (*pl++) = out[i].i; } } return rtn; } /* end of MPI_Reduce_w_inner */ int MPI_Allreduce_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; void *recvbuf; int count; MPI_Datatype datatype; MPI_Op op; MPI_Comm comm; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 6) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&recvbuf); count = slong (arg1+2); datatype = impi_to_mpi_datatype (slong (arg1+3)); op = impi_to_mpi_operation (slong (arg1+4)); /* comm = slong (arg1+5); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+5); state = stack->interpreter; rtn = MPI_Allreduce_w_inner (state, sendbuf, recvbuf, count, datatype, op, comm); return rtn; } /* end of MPI_Allreduce_w */ int MPI_Allreduce_w_inner ( Interpreter_State *state, void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm ) { return MPI_Allreduce (sendbuf, recvbuf, count, datatype, op, comm); } /* end of MPI_Allreduce_w_inner */ int MPI_Reduce_scatter_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; void *recvbuf; Datum *countsD; int *counts; MPI_Datatype datatype; MPI_Op op; MPI_Comm comm; Interpreter_State *state; int len; nargs = dereference(stack->top-1)->slong; if (nargs != 6) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&recvbuf); countsD = dereference (arg1+2); if ((countsD->storage_type != 3) || (countsD->type != 269)) { return MPI_ERR_ARG; } get_data_primitive_address (countsD, 0, (void **)&counts); len = countsD->array_length; datatype = impi_to_mpi_datatype (slong (arg1+3)); op = impi_to_mpi_operation (slong (arg1+4)); /* comm = slong (arg1+5); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+5); state = stack->interpreter; rtn = MPI_Reduce_scatter_w_inner (state, sendbuf, recvbuf, counts, len, datatype, op, comm); return rtn; } /* end of MPI_Reduce_scatter_w */ int MPI_Reduce_scatter_w_inner ( Interpreter_State *state, void *sendbuf, void *recvbuf, int *counts, int len, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm ) { return MPI_Reduce_scatter (sendbuf, recvbuf, counts, datatype, op, comm); } /* end of MPI_Reduce_scatter_w_inner */ int MPI_Scan_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; void *sendbuf; void *recvbuf; int count; MPI_Datatype datatype; MPI_Op op; MPI_Comm comm; Interpreter_State *state; nargs = dereference(stack->top-1)->slong; if (nargs != 6) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, (void **)&sendbuf); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&recvbuf); count = slong (arg1+2); datatype = impi_to_mpi_datatype (slong (arg1+3)); op = impi_to_mpi_operation (slong (arg1+4)); /* comm = slong (arg1+5); comm = impi_to_mpi_communicator(comm); */ comm = mpicomm (arg1+5); state = stack->interpreter; rtn = MPI_Scan_w_inner (state, sendbuf, recvbuf, count, datatype, op, comm); return rtn; } /* end of MPI_Scan_w */ int MPI_Scan_w_inner ( Interpreter_State *state, void *sendbuf, void *recvbuf, int count, MPI_Datatype datatype, MPI_Op op, MPI_Comm comm ) { return MPI_Scan (sendbuf, recvbuf, count, datatype, op, comm); } /* end of MPI_Scan_w_inner */ int MPI_Op_create_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Op_create_w */ int MPI_Op_create_w_inner ( Interpreter_State *state, MPI_Comm comm ) { int rtn = 0; return rtn; } /* end of MPI_Op_create_w_inner */ int MPI_Op_free_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Op_free_w */ int MPI_Op_free_w_inner ( Interpreter_State *state, MPI_Comm comm ) { int rtn = 0; return rtn; } /* end of MPI_Op_free_w_inner */ /* End of collectives */ int MPI_Group_size_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Group group; int *size; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; group = mpigroup (arg1); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&size); rtn = MPI_Group_size_w_inner (state, group, size); return rtn; } /* end of MPI_Group_size_w */ int MPI_Group_rank_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Group group; int *rank; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; group = mpigroup (arg1); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&rank); rtn = MPI_Group_rank_w_inner (state, group, rank); return rtn; } /* end of MPI_Group_rank_w */ int MPI_Comm_group_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm comm; MPI_Group *group; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&group); rtn = MPI_Comm_group_w_inner (state, comm, group); return rtn; } /* end of MPI_Comm_group_w */ int MPI_Group_incl_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Group group; int n; int *ranks; MPI_Group *newgroup; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 4) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; group = mpigroup (arg1); n = slong (arg1+1); get_data_primitive_address (arg1+2, 0, (void **)&ranks); get_data_primitive_address (arg1+3, 0, (void **)&newgroup); rtn = MPI_Group_incl_w_inner (state, group, n, ranks, newgroup); return rtn; } /* end of MPI_Group_incl_w */ int MPI_Group_free_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Group *group; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 1) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; get_data_primitive_address (arg1, 0, (void **)&group); rtn = MPI_Group_free_w_inner (state, group); return rtn; } /* end of MPI_Group_free_w */ int MPI_Comm_dup_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm comm; MPI_Comm *newcomm; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); get_data_primitive_address (arg1+1, 0, (void **)&newcomm); rtn = MPI_Comm_dup_w_inner (state, comm, newcomm); return rtn; } /* end of MPI_Comm_dup_w */ int MPI_Comm_create_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm comm; MPI_Group group; MPI_Comm *newcomm; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 3) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); group = mpigroup (arg1+1); get_data_primitive_address (arg1+2, 0, (void **)&newcomm); rtn = MPI_Comm_create_w_inner (state, comm, group, newcomm); return rtn; } /* end of MPI_Comm_create_w */ int MPI_Comm_split_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm comm; int color; int key; MPI_Comm *newcomm; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 4) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); color = slong (arg1+1); key = slong (arg1+2); get_data_primitive_address (arg1+3, 0, (void **)&newcomm); rtn = MPI_Comm_split_w_inner (state, comm, color, key, newcomm); return rtn; } /* end of MPI_Comm_split_w */ int MPI_Comm_free_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm *comm; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 1) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; get_data_primitive_address (arg1, 0, (void **)&comm); rtn = MPI_Comm_free_w_inner (state, comm); return rtn; } /* end of MPI_Comm_free_w */ int MPI_Intercomm_create_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm local_comm; int local_leader; MPI_Comm peer_comm; int remote_leader; int tag; MPI_Comm *newintercomm; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 6) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; local_comm = mpicomm (arg1); local_leader = slong (arg1+1); peer_comm = mpicomm (arg1+2); remote_leader = slong (arg1+3); tag = slong (arg1+4); get_data_primitive_address (arg1+5, 0, (void **)&newintercomm); rtn = MPI_Intercomm_create_w_inner (state, local_comm, local_leader, peer_comm, remote_leader, tag, newintercomm); return rtn; } /* end of MPI_Intercomm_create_w */ int MPI_Intercomm_merge_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm intercomm; int high; MPI_Comm *newintracomm; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 3) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; intercomm = mpicomm (arg1); high = slong (arg1+1); get_data_primitive_address (arg1+2, 0, (void **)&newintracomm); rtn = MPI_Intercomm_merge_w_inner (state, intercomm, high, newintracomm); return rtn; } /* end of MPI_Intercomm_merge_w */ int MPI_Group_size_w_inner ( Interpreter_State *state, MPI_Group group, int *size ) { int rtn; rtn = MPI_Group_size (group, size); return rtn; } /* end of MPI_Group_size_w_inner */ int MPI_Group_rank_w_inner ( Interpreter_State *state, MPI_Group group, int *rank ) { int rtn; rtn = MPI_Group_rank (group, rank); return rtn; } /* end of MPI_Group_rank_w_inner */ int MPI_Comm_group_w_inner ( Interpreter_State *state, MPI_Comm comm, MPI_Group *group ) { int rtn; rtn = MPI_Comm_group (comm, group); return rtn; } /* end of MPI_Comm_group_w_inner */ int MPI_Group_incl_w_inner ( Interpreter_State *state, MPI_Group group, int n, int *ranks, MPI_Group *newgroup ) { int rtn; rtn = MPI_Group_incl (group, n, ranks, newgroup); return rtn; } /* end of MPI_Group_incl_w_inner */ int MPI_Group_free_w_inner ( Interpreter_State *state, MPI_Group *group ) { int rtn; rtn = MPI_Group_free (group); return rtn; } /* end of MPI_Group_free_w_inner */ int MPI_Comm_dup_w_inner ( Interpreter_State *state, MPI_Comm comm, MPI_Comm *newcomm ) { int rtn; rtn = MPI_Comm_dup (comm, newcomm); return rtn; } /* end of MPI_Comm_dup_w_inner */ int MPI_Comm_create_w_inner ( Interpreter_State *state, MPI_Comm comm, MPI_Group group, MPI_Comm *newcomm ) { int rtn; rtn = MPI_Comm_create (comm, group, newcomm); return rtn; } /* end of MPI_Comm_create_w_inner */ int MPI_Comm_split_w_inner ( Interpreter_State *state, MPI_Comm comm, int color, int key, MPI_Comm *newcomm ) { int rtn; rtn = MPI_Comm_split (comm, color, key, newcomm); return rtn; } /* end of MPI_Comm_split_w_inner */ int MPI_Comm_free_w_inner ( Interpreter_State *state, MPI_Comm *comm ) { int rtn; rtn = MPI_Comm_free (comm); return rtn; } /* end of MPI_Comm_free_w_inner */ int MPI_Intercomm_create_w_inner ( Interpreter_State *state, MPI_Comm local_comm, int local_leader, MPI_Comm peer_comm, int remote_leader, int tag, MPI_Comm *newintercomm ) { int rtn; rtn = MPI_Intercomm_create (local_comm, local_leader, peer_comm, remote_leader, tag, newintercomm); return rtn; } /* end of MPI_Intercomm_create_w_inner */ int MPI_Intercomm_merge_w_inner ( Interpreter_State *state, MPI_Comm intercomm, int high, MPI_Comm *newintracomm ) { int rtn; rtn = MPI_Intercomm_merge (intercomm, high, newintracomm); return rtn; } /* end of MPI_Intercomm_merge_w_inner */ int MPI_Group_translate_ranks_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_translate_ranks_w */ int MPI_Group_compare_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_compare_w */ int MPI_Group_union_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_union_w */ int MPI_Group_intersection_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_intersection_w */ int MPI_Group_difference_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_difference_w */ int MPI_Group_excl_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_excl_w */ int MPI_Group_range_incl_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_range_incl_w */ int MPI_Group_range_excl_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Group_range_excl_w */ int MPI_Comm_compare_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Comm_compare_w */ int MPI_Comm_test_inter_w (stack) Data_Stack *stack; { int rtn; MPI_Comm comm; int flag; int nargs; Datum *arg1, *s; void *tp; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); rtn = MPI_Comm_test_inter (comm, &flag); s = dereference (arg1+1); get_data_primitive_address (s, 0, &tp); assign_by_type (tp, s->type, (void *)&flag, 269); return rtn; } /* end of MPI_Comm_test_inter_w */ int MPI_Comm_remote_size_w (stack) Data_Stack *stack; { int rtn; MPI_Comm comm; int size; int nargs; Datum *arg1, *s; void *tp; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); rtn = MPI_Comm_remote_size (comm, &size); s = dereference (arg1+1); get_data_primitive_address (s, 0, &tp); assign_by_type (tp, s->type, (void *)&size, 269); return rtn; } /* end of MPI_Comm_remote_size_w */ int MPI_Comm_remote_group_w (stack) Data_Stack *stack; { int rtn = 0; int nargs; Datum *arg1, *d; Interpreter_State *state; MPI_Comm comm; MPI_Group *group; state = stack->interpreter; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; comm = mpicomm (arg1); d = dereference (arg1+1); get_data_primitive_address (d, 0, (void **)&group); rtn = MPI_Comm_remote_group_w_inner (state, comm, group); return rtn; } /* end of MPI_Comm_remote_group_w */ int MPI_Comm_remote_group_w_inner ( Interpreter_State *state, MPI_Comm comm, MPI_Group *group ) { int rtn; rtn = MPI_Comm_remote_group (comm, group); return rtn; } /* end of MPI_Comm_group_w_inner */ int MPI_Keyval_create_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Keyval_create_w */ int MPI_Keyval_free_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Keyval_free_w */ int MPI_Attr_put_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Attr_put_w */ int MPI_Attr_get_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Attr_get_w */ int MPI_Attr_delete_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Attr_delete_w */ int MPI_Cart_create_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_create_w */ int MPI_Dims_create_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Dims_create_w */ int MPI_Graph_create_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Graph_create_w */ int MPI_Topo_test_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Topo_test_w */ int MPI_Graphdims_get_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Graphdims_get_w */ int MPI_Graph_get_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Graph_get_w */ int MPI_Cartdim_get_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cartdim_get_w */ int MPI_Cart_get_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_get_w */ int MPI_Cart_rank_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_rank_w */ int MPI_Cart_coords_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_coords_w */ int MPI_Graph_neighbors_count_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Graph_neighbors_count_w */ int MPI_Graph_neighbors_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Graph_neighbors_w */ int MPI_Cart_shift_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_shift_w */ int MPI_Cart_sub_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_sub_w */ int MPI_Cart_map_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Cart_map_w */ int MPI_Graph_map_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Graph_map_w */ int MPI_Get_processor_name_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Get_processor_name_w */ int MPI_Errhandler_create_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Errhandler_create_w */ int MPI_Errhandler_set_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Errhandler_set_w */ int MPI_Errhandler_get_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Errhandler_get_w */ int MPI_Errhandler_free_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Errhandler_free_w */ int MPI_Error_string_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Error_string_w */ int MPI_Error_class_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Error_class_w */ int MPI_Wtime_w (stack) Data_Stack *stack; { int rtn = 0; double MPI_Wtime (); return rtn; } /* end of MPI_Wtime_w */ int MPI_Wtick_w (stack) Data_Stack *stack; { int rtn = 0; double MPI_Wtick (); return rtn; } /* end of MPI_Wtick_w */ int MPI_Initialized_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Initialized_w */ int MPI_Abort_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Abort_w */ int MPI_Get_version_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Get_version_w */ int MPI_Finalized_w (stack) Data_Stack *stack; { int rtn = 0; return rtn; } /* end of MPI_Finalized_w */ int MPI_Init_w (stack) Data_Stack *stack; { int rtn; rtn = MPI_Init (0, NULL); return rtn; } /* end of MPI_Init_w */ int MPI_Finalize_w (stack) Data_Stack *stack; { int rtn; rtn = MPI_Finalize (); return rtn; } /* end of MPI_Finalize_w */ int MPI_Send_w (stack) Data_Stack *stack; { int rtn; int nargs; Datum *arg1, *d; void *buf; int count; MPI_Datatype datatype; int dest, tag; MPI_Comm comm; nargs = dereference(stack->top-1)->slong; if (nargs != 6) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, &buf); count = slong (arg1+1); datatype = impi_to_mpi_datatype (slong (arg1+2)); dest = slong (arg1+3); tag = slong (arg1+4); /* comm = impi_to_mpi_communicator (slong (arg1+5)); */ comm = mpicomm (arg1+5); rtn = MPI_Send (buf, count, datatype, dest, tag, comm); return rtn; } /* end of MPI_Send_w */ int MPI_Recv_w (stack) Data_Stack *stack; { int rtn; int nargs; Datum *arg1; void *buf; Datum *d; int count; MPI_Datatype datatype; int source; int tag; MPI_Comm comm; MPI_Status status; void *p; nargs = dereference(stack->top-1)->slong; if (nargs != 7) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; d = dereference (arg1); get_data_primitive_address (d, 0, &buf); count = slong (arg1+1); datatype = impi_to_mpi_datatype (slong (arg1+2)); source = slong (arg1+3); tag = slong (arg1+4); /* comm = impi_to_mpi_communicator (slong (arg1+5)); */ comm = mpicomm (arg1+5); rtn = MPI_Recv (buf, count, datatype, source, tag, comm, &status); d = dereference (arg1+6); /* status */ if (d->storage_type != 3) { rtn = MPI_ERR_ARG; } else { get_data_primitive_address (d, 0, &p); assign_by_type (p, d->type, (void *)&status.MPI_SOURCE, 269); get_data_primitive_address (d, 1, &p); assign_by_type (p, d->type, (void *)&status.MPI_TAG, 269); get_data_primitive_address (d, 2, &p); assign_by_type (p, d->type, (void *)&status.MPI_ERROR, 269); } return rtn; } /* end of MPI_Recv_w */ int MPI_Comm_size_w (stack) Data_Stack *stack; { int rtn; MPI_Comm comm; int size; int nargs; Datum *arg1, *s; void *tp; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; /* comm = impi_to_mpi_communicator (slong (arg1)); */ comm = mpicomm (arg1); rtn = MPI_Comm_size (comm, &size); s = dereference (arg1+1); get_data_primitive_address (s, 0, &tp); assign_by_type (tp, s->type, (void *)&size, 269); return rtn; } /* end of MPI_Comm_size_w */ int MPI_Comm_rank_w (stack) Data_Stack *stack; { int rtn; MPI_Comm comm; int rank; int nargs; Datum *arg1, *r; void *tp; nargs = dereference(stack->top-1)->slong; if (nargs != 2) { return MPI_ERR_ARG; } arg1 = (stack->top-1) - nargs; /* comm = impi_to_mpi_communicator (slong (arg1)); */ comm = mpicomm (arg1); rtn = MPI_Comm_rank (comm, &rank); r = dereference (arg1+1); get_data_primitive_address (r, 0, &tp); assign_by_type (tp, r->type, (void *)&rank, 269); return rtn; } /* end of MPI_Comm_rank_w */ /*****************************************************************/ /* Non-commutative reduce operation */ /* This routine is a non-commutative, associative binary operation to be used as a test for the MPI reduce functions. It operates on pairs of ints, performing independent operations on the low order 8 bits and the remaining the high-order bits. The low order 8 bits of the result are simply the low order 8 bits of the left operand. The high order bits of the result are the sum of the high order bits of the two operands. For operands that are not ints, nothing is done. In effect, this means that for non-ints, the operation returns the right operand. Note that this also qualifies as a non-commutative operation. */ void nonComm (void *left, void* right, int *len, MPI_Datatype *datatype) { int *l, *r; int i; /* Only operate on ints */ if (*datatype != MPI_INT) { return; } l = (int *) left; r = (int *) right; for (i = 0; i < *len; i++) { r[i] = ((l[i]/256 + r[i]/256) * 256) | (l[i] & 0xff); } } /* end of nonCommOp */ int get_nonComm_op (MPI_Op *op) { if (MPI_Op_create (nonComm, 0, op) != MPI_SUCCESS) { fprintf (stderr, "Error from MPI_Op_create.\n"); *op = MPI_OP_NULL; return -1; } return 0; } /* end of get_nonComm_op */ /** $Id: report_real.c 56 2005-05-02 20:03:33Z wgeorge $ */ static int currReportLevel = 0; void send_report_inner ( Interpreter_State *state, int level, int rank, char *brief_msg, char *long_msg ) { if (brief_msg == NULL) { brief_msg = " < error msg missing > "; } printf ("INFO %d from rank %d : %s\n", level, rank, brief_msg); if (long_msg != NULL) { printf (" %s\n", long_msg); } currReportLevel = (((abs(level))>(currReportLevel))?(abs(level)):(currReportLevel)); } /* end of send_report_inner */ void set_report_level (int level) { currReportLevel = level; } int get_report_level () { return currReportLevel; } /******************************************************** The following code provides the getc look-alike that will be used in the lex-generated code. Note that it gets characters from a memory buffer that is provided by a call to set_script_buffer. Note that the FILE* args are ignored. ********************************************************/ void set_script_buffer (interp_state, buf, len) Interpreter_State *interp_state; char *buf; int len; { interp_state->script.script_buffer = buf; interp_state->script.curr_script_pos = buf; if (buf != NULL) { interp_state->script.eof_script_pos = buf + len; } else { interp_state->script.eof_script_pos = NULL; } lineno = 1; } /* end of set script_buffer */ int script_getc (stream) FILE *stream; { if (LY_Script->curr_script_pos < LY_Script->eof_script_pos) { if (*(LY_Script->curr_script_pos) != 0) { return *((LY_Script->curr_script_pos)++); } LY_Script->curr_script_pos = LY_Script->eof_script_pos; } return EOF; /* for error or eof */ } /* end of script_getc */ int script_ungetc (c, stream) int c; FILE *stream; { if (LY_Script->script_buffer != NULL) { *(--(LY_Script->curr_script_pos)) = c; } else { return EOF; } return c; } /* end of script_ungetc */ int yywrap () { return 1; } int string_type () { return 261; } /* end of string_type */ main (argc, argv) int argc; char **argv; { int i; int yy; int rtn; Interpreter_State interp_state; /* JMS 7 Oct 1999 Ensure that these two variables are initialized to some default */ int verbose = 0; int startupOnly = 0; MPI_Init (&argc, &argv); MPI_Comm_size (MPI_COMM_WORLD, &Num_MPI_Procs); MPI_Comm_rank (MPI_COMM_WORLD, &My_MPI_Rank); progname = argv[0]; if (argc > 4) { fprintf(stderr, "Usage: %s [-v] [-master] [-s]"); exit(1); } /* JMS 7 Oct 1999 Re-wrote the arg checking stuff */ for (i = 0; i < argc; i++) { if (strcmp(argv[i], "-v") == 0) verbose = 1; else if (strcmp(argv[i], "-master") == 0) iAmMaster = 1; else if (strcmp(argv[i], "-s") == 0) startupOnly = 1; } Verbose = verbose; if (startupOnly) { printf ("Rank %d of %d processes is alive.\n", My_MPI_Rank, Num_MPI_Procs); printf ("Rank %d is exiting.\n", My_MPI_Rank); MPI_Finalize (); exit (0); } if (itm_handshake ()) { fprintf (stderr, "Fatal error in initial MPI Send/Recv handshake.\n"); exit (-1); } interp_state.masterRank = Controlling_Rank; interp_state.iAmMaster = iAmMaster; initialize_interpreter_state (&interp_state, verbose, Num_MPI_Procs, My_MPI_Rank, MPI_COMM_WORLD); while (! get_script (&interp_state)) { rtn = 0; while (!rtn) { /* CAN SYNCHRONIZE HERE */ reset_interpreter_machine (&interp_state); if (verbose) printf ("\n\nBEGIN PARSING \n"); if ((yy=yyparse ()) != 0) { fprintf (stderr, "Error parsing input; exiting script.\n"); send_report_inner (&interp_state, 3, interp_state.mpiRank, "Error parsing script.", NULL); break; } /* CAN UNSYNCHRONIZE HERE */ if (verbose) printf ("END PARSING \n"); /* add_program_termination (&interp_state); */ add_inst_execution_done (&interp_state); if (verbose) printf ("\nBEGIN EXECUTING \n"); rtn = execute (&interp_state); if (verbose) printf ("END EXECUTING \n\n"); } if (verbose) printf ("RETURN FROM EXECUTION\n\n"); end_of_test_handshake (&interp_state); } /* end of while (gets(fn)) */ if (verbose) { printf ("Rank %d is exiting.\n", My_MPI_Rank); } MPI_Finalize (); exit (0); } /* end of main */ /** end_of_test_handshake This little handshake is done at the end of the execution of each script. The master rank sends "DONE" to every rank. They recv and verify this then they send back "done". The master rank receives and verifies each "done". */ end_of_test_handshake (Interpreter_State *interp_state) { char c_arr[6]; int i; MPI_Status stat; int reportLevel; char doneMsg[6]; char longMsg[512]; strncpy (c_arr, "DONE", 4); /* master rank sends DONE */ if (interp_state->iAmMaster) { for (i = 0; i < interp_state->mpiNumProcs; i++) { if (i != interp_state->mpiRank) { if (MPI_Send (c_arr, 4, MPI_UNSIGNED_CHAR, i, i+10, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error sending DONE from controlling rank.\n" ); return -1; } } /* end of if i != mpiRank */ } } if ( ! interp_state->iAmMaster) { /* each rank recvs DONE */ if (MPI_Recv ( c_arr, 4, MPI_UNSIGNED_CHAR, interp_state->masterRank, interp_state->mpiRank+10, MPI_COMM_WORLD, &stat) != MPI_SUCCESS) { fprintf (stderr, "Error in end of test handshake: " "bad Recv from controlling rank.\n"); return -1; } if (strncmp (c_arr, "DONE", 4) != 0) { fprintf (stderr, "Error in end of test handshake: " "DONE not properly received.\n"); return -1; } /* each rank sends done0, done1, or whatever to master rank */ reportLevel = abs (get_report_level()); if (reportLevel > 9) { reportLevel = 9; } sprintf (doneMsg, "done%1d", reportLevel); /* each rank sends done to master rank */ if (MPI_Send (doneMsg, 5, MPI_UNSIGNED_CHAR, interp_state->masterRank, interp_state->mpiRank+10, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error sending done to controlling rank.\n" ); return -1; } } /* end of if ! iAmMaster */ /* master rank recvs done */ if (interp_state->iAmMaster) { reportLevel = abs(get_report_level ()); for (i = 0; i < interp_state->mpiNumProcs; i++) { if (i != interp_state->mpiRank) { if (MPI_Recv (c_arr, 5, MPI_UNSIGNED_CHAR, i, i+10, MPI_COMM_WORLD, &stat) != MPI_SUCCESS) { fprintf (stderr, "Error in end of test handshake: " "bad Recv from controlling rank.\n"); return -1; } if (strncmp (c_arr, "done", 4) != 0) { fprintf (stderr, "Error in end of test handshake: " " not properly received.\n"); return -1; } c_arr[5] = 0; reportLevel = (((reportLevel)>(atoi(c_arr+4)))?(reportLevel):(atoi(c_arr+4))); } /* end of if (i!=mpiRank) */ } if (reportLevel == 3) { sprintf (longMsg, "%s\n%s%s", "Some processes report an INDETERMINATE completion status.", "Please check both local and remote messages ", "for additional information." ); send_report_inner (interp_state, reportLevel, interp_state->mpiRank, "Final status of test is INDETERMINATE.", longMsg); } else if (reportLevel > 3) { sprintf (longMsg, "%s\n%s%s", "Some processes report a completion status of FAILURE.", "Please check both local and remote messages ", "for additional information." ); send_report_inner (interp_state, reportLevel, interp_state->mpiRank, "Final status of test is FAILURE.", longMsg); } else { send_report_inner (interp_state, 0, interp_state->mpiRank, "Final status of test is SUCCESS.", NULL); } } set_report_level (0); return 0; } /* end of end_of_test_handshake */ /* These are a couple of utility routines for turning ints into unsigned character arrays and back. This is needed so that during the initial handshake, we are sending and receiving only unsigned chars. */ void uint_to_c_array (unsigned int i, unsigned char c[4]) { c[3] = 0xff & i; c[2] = 0xff & (i >> 8); c[1] = 0xff & (i >> 16); c[0] = 0xff & (i >> 24); } void c_array_to_uint (unsigned int *i, unsigned char c[4]) { *i = c[3] | (c[2] << 8) | (c[1] << 16) | (c[0] << 24); } /******** Here is the code that handles moving around the test scripts. *********/ int get_script (interp_state) Interpreter_State *interp_state; { static char *Curr_Script_Buffer = NULL; unsigned int script_len; MPI_Status st; unsigned char c_arr[4]; static FILE *Script_Name_Fp = NULL; char filename[256]; int rtn; static char *script_buf; static unsigned int local_len; int i; /* If I am the controlling rank, get the script and send it out */ if (interp_state->iAmMaster) { /* open the script name file if necessary */ if (Script_Name_Fp == NULL) { if ((Script_Name_Fp = fopen ("scripts", "r")) == NULL) { fprintf(stderr, "Can't open file .\n"); return (-1); } } /* get the script file name */ if (fscanf(Script_Name_Fp, "%s", filename) != 1) { printf ( "No more scripts *******************************\n"); printf ("Sending shutdown message.\n"); /* send signal that there are no more scripts to all ranks */ local_len = 0; uint_to_c_array (local_len, c_arr); for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { if (MPI_Send (c_arr, 4, MPI_UNSIGNED_CHAR, i, i, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error sending shutdown message " "to rank %d.\n", i); fprintf (stderr, " Proceeding with shutdown.\n"); } } } for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { if (MPI_Recv (c_arr, 4, MPI_UNSIGNED_CHAR, i, i+42, MPI_COMM_WORLD, &st) != MPI_SUCCESS) { fprintf (stderr, "Error receiving shutdown ack" "from rank %d.\n", i); fprintf (stderr, " Proceeding with shutdown.\n"); } else if (strncmp ((char*)c_arr, "exit", 4)) { fprintf (stderr, "Error in shutdown ack" "from rank %d.\n", i); fprintf (stderr, " Proceeding with shutdown.\n"); } else { printf ( "Received shutdown ack from rank %d.\n", i); } } } return 1; } /* read the script into memory */ if (read_script (filename, &script_buf, &local_len)) { fprintf (stderr, "Error reading script file <%s>\n", filename); return -1; } printf ( "Sending script < %s > *********************************\n", filename); /* send the script to all ranks */ uint_to_c_array (local_len, c_arr); for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { if (MPI_Send (c_arr, 4, MPI_UNSIGNED_CHAR, i, i, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error sending script from controlling rank.\n" ); return -1; } if (MPI_Send (script_buf, local_len, MPI_UNSIGNED_CHAR, i, i+1, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error sending script from controlling rank.\n" ); return -1; } } } /* free previously allocated script space */ if ( Curr_Script_Buffer != NULL) { free (Curr_Script_Buffer); } /* allocate space for new script */ if ( (Curr_Script_Buffer = (char *)malloc (local_len)) == NULL) { fprintf (stderr, "Error allocating memory for test script.\n"); return -1; } memcpy (Curr_Script_Buffer, script_buf, local_len); /* free the script memory buffer */ free (script_buf); script_len = local_len; } else { /* I am not the master rank */ /* receive the length of the script */ if (MPI_Recv (c_arr, 4, MPI_UNSIGNED_CHAR, Controlling_Rank, My_MPI_Rank, MPI_COMM_WORLD, &st) != MPI_SUCCESS) { fprintf (stderr, "Error receiving script from controlling rank.\n"); return -1; } c_array_to_uint (&script_len, c_arr); if (script_len == 0) { memcpy (c_arr, "exit", 4); if (MPI_Send (c_arr, 4, MPI_UNSIGNED_CHAR, Controlling_Rank, My_MPI_Rank+42, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error sending exit ack from rank %d\n", interp_state->mpiRank); } return 1; } /* free previously allocated script space */ if ( Curr_Script_Buffer != NULL) { free (Curr_Script_Buffer); } /* allocate space for new script */ if ( (Curr_Script_Buffer = (char *)malloc (script_len)) == NULL) { fprintf (stderr, "Error allocating memory for test script.\n"); return -1; } /* Recv the script */ if (MPI_Recv (Curr_Script_Buffer, script_len, MPI_UNSIGNED_CHAR, Controlling_Rank, My_MPI_Rank+1, MPI_COMM_WORLD, &st) != MPI_SUCCESS) { fprintf (stderr, "Error receiving script from controlling rank.\n"); return -1; } } /* end of not master */ if (Verbose) { printf ("\nGot script in rank %d :\n", My_MPI_Rank); printf ("*********************************************\n"); printf ("%s", (char *)Curr_Script_Buffer); printf ("*********************************************\n"); printf ("\n"); } /* Tell lex code about it */ set_script_buffer (interp_state, Curr_Script_Buffer, script_len); return 0; } /* end of get_script */ int read_script (char *filename, char **script_buf, int *len) { char line[256]; char *p; FILE *fp; /* printf ("read script called with <%s>\n", filename); */ fp = fopen (filename, "r"); if (fp == NULL) { fprintf (stderr, "Unable to open file <%s>.\n", filename); return -1; } /* figure out length of file */ if (fseek (fp, 0L, SEEK_END) ) { fprintf (stderr, "Error accessing file <%s>.\n", filename); fclose (fp); return -1; } *len = ftell (fp) + 10; if (*len < 0) { fprintf (stderr, "Error accessing file <%s> length.\n", filename); fclose (fp); return -1; } rewind (fp); if ( (*script_buf = (char *)malloc (*len)) == NULL) { fprintf (stderr, "Unable to allocate memory for script buffer.\n"); fclose (fp); return -1; } p = *script_buf; while (fgets (line, sizeof(line), fp) != NULL) { if (line[0] == '~') { line[0] = ' '; } if (line[0] == '`') { *(p++) = '\n'; } else { strcpy (p, line); p += strlen (line); } } /* end of while */ fclose (fp); *(p++) = '\n'; *(p++) = 0; *len = p - *script_buf; /* printf ("script = <%s>\n", *script_buf); */ return 0; } /* end of read_script */ /*********** MPI handshake with ITM: controlling rank sends its rank (4 unsigned chars) to all other ranks all ranks recv controlling rank each rank sends to controlling rank 4 bytes (not it's rank) that uniquely encodes it's rank controlling rank recvs rank values from each rank and verifies In controlling rank: for each other rank construct a 256 byte test sequence that is unique for the given rank and contains all 256 values send the test sequence to the rank endfor In other ranks: recv the 256 byte sequence and verify make another test sequence and send it to the controlling rank In controlling rank: for each other rank, recv and verify the test sequence **********/ /* This routine combines the master/non-master functionality for historic reasons. It should be split into two routines. */ int itm_handshake () { int i, j; unsigned char buf[256]; unsigned char expected[256]; MPI_Status stat; unsigned int my_rank, controlling_rank, r; unsigned char c_arr[4]; /* send the rank of the controlling proc */ if (iAmMaster) { my_rank = My_MPI_Rank; uint_to_c_array (my_rank, c_arr); for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { if (MPI_Send (c_arr, 4, MPI_UNSIGNED_CHAR, i, i, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake.\n"); return -1; } } } Controlling_Rank = My_MPI_Rank; } else { /* Receive the rank of the controlling process */ if (MPI_Recv (c_arr, 4, MPI_UNSIGNED_CHAR, MPI_ANY_SOURCE, My_MPI_Rank, MPI_COMM_WORLD, &stat) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: bad Recv of controlling rank.\n"); return -1; } c_array_to_uint (&controlling_rank, c_arr); Controlling_Rank = controlling_rank; /* Check if it is plausible */ if ( (0 > Controlling_Rank) || (Controlling_Rank >= Num_MPI_Procs) ) { fprintf (stderr, "Error in ITM handshake: invalid controlling rank %d.\n", Controlling_Rank); return -1; } /* Send an int that identifies my rank */ /* this identifies my rank without being identical to it */ r = My_MPI_Rank + 2*Num_MPI_Procs; uint_to_c_array (r, c_arr); if (MPI_Send (c_arr, 4, MPI_UNSIGNED_CHAR, Controlling_Rank, My_MPI_Rank, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: Bad send of my rank id.\n"); return -1; } } /* Recv and verify the rank ids */ if (iAmMaster) { for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { if (MPI_Recv (c_arr, 4, MPI_UNSIGNED_CHAR, i, i, MPI_COMM_WORLD, &stat) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: " "bad Recv of rank id for rank %d.\n", i); return -1; } c_array_to_uint (&r, c_arr); if (r != i + 2*Num_MPI_Procs) { fprintf (stderr, "Error in ITM handshake: " "bad rank id for rank %d.\n", i); return -1; } } } /* Now send out a buffer of 256 characters to test Recv on IUT side. */ for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { make_test_seq (i, 0, buf); if (MPI_Send (buf, 256, MPI_UNSIGNED_CHAR, i, My_MPI_Rank, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: " "bad send in controlling rank.\n"); return -1; } } } } else { /* Recv a test buffer from the controlling rank */ if (MPI_Recv (buf, 256, MPI_UNSIGNED_CHAR, Controlling_Rank, Controlling_Rank, MPI_COMM_WORLD, &stat) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: bad Recv of test sequence.\n"); return -1; } /* verify the contents of the test buffer */ make_test_seq (My_MPI_Rank, 0, expected); for (i = 0; i < 256; i++) { if (buf[i] != expected[i]) { fprintf (stderr, "Error in ITM handshake: " "invalid contents of Recv'd test sequence.\n"); return -1; } } /* Now make a different test sequence and send it back */ make_test_seq (My_MPI_Rank, 2*Num_MPI_Procs+1, buf); if (MPI_Send (buf, 256, MPI_UNSIGNED_CHAR, Controlling_Rank, My_MPI_Rank, MPI_COMM_WORLD) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: bad Send of test sequence.\n"); return -1; } } /* Recv the test buffers from each rank and verify contents */ if (iAmMaster) { for (i = 0; i < Num_MPI_Procs; i++) { if (i != My_MPI_Rank) { /* get the sequence */ if (MPI_Recv (buf, 256, MPI_UNSIGNED_CHAR, i, i, MPI_COMM_WORLD, &stat) != MPI_SUCCESS) { fprintf (stderr, "Error in ITM handshake: " "bad Recv of test sequence " "in controlling rank.\n"); return -1; } /* verify contents */ make_test_seq (i, 2*Num_MPI_Procs+1, expected); for (j = 0; j < 256; j++) { if (buf[j] != expected[j]) { fprintf (stderr, "Error in ITM handshake: " "invalid contents of Recv'd " "test sequence " "in controlling rank.\n"); return -1; } } } } } return 0; } /* end of itm_handshake */ /* This routine fills in buf with 256 values in an arder that is dependant on the specified rank and offset. For a given offset, different ranks will produce different orders, unless the ranks differ by 128. */ int make_test_seq (int rank, int offset, unsigned char buf[256]) { int n, nn, i; /* n is odd - hence relatively prime to 256 */ n = 2 * (rank + offset) + 1; n = n % 256; nn = n; for (i = 0; i < 256; i++) { buf[i] = nn%256; nn += n; } return 0; } /* end of make_test_seq */ /************************/ exit_wrapper (int e) { MPI_Finalize (); exit (e); return 1; }