Open64: osprey/be/whirl2f/wn2f_expr.cxx Source File

00001 /*
00002  * Copyright 2003, 2004, 2005, 2006 PathScale, Inc.  All Rights Reserved.
00003  */
00004 
00005 /*
00006 
00007   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00008 
00009   This program is free software; you can redistribute it and/or modify it
00010   under the terms of version 2 of the GNU General Public License as
00011   published by the Free Software Foundation.
00012 
00013   This program is distributed in the hope that it would be useful, but
00014   WITHOUT ANY WARRANTY; without even the implied warranty of
00015   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00016 
00017   Further, this software is distributed without any warranty that it is
00018   free of the rightful claim of any third person regarding infringement 
00019   or the like.  Any license provided herein, whether implied or 
00020   otherwise, applies only to this software file.  Patent licenses, if 
00021   any, provided herein do not apply to combinations of this program with 
00022   other software, or any other product whatsoever.  
00023 
00024   You should have received a copy of the GNU General Public License along
00025   with this program; if not, write the Free Software Foundation, Inc., 59
00026   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00027 
00028   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00029   Mountain View, CA 94043, or:
00030 
00031   http://www.sgi.com
00032 
00033   For further information regarding this notice, see:
00034 
00035   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00036 
00037 */
00038 
00039 
00040 /* ====================================================================
00041  * ====================================================================
00042  *
00043  * Module: wn2f_expr.c
00044  * $Revision: 1.15 $
00045  * $Date: 05/12/05 08:59:32-08:00 $
00046  * $Author: bos@eng-24.pathscale.com $
00047  * $Source: /scratch/mee/2.4-65/kpro64-pending/be/whirl2f/SCCS/s.wn2f_expr.cxx $
00048  *
00049  * Revision history:
00050  *  12-Apr-95 - Original Version
00051  *
00052  * Description:
00053  *
00054  *   Translate a WN expression subtree to Fortran by means of an inorder 
00055  *   recursive descent traversal of the WHIRL IR.  Note that the routines
00056  *   to handle statements and loads/stores are in separate source files.
00057  *   Recursive translation of WN nodes should only use WN2F_Translate()!
00058  *
00059  * ====================================================================
00060  * ====================================================================
00061  */
00062 
00063 #ifdef _KEEP_RCS_ID
00064 /*REFERENCED*/
00065 static char *rcs_id = "$Source: /scratch/mee/2.4-65/kpro64-pending/be/whirl2f/SCCS/s.wn2f_expr.cxx $ $Revision: 1.15 $";
00066 #endif
00067 
00068 #include "whirl2f_common.h"
00069 #include "PUinfo.h"          /* In be/whirl2c directory */
00070 #include "tcon2f.h"
00071 #include "wn2f.h"
00072 #include "ty2f.h"
00073 #include "st2f.h"
00074 #include "wn2f_load_store.h"
00075 #include "intrn_info.h"          /* INTR macros */
00076 
00077 /*---- Fortran names for binary and unary arithmetic operations -------*/
00078 /*---------------------------------------------------------------------*/
00079 
00080 
00081 /* The builtin Fortran operations will begin with a special character
00082  * or an alphabetic character, where those beginning with an alphabetic
00083  * character will be applied like functions and all others will be
00084  * applied in usual infix format.  When a name begins with '_', it is
00085  * a whirl2f special symbol to be applied like a function.  It will
00086  * be implemented in a library made available to be linked in with 
00087  * compiled whirl2f code.
00088  */
00089 #define WN2F_IS_ALPHABETIC(opc) \
00090    ((Opc_Fname[opc][0]>='a' && Opc_Fname[opc][0]<='z') || \
00091     (Opc_Fname[opc][0]>='A' && Opc_Fname[opc][0]<='Z') || \
00092     (Opc_Fname[opc][0]=='_'))
00093 
00094 #define WN2F_IS_INFIX_OP(opc) \
00095    (Opc_Fname[opc]!=NULL && !WN2F_IS_ALPHABETIC(opc))
00096 
00097 #define WN2F_IS_FUNCALL_OP(opc) \
00098    (Opc_Fname[opc]!=NULL && WN2F_IS_ALPHABETIC(opc))
00099 
00100 
00101 /* Mapping from opcodes to Fortran names for arithmetic/logical 
00102  * operations.  An empty (NULL) name will occur for non-
00103  * arithmetic/logical opcodes, which must be handled by special
00104  * handler-functions.  This mapping is dynamically initialized,
00105  * based on Fname_Map[], in WN2F_Expr_Initialize().
00106  */
00107 #define NUMBER_OF_OPCODES (OPCODE_LAST+1)
00108 static const char *Opc_Fname[NUMBER_OF_OPCODES];
00109    
00110 
00111 typedef struct Fname_PartialMap
00112 {
00113    OPCODE      opc;
00114    const char *fname;
00115 } FNAME_PARTIALMAP;
00116 
00117 #define NUMBER_OF_FNAME_PARTIALMAPS \
00118    sizeof(Fname_Map) / sizeof(FNAME_PARTIALMAP)
00119 
00120 static const FNAME_PARTIALMAP Fname_Map[] =
00121 {
00122   {OPC_U8NEG, "-"},
00123   {OPC_FQNEG, "-"},
00124   {OPC_I8NEG, "-"},
00125   {OPC_U4NEG, "-"},
00126   {OPC_CQNEG, "-"},
00127   {OPC_F8NEG, "-"},
00128   {OPC_C8NEG, "-"},
00129   {OPC_I4NEG, "-"},
00130   {OPC_F4NEG, "-"},
00131   {OPC_C4NEG, "-"},
00132   {OPC_I4ABS, "ABS"},
00133   {OPC_F4ABS, "ABS"},
00134   {OPC_FQABS, "ABS"},
00135   {OPC_I8ABS, "ABS"},
00136   {OPC_F8ABS, "ABS"},
00137   {OPC_F4SQRT, "SQRT"},
00138   {OPC_C4SQRT, "SQRT"},
00139   {OPC_FQSQRT, "SQRT"},
00140   {OPC_CQSQRT, "SQRT"},
00141   {OPC_F8SQRT, "SQRT"},
00142   {OPC_C8SQRT, "SQRT"},
00143   {OPC_I4F4RND, "JNINT"},
00144   {OPC_I4FQRND, "JIQNNT"},
00145   {OPC_I4F8RND, "JIDNNT"},
00146   {OPC_U4F4RND, "JNINT"},
00147   {OPC_U4FQRND, "JIQNNT"},
00148   {OPC_U4F8RND, "JIDNNT"},
00149   {OPC_I8F4RND, "KNINT"},
00150   {OPC_I8FQRND, "KIQNNT"},
00151   {OPC_I8F8RND, "KIDNNT"},
00152   {OPC_U8F4RND, "KNINT"},
00153   {OPC_U8FQRND, "KIQNNT"},
00154   {OPC_U8F8RND, "KIDNNT"},
00155   {OPC_I4F4TRUNC, "JINT"},
00156   {OPC_I4FQTRUNC, "JIQINT"},
00157   {OPC_I4F8TRUNC, "JIDINT"},
00158   {OPC_U4F4TRUNC, "JINT"},
00159   {OPC_U4FQTRUNC, "JIQINT"},
00160   {OPC_U4F8TRUNC, "JIDINT"},
00161   {OPC_I8F4TRUNC, "KINT"},
00162   {OPC_I8FQTRUNC, "KIQINT"},
00163   {OPC_I8F8TRUNC, "KIDINT"},
00164   {OPC_U8F4TRUNC, "KINT"},
00165   {OPC_U8FQTRUNC, "KIQINT"},
00166   {OPC_U8F8TRUNC, "KIDINT"},
00167   {OPC_I4F4CEIL, "OPC_I4F4CEIL"},
00168   {OPC_I4FQCEIL, "OPC_I4FQCEIL"},
00169   {OPC_I4F8CEIL, "OPC_I4F8CEIL"},
00170   {OPC_I8F4CEIL, "OPC_I8F4CEIL"},
00171   {OPC_I8FQCEIL, "OPC_I8FQCEIL"},
00172   {OPC_I8F8CEIL, "OPC_I8F8CEIL"},
00173   {OPC_I4F4FLOOR, "OPC_I4F4FLOOR"},
00174   {OPC_I4FQFLOOR, "OPC_I4FQFLOOR"},
00175   {OPC_I4F8FLOOR, "OPC_I4F8FLOOR"},
00176   {OPC_I8F4FLOOR, "OPC_I8F4FLOOR"},
00177   {OPC_I8FQFLOOR, "OPC_I8FQFLOOR"},
00178   {OPC_I8F8FLOOR, "OPC_I8F8FLOOR"},
00179   {OPC_I4BNOT, "NOT"},
00180   {OPC_U8BNOT, "NOT"},
00181   {OPC_I8BNOT, "NOT"},
00182   {OPC_U4BNOT, "NOT"},
00183 // >> WHIRL 0.30: replace OPC_LNOT by OPC_B and OPC_I4 variant
00184 // TODO WHIRL 0.30: get rid of OPC_I4 variant
00185   {OPC_BLNOT, ".NOT."},
00186   {OPC_I4LNOT, ".NOT."},
00187 // << WHIRL 0.30: replace OPC_LNOT by OPC_B and OPC_I4 variant
00188   {OPC_U8ADD, "+"},
00189   {OPC_FQADD, "+"},
00190   {OPC_I8ADD, "+"},
00191   {OPC_U4ADD, "+"},
00192   {OPC_CQADD, "+"},
00193   {OPC_F8ADD, "+"},
00194   {OPC_C8ADD, "+"},
00195   {OPC_I4ADD, "+"},
00196   {OPC_F4ADD, "+"},
00197   {OPC_C4ADD, "+"},
00198 #ifdef TARG_X8664
00199   {OPC_V16I1ADD, "+"},
00200   {OPC_V16I2ADD, "+"},
00201   {OPC_V16I4ADD, "+"},
00202   {OPC_V16I8ADD, "+"},
00203   {OPC_V16F4ADD, "+"},
00204   {OPC_V16F8ADD, "+"},
00205   {OPC_V16C4ADD, "+"},
00206   {OPC_V16C8ADD, "+"},
00207   {OPC_V16I1SUB, "-"},
00208   {OPC_V16I2SUB, "-"},
00209   {OPC_V16I4SUB, "-"},
00210   {OPC_V16I8SUB, "-"},
00211   {OPC_V16F4SUB, "-"},
00212   {OPC_V16F8SUB, "-"},
00213   {OPC_V16C4SUB, "-"},
00214   {OPC_V16C8SUB, "-"},
00215   {OPC_V16F4MPY, "*"},
00216   {OPC_V16F4DIV, "/"},
00217   {OPC_V16F8MPY, "*"},
00218   {OPC_V16F8DIV, "/"},
00219   {OPC_V16C4MPY, "*"},
00220   {OPC_V16C4DIV, "/"},
00221   {OPC_V16C8MPY, "*"},
00222   {OPC_V16C8DIV, "/"},
00223   {OPC_V16F8F8REPLICA, "REPLICA"},
00224   {OPC_V16F4SQRT, "SQRT"},
00225   {OPC_V16F8SQRT, "SQRT"},
00226   {OPC_V16I1NEG, "-"},
00227   {OPC_V16I2NEG, "-"},
00228   {OPC_V16I4NEG, "-"},
00229   {OPC_V16I8NEG, "-"},
00230   {OPC_V16F4NEG, "-"},
00231   {OPC_V16F8NEG, "-"},
00232 #endif /* TARG_X8664 */
00233   {OPC_U8SUB, "-"},
00234   {OPC_FQSUB, "-"},
00235   {OPC_I8SUB, "-"},
00236   {OPC_U4SUB, "-"},
00237   {OPC_CQSUB, "-"},
00238   {OPC_F8SUB, "-"},
00239   {OPC_C8SUB, "-"},
00240   {OPC_I4SUB, "-"},
00241   {OPC_F4SUB, "-"},
00242   {OPC_C4SUB, "-"},
00243   {OPC_U8MPY, "*"},
00244   {OPC_FQMPY, "*"},
00245   {OPC_I8MPY, "*"},
00246   {OPC_U4MPY, "*"},
00247   {OPC_CQMPY, "*"},
00248   {OPC_F8MPY, "*"},
00249   {OPC_C8MPY, "*"},
00250   {OPC_I4MPY, "*"},
00251   {OPC_F4MPY, "*"},
00252   {OPC_C4MPY, "*"},
00253   {OPC_U8DIV, "/"},
00254   {OPC_FQDIV, "/"},
00255   {OPC_I8DIV, "/"},
00256   {OPC_U4DIV, "/"},
00257   {OPC_CQDIV, "/"},
00258   {OPC_F8DIV, "/"},
00259   {OPC_C8DIV, "/"},
00260   {OPC_I4DIV, "/"},
00261   {OPC_F4DIV, "/"},
00262   {OPC_C4DIV, "/"},
00263   {OPC_I4MOD, "MOD"},
00264   {OPC_U8MOD, "MOD"},
00265   {OPC_I8MOD, "MOD"},
00266   {OPC_U8MOD, "MOD"},
00267   {OPC_U4MOD, "MOD"},
00268   {OPC_I4REM, "MOD"},
00269   {OPC_U8REM, "MOD"},
00270   {OPC_I8REM, "MOD"},
00271   {OPC_U4REM, "MOD"},
00272   {OPC_I4MAX, "MAX"},
00273   {OPC_U8MAX, "MAX"},
00274   {OPC_F4MAX, "MAX"},
00275   {OPC_FQMAX, "MAX"},
00276   {OPC_I8MAX, "MAX"},
00277   {OPC_U4MAX, "MAX"},
00278   {OPC_F8MAX, "MAX"},
00279   {OPC_I4MIN, "MIN"},
00280   {OPC_U8MIN, "MIN"},
00281   {OPC_F4MIN, "MIN"},
00282   {OPC_FQMIN, "MIN"},
00283   {OPC_I8MIN, "MIN"},
00284   {OPC_U4MIN, "MIN"},
00285   {OPC_F8MIN, "MIN"},
00286 #ifdef TARG_X8664
00287   {OPC_V16F4MIN, "MIN"},
00288   {OPC_V16F8MIN, "MIN"},
00289   {OPC_V16F4MAX, "MAX"},
00290   {OPC_V16F8MAX, "MAX"},
00291   {OPC_V16I1MAX, "MAX"},
00292   {OPC_V16I2MAX, "MAX"},
00293   {OPC_V16I4MAX, "MAX"},
00294   {OPC_V16I1MIN, "MIN"},
00295   {OPC_V16I2MIN, "MIN"},
00296   {OPC_V16I4MIN, "MIN"},
00297 #endif
00298   {OPC_I4BAND, "IAND"},
00299   {OPC_U8BAND, "IAND"},
00300   {OPC_I8BAND, "IAND"},
00301   {OPC_U4BAND, "IAND"},
00302   {OPC_I4BIOR, "IOR"},
00303   {OPC_U8BIOR, "IOR"},
00304   {OPC_I8BIOR, "IOR"},
00305   {OPC_U4BIOR, "IOR"},
00306   {OPC_I4BXOR, "IEOR"},
00307   {OPC_U8BXOR, "IEOR"},
00308   {OPC_I8BXOR, "IEOR"},
00309   {OPC_U4BXOR, "IEOR"},
00310 // >> WHIRL 0.30: replaced OPC_{LAND,LIOR,CAND,CIOR} by OPC_B and OPC_I4 variants
00311 // TODO WHIRL 0.30: get rid of OPC_I4 variants
00312   {OPC_BLAND, ".AND."},
00313   {OPC_I4LAND, ".AND."},
00314   {OPC_BLIOR, ".OR."},
00315   {OPC_I4LIOR, ".OR."},
00316   {OPC_BCAND, ".AND."},
00317   {OPC_I4CAND, ".AND."},
00318   {OPC_BCIOR, ".OR."},
00319   {OPC_I4CIOR, ".OR."},
00320 // << WHIRL 0.30: replaced OPC_{LAND,LIOR,CAND,CIOR} by OPC_B and OPC_I4 variants
00321   {OPC_I4SHL, "ISHIFT"},
00322   {OPC_U8SHL, "ISHIFT"},
00323   {OPC_I8SHL, "ISHIFT"},
00324   {OPC_U4SHL, "ISHIFT"},
00325   {OPC_I4ASHR, "IASHR"},
00326   {OPC_U8ASHR, "IASHR"},
00327   {OPC_I8ASHR, "IASHR"},
00328   {OPC_U4ASHR, "IASHR"},
00329 // >> WHIRL 0.30: replaced OPC_T1{EQ,NE,GT,GE,LT,LE} by OPC_B and OPC_I4 variants
00330 // TODO WHIRL 0.30: get rid of OPC_I4 variants
00331   {OPC_BU8EQ, ".EQ."},
00332   {OPC_BFQEQ, ".EQ."},
00333   {OPC_BI8EQ, ".EQ."},
00334   {OPC_BU4EQ, ".EQ."},
00335   {OPC_BCQEQ, ".EQ."},
00336   {OPC_BF8EQ, ".EQ."},
00337   {OPC_BC8EQ, ".EQ."},
00338   {OPC_BI4EQ, ".EQ."},
00339   {OPC_BF4EQ, ".EQ."},
00340   {OPC_BC4EQ, ".EQ."},
00341   {OPC_BU8NE, ".NE."},
00342   {OPC_BFQNE, ".NE."},
00343   {OPC_BI8NE, ".NE."},
00344   {OPC_BU4NE, ".NE."},
00345   {OPC_BCQNE, ".NE."},
00346   {OPC_BF8NE, ".NE."},
00347   {OPC_BC8NE, ".NE."},
00348   {OPC_BI4NE, ".NE."},
00349   {OPC_BF4NE, ".NE."},
00350   {OPC_BC4NE, ".NE."},
00351   {OPC_BI4GT, ".GT."},
00352   {OPC_BU8GT, ".GT."},
00353   {OPC_BF4GT, ".GT."},
00354   {OPC_BFQGT, ".GT."},
00355   {OPC_BI8GT, ".GT."},
00356   {OPC_BU4GT, ".GT."},
00357   {OPC_BF8GT, ".GT."},
00358 #ifdef TARG_X8664
00359   {OPC_V16I8V16F8GT, ".GT."},
00360   {OPC_V16I8V16F8LT, ".LT."},
00361   {OPC_V16I8V16F8GE, ".GE."},
00362   {OPC_V16I8V16F8LE, ".LE."},
00363   {OPC_V16I8V16F8NE, ".NE."},
00364   {OPC_V16I8V16F8EQ, ".EQ."},
00365 #endif
00366   {OPC_BI4GE, ".GE."},
00367   {OPC_BU8GE, ".GE."},
00368   {OPC_BF4GE, ".GE."},
00369   {OPC_BFQGE, ".GE."},
00370   {OPC_BI8GE, ".GE."},
00371   {OPC_BU4GE, ".GE."},
00372   {OPC_BF8GE, ".GE."},
00373   {OPC_BI4LT, ".LT."},
00374   {OPC_BU8LT, ".LT."},
00375   {OPC_BF4LT, ".LT."},
00376   {OPC_BFQLT, ".LT."},
00377   {OPC_BI8LT, ".LT."},
00378   {OPC_BU4LT, ".LT."},
00379   {OPC_BF8LT, ".LT."},
00380   {OPC_BI4LE, ".LE."},
00381   {OPC_BU8LE, ".LE."},
00382   {OPC_BF4LE, ".LE."},
00383   {OPC_BFQLE, ".LE."},
00384   {OPC_BI8LE, ".LE."},
00385   {OPC_BU4LE, ".LE."},
00386   {OPC_BF8LE, ".LE."},
00387   {OPC_I4U8EQ, ".EQ."},
00388   {OPC_I4FQEQ, ".EQ."},
00389   {OPC_I4I8EQ, ".EQ."},
00390   {OPC_I4U4EQ, ".EQ."},
00391   {OPC_I4CQEQ, ".EQ."},
00392   {OPC_I4F8EQ, ".EQ."},
00393   {OPC_I4C8EQ, ".EQ."},
00394   {OPC_I4I4EQ, ".EQ."},
00395   {OPC_I4F4EQ, ".EQ."},
00396   {OPC_I4C4EQ, ".EQ."},
00397   {OPC_I8I4EQ, ".EQ."},
00398   {OPC_I8I4NE, ".NE."},
00399   {OPC_I4U8NE, ".NE."},
00400   {OPC_I4FQNE, ".NE."},
00401   {OPC_I4I8NE, ".NE."},
00402   {OPC_I4U4NE, ".NE."},
00403   {OPC_I4CQNE, ".NE."},
00404   {OPC_I4F8NE, ".NE."},
00405   {OPC_I4C8NE, ".NE."},
00406   {OPC_I4I4NE, ".NE."},
00407   {OPC_I4F4NE, ".NE."},
00408   {OPC_I4C4NE, ".NE."},
00409   {OPC_I4I4GT, ".GT."},
00410   {OPC_I4U8GT, ".GT."},
00411   {OPC_I4F4GT, ".GT."},
00412   {OPC_I4FQGT, ".GT."},
00413   {OPC_I4I8GT, ".GT."},
00414   {OPC_I4U4GT, ".GT."},
00415   {OPC_I4F8GT, ".GT."},
00416   {OPC_I4I4GE, ".GE."},
00417   {OPC_I4U8GE, ".GE."},
00418   {OPC_I4F4GE, ".GE."},
00419   {OPC_I4FQGE, ".GE."},
00420   {OPC_I4I8GE, ".GE."},
00421   {OPC_I4U4GE, ".GE."},
00422   {OPC_I4F8GE, ".GE."},
00423   {OPC_I4I4LT, ".LT."},
00424   {OPC_I4U8LT, ".LT."},
00425   {OPC_I4F4LT, ".LT."},
00426   {OPC_I4FQLT, ".LT."},
00427   {OPC_I4I8LT, ".LT."},
00428   {OPC_I4U4LT, ".LT."},
00429   {OPC_I4F8LT, ".LT."},
00430   {OPC_I4I4LE, ".LE."},
00431   {OPC_I4U8LE, ".LE."},
00432   {OPC_I4F4LE, ".LE."},
00433   {OPC_I4FQLE, ".LE."},
00434   {OPC_I4I8LE, ".LE."},
00435   {OPC_I4U4LE, ".LE."},
00436   {OPC_I4F8LE, ".LE."}
00437 // << WHIRL 0.30: replaced OPC_T1{EQ,NE,GT,GE,LT,LE} by OPC_B and OPC_I4 variants
00438 }; /* Fname_Map */
00439 
00440 
00441 /*------------------------- Value Conversions -------------------------*/
00442 /*---------------------------------------------------------------------*/
00443 
00444 /* Create a mapping from a pair of MTYPEs to the Fortran intrinsic
00445  * or builtin operation that carries out the conversion.  NULL means
00446  * that either the conversion is redundant and can be ignored or there
00447  * is no way we can do it.
00448  */
00449 static const char *Conv_Op[MTYPE_LAST+1][MTYPE_LAST+1];
00450 
00451 typedef struct Conv_Op
00452 {
00453    MTYPE       from, to;
00454    const char *name;
00455 } CONV_OP;
00456 
00457 #define NUMBER_OF_CONV_OPS sizeof(Conv_Op_Map)/sizeof(CONV_OP)
00458 
00459 static const CONV_OP Conv_Op_Map[] = 
00460 {
00461    /* from   |   to   |   op-name */
00462 
00463    /* Only consider conversion to ptr sized unsigned numbers 
00464     * valid in Fortran.
00465     */
00466    {MTYPE_I1, MTYPE_U4, "JZEXT"},
00467    {MTYPE_I2, MTYPE_U4, "JZEXT"},
00468    {MTYPE_I4, MTYPE_U4, "JZEXT"},
00469    {MTYPE_I8, MTYPE_U4, "JZEXT"},
00470    /*{MTYPE_U1, MTYPE_U4, ""},*/
00471    /*{MTYPE_U2, MTYPE_U4, ""},*/
00472    /*{MTYPE_U4, MTYPE_U4, ""},*/
00473    {MTYPE_U8, MTYPE_U4, "JZEXT"},
00474 
00475    {MTYPE_I1, MTYPE_U8, "KZEXT"},
00476    {MTYPE_I2, MTYPE_U8, "KZEXT"},
00477    {MTYPE_I4, MTYPE_U8, "KZEXT"},
00478    {MTYPE_I8, MTYPE_U8, "KZEXT"},
00479    /*{MTYPE_U1, MTYPE_U8, ""},*/
00480    /*{MTYPE_U2, MTYPE_U8, ""},*/
00481    /*{MTYPE_U4, MTYPE_U8, ""},*/
00482    /*{MTYPE_U8, MTYPE_U8, ""},*/
00483 
00484    /*{MTYPE_I1, MTYPE_I1, ""},*/
00485    {MTYPE_I2, MTYPE_I1, "INT1"},
00486    {MTYPE_I4, MTYPE_I1, "INT1"},
00487    {MTYPE_I8, MTYPE_I1, "INT1"},
00488    /*{MTYPE_U1, MTYPE_I1, ""},*/
00489    {MTYPE_U2, MTYPE_I1, "INT1"},
00490    {MTYPE_U4, MTYPE_I1, "INT1"},
00491    {MTYPE_U8, MTYPE_I1, "INT1"},
00492    {MTYPE_F4, MTYPE_I1, "INT1"},
00493    {MTYPE_F8, MTYPE_I1, "INT1"},
00494    {MTYPE_FQ, MTYPE_I1, "INT1"},
00495 
00496    {MTYPE_I1, MTYPE_I2, "INT2"},
00497    /*{MTYPE_I2, MTYPE_I2, ""},*/
00498    {MTYPE_I4, MTYPE_I2, "INT2"},
00499    {MTYPE_I8, MTYPE_I2, "INT2"},
00500    {MTYPE_U1, MTYPE_I2, "INT2"},
00501    /*{MTYPE_U2, MTYPE_I2, ""},*/
00502    {MTYPE_U4, MTYPE_I2, "INT2"},
00503    {MTYPE_U8, MTYPE_I2, "INT2"},
00504    {MTYPE_F4, MTYPE_I2, "INT2"},
00505    {MTYPE_F8, MTYPE_I2, "INT2"},
00506    {MTYPE_FQ, MTYPE_I2, "INT2"},
00507 
00508    {MTYPE_I1, MTYPE_I4, "INT4"},
00509    {MTYPE_I2, MTYPE_I4, "INT4"},
00510    /*{MTYPE_I4, MTYPE_I4, ""},*/
00511    {MTYPE_I8, MTYPE_I4, "INT4"},
00512    {MTYPE_U1, MTYPE_I4, "INT4"},
00513    {MTYPE_U2, MTYPE_I4, "INT4"},
00514    /*{MTYPE_U4, MTYPE_I4, ""},*/
00515    {MTYPE_U8, MTYPE_I4, "INT4"},
00516    {MTYPE_F4, MTYPE_I4, "INT4"},
00517    {MTYPE_F8, MTYPE_I4, "INT4"},
00518    {MTYPE_FQ, MTYPE_I4, "INT4"},
00519 
00520    {MTYPE_I1, MTYPE_I8, "INT8"},
00521    {MTYPE_I2, MTYPE_I8, "INT8"},
00522    {MTYPE_I4, MTYPE_I8, "INT8"},
00523    /*{MTYPE_I8, MTYPE_I8, ""},*/
00524    {MTYPE_U1, MTYPE_I8, "INT8"},
00525    {MTYPE_U2, MTYPE_I8, "INT8"},
00526    {MTYPE_U4, MTYPE_I8, "INT8"},
00527    /*{MTYPE_U8, MTYPE_I8, ""},*/
00528    {MTYPE_F4, MTYPE_I8, "INT8"},
00529    {MTYPE_F8, MTYPE_I8, "INT8"},
00530    {MTYPE_FQ, MTYPE_I8, "INT8"},
00531 
00532    {MTYPE_I1, MTYPE_F4, "REAL"},
00533    {MTYPE_I2, MTYPE_F4, "REAL"},
00534    {MTYPE_I4, MTYPE_F4, "REAL"},
00535    {MTYPE_I8, MTYPE_F4, "REAL"},
00536    {MTYPE_U1, MTYPE_F4, "REAL"},
00537    {MTYPE_U2, MTYPE_F4, "REAL"},
00538    {MTYPE_U4, MTYPE_F4, "REAL"},
00539    {MTYPE_U8, MTYPE_F4, "REAL"},
00540    /*{MTYPE_F4, MTYPE_F4, ""},*/
00541    {MTYPE_F8, MTYPE_F4, "REAL"},
00542    {MTYPE_FQ, MTYPE_F4, "REAL"},
00543 
00544    {MTYPE_I1, MTYPE_F8, "DBLE"},
00545    {MTYPE_I2, MTYPE_F8, "DBLE"},
00546    {MTYPE_I4, MTYPE_F8, "DBLE"},
00547    {MTYPE_I8, MTYPE_F8, "DBLE"},
00548    {MTYPE_U1, MTYPE_F8, "DBLE"},
00549    {MTYPE_U2, MTYPE_F8, "DBLE"},
00550    {MTYPE_U4, MTYPE_F8, "DBLE"},
00551    {MTYPE_U8, MTYPE_F8, "DBLE"},
00552    {MTYPE_F4, MTYPE_F8, "DBLE"},
00553    /*{MTYPE_F8, MTYPE_F8, ""},*/
00554    {MTYPE_FQ, MTYPE_F8, "DBLE"},
00555 
00556    {MTYPE_I1, MTYPE_FQ, "QEXT"},
00557    {MTYPE_I2, MTYPE_FQ, "QEXT"},
00558    {MTYPE_I4, MTYPE_FQ, "QEXT"},
00559    {MTYPE_I8, MTYPE_FQ, "QEXT"},
00560    {MTYPE_U1, MTYPE_FQ, "QEXT"},
00561    {MTYPE_U2, MTYPE_FQ, "QEXT"},
00562    {MTYPE_U4, MTYPE_FQ, "QEXT"},
00563    {MTYPE_U8, MTYPE_FQ, "QEXT"},
00564    {MTYPE_F4, MTYPE_FQ, "QEXT"},
00565    {MTYPE_F8, MTYPE_FQ, "QEXT"}
00566    /*{MTYPE_FQ, MTYPE_FQ, ""}*/
00567 }; /* Conv_Op_Map */
00568 
00569 
00570 static void
00571 WN2F_Convert(TOKEN_BUFFER tokens,
00572        MTYPE        from_mtype,
00573        MTYPE        to_mtype)
00574 {
00575    /* We emit a warning message for conversions not covered (TODO: put
00576     * this warning under a command-line option).  Converts the expression
00577     * in the given token-buffer to the given mtype.
00578     */
00579    Prepend_Token_Special(tokens, '(');
00580    if (Conv_Op[from_mtype][to_mtype] == NULL)
00581    {
00582       ASSERT_WARN(Conv_Op[from_mtype][to_mtype] != NULL,
00583       (DIAG_W2F_UNEXPECTED_CVT, 
00584        MTYPE_name(from_mtype), MTYPE_name(to_mtype), 
00585        "WN2F_Convert"));
00586       Prepend_Token_String(tokens, "WN2F_Convert");
00587    }
00588    else
00589    {
00590       /* Note all these are intrinsics in the mongoose compiler and
00591        * need not be declared.
00592        */
00593       Prepend_Token_String(tokens, Conv_Op[from_mtype][to_mtype]);
00594    }
00595    Append_Token_Special(tokens, ')');
00596 } /* WN2F_Convert */
00597 
00598 
00599 /*------------------------- Utility Functions -------------------------*/
00600 /*---------------------------------------------------------------------*/
00601 
00602 static WN2F_STATUS
00603 WN2F_Translate_Arithmetic_Operand(TOKEN_BUFFER tokens,
00604           WN          *opnd, 
00605           TY_IDX       assumed_ty, 
00606           BOOL         call_by_value,
00607           WN2F_CONTEXT context)
00608 {
00609    /* Translate an operand to a function or built-in operator invocation,
00610     * based on whether the context indicates that we have call-by-value
00611     * or call-by-reference.  Also, the context indicates what type of
00612     * argument we expect.
00613     */
00614    
00615    /* TODO(?): Type promotion
00616     *
00617     * TY          *opnd_ty = WN_Tree_Type(opnd);
00618     * if (!WN2F_arithmetic_compatible_types(assumed_ty, opnd_ty))
00619     * {
00620     *    WN2F_prepend_cast(opnd, assumed_ty, context);
00621     * }
00622     */
00623 
00624    /* We do not handle substring expressions here, and assume any
00625     * such expression will be dispatched to a specialty routine
00626     * such as WN2F_Intr_Infix_SubstrExpr().
00627     */
00628    ASSERT_DBG_WARN(!TY_Is_Character_Reference(assumed_ty) &&
00629        !TY_Is_Chararray_Reference(assumed_ty),
00630        (DIAG_W2F_UNEXPECTED_SUBSTRING_REF, 
00631         "WN2F_Translate_Arithmetic_Operand()"));
00632    
00633    if (!call_by_value)
00634    {
00635       WN2F_Offset_Memref(tokens, 
00636        opnd,                   /* address expression */
00637        assumed_ty,             /* address type */
00638        TY_pointed(assumed_ty), /* object type */
00639        0,                      /* offset from address */
00640        context);
00641    }
00642    else
00643    {
00644       WN2F_translate(tokens, opnd, context);
00645    }
00646    
00647    return EMPTY_WN2F_STATUS;
00648 } /* WN2F_Translate_Arithmetic_Operand */
00649 
00650 
00651 static WN2F_STATUS
00652 WN2F_Infix_Op(TOKEN_BUFFER tokens, 
00653         OPCODE       opcode,
00654         TY_IDX       result_ty,
00655         WN          *wn0,
00656         WN          *wn1,
00657         WN2F_CONTEXT context)
00658 {
00659    /* Infix Fortran operator.  Only string argument are passed by
00660     * reference; all other argument types are passed by value.
00661     */
00662    const BOOL   parenthesize = !WN2F_CONTEXT_no_parenthesis(context);
00663    const BOOL   binary_op = (wn0 != NULL);
00664 
00665    TY_IDX      wn0_ty;       /* Expected type of wn0 */
00666    TY_IDX      wn1_ty;       /* Expected type of wn1 */
00667 
00668    /* Ensure that subexpressions are parenthesized */
00669    reset_WN2F_CONTEXT_no_parenthesis(context);
00670 
00671    /* Get the expected types for the two operands, dependent on whether
00672     * or not we have a descriptor type.
00673     */
00674    if (OPCODE_desc(opcode) == MTYPE_V)
00675       wn0_ty = wn1_ty = result_ty;
00676    else
00677       wn0_ty = wn1_ty = Stab_Mtype_To_Ty(OPCODE_desc(opcode));
00678 
00679    if (parenthesize)
00680       Append_Token_Special(tokens, '(');
00681 
00682    /* First operand */
00683    if (binary_op)
00684       WN2F_Translate_Arithmetic_Operand(tokens, wn0, wn0_ty, 
00685           TRUE/*call-by-value*/,
00686           context);
00687    
00688    /* Operation */
00689    Append_Token_String(tokens, Opc_Fname[opcode]);
00690 
00691    /* Second operand, or only operand for unary operation */
00692    WN2F_Translate_Arithmetic_Operand(tokens, wn1, wn1_ty, 
00693              TRUE/*call-by-value*/,
00694              context);
00695 
00696    if (parenthesize)
00697       Append_Token_Special(tokens, ')');
00698 
00699    return EMPTY_WN2F_STATUS;
00700 } /* WN2F_Infix_Op */
00701 
00702 static WN2F_STATUS
00703 WN2F_Funcall_Op(TOKEN_BUFFER tokens, 
00704     OPCODE       opcode,
00705     WN          *wn0, 
00706     WN          *wn1, 
00707     WN2F_CONTEXT context)
00708 {
00709    /* Prefix Fortran operator.  Only string argument are passed by
00710     * reference; all other argument types are passed by value.
00711     */
00712    const BOOL   binary_op = (wn0 != NULL);
00713 
00714    TY_IDX const   rty = Stab_Mtype_To_Ty(OPCODE_rtype(opcode));
00715    TY_IDX         dty = Stab_Mtype_To_Ty(OPCODE_desc(opcode));
00716 
00717    /* If there is no descriptor type, assume the operands should be
00718     * of the same type as the result.  The assumed type of the argument
00719     * will be the dty.
00720     */
00721    if (TY_kind(dty) == KIND_VOID)
00722       dty = rty;
00723    
00724    Append_Token_String(tokens, Opc_Fname[opcode]);
00725    Append_Token_Special(tokens, '(');
00726    
00727    /* No need to parenthesize subexpressions */
00728    set_WN2F_CONTEXT_no_parenthesis(context);
00729 
00730    /* First operand */
00731    if (binary_op)
00732    {
00733       WN2F_Translate_Arithmetic_Operand(tokens, wn0, dty,
00734           TRUE/*call-by-value*/,
00735           context);
00736       Append_Token_Special(tokens, ',');
00737    }
00738 
00739    /* Second operand, or only operand for unary operation */
00740    WN2F_Translate_Arithmetic_Operand(tokens, wn1, dty,
00741              TRUE/*call-by-value*/,
00742              context);
00743 
00744    Append_Token_Special(tokens, ')');
00745    return EMPTY_WN2F_STATUS;
00746 } /* WN2F_Funcall_Op */
00747 
00748 
00749 static WN2F_STATUS 
00750 WN2F_Intr_Funcall(TOKEN_BUFFER tokens, 
00751       WN          *wn,
00752       const char  *func_name,
00753       INT          first_arg_idx,
00754       INT          last_arg_idx,
00755       BOOL         call_by_value,
00756       WN2F_CONTEXT context)
00757 {
00758    /* An intrinsic operator expression to be emitted with function
00759     * call syntax.  All arguments are passed by value or by reference,
00760     * i.e. we never have some arguments passed by value and some by 
00761     * reference, unless we have explicit INTR_OPC_ADRTMP or 
00762     * INTR_OPC_VALTMP argument expressions. Note that we also
00763     * handle substring arguments here. 
00764     */
00765    INT arg_idx, implicit_args, total_implicit_args;
00766    TY_IDX opnd_type;
00767 
00768    /* Determine the number of implicit arguments appended to the end
00769     * of the argument list (i.e. string lengths).
00770     */
00771    for (arg_idx = first_arg_idx, total_implicit_args = 0; 
00772   arg_idx <= last_arg_idx - total_implicit_args; 
00773   arg_idx++)
00774    {
00775       opnd_type = WN_Tree_Type(WN_kid(wn, arg_idx));
00776       if (TY_Is_Character_Reference(opnd_type) ||
00777     TY_Is_Chararray_Reference(opnd_type))
00778       {
00779    total_implicit_args++;
00780       }
00781    }
00782 
00783    /* Append the function-name */
00784    Append_Token_String(tokens, func_name);
00785    
00786    /* Append the argument list to the function reference, skipping
00787     * implicit character-string-length arguments assumed to be the
00788     * last ones in the list (see also ST2F_func_header()).
00789     */
00790    Append_Token_Special(tokens, '(');
00791    set_WN2F_CONTEXT_no_parenthesis(context);
00792    for (arg_idx = first_arg_idx, implicit_args = 0; 
00793   arg_idx <= last_arg_idx - implicit_args; 
00794   arg_idx++)
00795    {
00796       opnd_type = WN_Tree_Type(WN_kid(wn, arg_idx));
00797 
00798       if (TY_Is_Character_Reference(opnd_type) ||
00799     TY_Is_Chararray_Reference(opnd_type))
00800       {
00801    implicit_args++;
00802    WN2F_String_Argument(tokens,
00803             WN_kid(wn, arg_idx), /* string base */
00804             WN_kid(wn, 
00805              last_arg_idx - 
00806              (total_implicit_args - 
00807               implicit_args)), /* string length */
00808             context);
00809       }
00810       else
00811    WN2F_Translate_Arithmetic_Operand(tokens,
00812              WN_kid(wn, arg_idx),
00813              opnd_type,
00814              call_by_value,
00815              context);
00816 
00817       if ((arg_idx+implicit_args) < WN_kid_count(wn) - 1)
00818    Append_Token_Special(tokens, ',');
00819    }
00820    Append_Token_Special(tokens, ')');
00821 
00822    /* TODO: See if we need to cast the resultant value */
00823 
00824    return EMPTY_WN2F_STATUS;
00825 } /* WN2F_Intr_Funcall */
00826 
00827 
00828 static WN2F_STATUS
00829 WN2F_Intr_Infix(TOKEN_BUFFER tokens, 
00830     const char  *op_name,
00831     WN          *opnd0,   /* NULL for unary operation */
00832     WN          *opnd1,
00833     BOOL         call_by_value,
00834     WN2F_CONTEXT context)
00835 {
00836    /* An intrinsic operator expression to be emitted with infix operator
00837     * syntax.  Note that we have already determined what the two arguments
00838     * are, and any implicit argument have already been ignored.
00839     */
00840    const BOOL parenthesize = !WN2F_CONTEXT_no_parenthesis(context);
00841    const BOOL binary_op = (opnd0 != NULL);
00842 
00843    /* Ensure that subexpressions are parenthesized */
00844    reset_WN2F_CONTEXT_no_parenthesis(context);
00845    
00846    if (parenthesize)
00847       Append_Token_Special(tokens, '(');
00848 
00849    if (binary_op)
00850       WN2F_Translate_Arithmetic_Operand(tokens,
00851           opnd0,
00852           WN_Tree_Type(opnd0),
00853           call_by_value,
00854           context);
00855    Append_Token_String(tokens, op_name);
00856    WN2F_Translate_Arithmetic_Operand(tokens,
00857              opnd1,
00858              WN_Tree_Type(opnd1),
00859              call_by_value,
00860              context);
00861    if (parenthesize)
00862       Append_Token_Special(tokens, ')');
00863 
00864    return EMPTY_WN2F_STATUS;
00865 } /* WN2F_Intr_Infix */
00866 
00867 
00868 static WN2F_STATUS
00869 WN2F_Binary_Substr_Op(TOKEN_BUFFER tokens, 
00870           WN          *op_wn,   /* Top-level expression */
00871           const char  *op_name, /* The builtin operator */
00872           WN2F_CONTEXT context)
00873 {
00874    /* Similar to WN2F_Infix_Op, but we expect the arguments to be
00875     * string expressions.
00876     */
00877    const BOOL parenthesize = !WN2F_CONTEXT_no_parenthesis(context);
00878 
00879    /* Ensure that subexpressions are parenthesized */
00880    reset_WN2F_CONTEXT_no_parenthesis(context);
00881    
00882    if (parenthesize)
00883       Append_Token_Special(tokens, '(');
00884 
00885    WN2F_String_Argument(tokens,
00886       WN_kid(op_wn, 0), /* string base */
00887       WN_kid(op_wn, 2), /* string length */
00888       context);
00889    Append_Token_String(tokens, op_name);
00890    WN2F_String_Argument(tokens,
00891       WN_kid(op_wn, 1), /* string base */
00892       WN_kid(op_wn, 3), /* string length */
00893       context);
00894    if (parenthesize)
00895       Append_Token_Special(tokens, ')');
00896 
00897    return EMPTY_WN2F_STATUS;
00898 } /* WN2F_Binary_Substr_Op */
00899 
00900 
00901 /*------------------------- Exported Functions ------------------------*/
00902 /*---------------------------------------------------------------------*/
00903 
00904 
00905 void WN2F_Expr_initialize(void)
00906 {
00907    INT  map;
00908 
00909    /* Reset the Opc_Fname array.  This has already been
00910     * implicitly done by declaring it as static:
00911     *
00912     *    OPCODE   opc;
00913     *    for (opc = 0; opc < NUMBER_OF_OPCODES; opc++)
00914     *       Opc_Fname[opc] = NULL;
00915     *
00916     * Initialize the Opc_Fname array:
00917     */
00918    for (map = 0; map < NUMBER_OF_FNAME_PARTIALMAPS; map++)
00919       Opc_Fname[Fname_Map[map].opc] = Fname_Map[map].fname;
00920 
00921    /* Initialize the Conv_Op array (default value is NULL) */
00922    for (map = 0; map < NUMBER_OF_CONV_OPS; map++)
00923       Conv_Op[Conv_Op_Map[map].from][Conv_Op_Map[map].to] = 
00924    Conv_Op_Map[map].name;
00925 
00926 } /* WN2F_Expr_initialize */
00927 
00928 
00929 void WN2F_Expr_finalize(void)
00930 {
00931    /* Nothing to do for now */
00932 } /* WN2F_Expr_finalize */
00933 
00934 
00935 WN2F_STATUS
00936 WN2F_binaryop(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00937 {
00938    ASSERT_DBG_FATAL(WN_kid_count(wn) == 2, 
00939         (DIAG_W2F_UNEXPECTED_NUM_KIDS, 
00940          WN_kid_count(wn), 2, WN_opc_name(wn)));
00941 
00942    if (WN2F_IS_INFIX_OP(WN_opcode(wn)))
00943       WN2F_Infix_Op(tokens,
00944         WN_opcode(wn),
00945         WN_Tree_Type(wn),
00946         WN_kid0(wn),
00947         WN_kid1(wn),
00948         context);
00949    else if (WN2F_IS_FUNCALL_OP(WN_opcode(wn)))
00950       WN2F_Funcall_Op(tokens,
00951           WN_opcode(wn),
00952           WN_kid0(wn),
00953           WN_kid1(wn),
00954           context);
00955    else
00956       ASSERT_DBG_FATAL(FALSE, (DIAG_W2F_UNEXPECTED_OPC, "WN2F_binaryop"));
00957 
00958    return EMPTY_WN2F_STATUS;
00959 } /* WN2F_binaryop */
00960 
00961 
00962 WN2F_STATUS
00963 WN2F_unaryop(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00964 {
00965    ASSERT_DBG_FATAL(WN_kid_count(wn) == 1, 
00966         (DIAG_W2F_UNEXPECTED_NUM_KIDS, 
00967          WN_kid_count(wn), 1, WN_opc_name(wn)));
00968 
00969    if (WN2F_IS_INFIX_OP(WN_opcode(wn)))
00970       WN2F_Infix_Op(tokens,
00971         WN_opcode(wn),
00972         WN_Tree_Type(wn),
00973         NULL, /* No first operand */
00974         WN_kid0(wn),
00975         context);
00976    else if (WN2F_IS_FUNCALL_OP(WN_opcode(wn)))
00977       WN2F_Funcall_Op(tokens,
00978           WN_opcode(wn),
00979           NULL, /* No first operand */
00980           WN_kid0(wn),
00981           context);
00982    else
00983       ASSERT_DBG_FATAL(FALSE, (DIAG_W2F_UNEXPECTED_OPC, "WN2F_binaryop"));
00984 
00985    return EMPTY_WN2F_STATUS;
00986 } /* WN2F_unaryop */
00987 
00988 
00989 WN2F_STATUS 
00990 WN2F_intrinsic_op(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00991 {
00992    /* An intrinsic operator expression.  Generate the call as is,
00993     * regardless how the return value is returned, since we know
00994     * the consumer of the value is the surrounding expression.  This
00995     * call is not related to the call-info generated by PUinfo.
00996     * Note that either all or none of the arguments are call-by-value.
00997     */
00998    INT   first_arg_idx, last_arg_idx;
00999    BOOL  by_value;
01000 
01001    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_INTRINSIC_OP, 
01002         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_intrinsic_op"));
01003 
01004    by_value = INTRN_by_value(WN_intrinsic(wn));
01005    last_arg_idx = WN_kid_count(wn) - 1;
01006    first_arg_idx = 0; /* Assume we never return to first argument */
01007 
01008    /* Switch on WN_intrinsic(wn) to handle builtin fortran opcodes.
01009     */
01010    switch (WN_intrinsic(wn))
01011    {      
01012    case INTRN_I4EXPEXPR: 
01013    case INTRN_I8EXPEXPR:
01014    case INTRN_F4EXPEXPR:
01015    case INTRN_F8EXPEXPR:
01016    case INTRN_FQEXPEXPR:
01017    case INTRN_C4EXPEXPR:
01018    case INTRN_C8EXPEXPR:
01019    case INTRN_CQEXPEXPR:
01020    case INTRN_F4I4EXPEXPR:
01021    case INTRN_F4I8EXPEXPR:
01022    case INTRN_F8I4EXPEXPR:
01023    case INTRN_F8I8EXPEXPR:
01024    case INTRN_FQI4EXPEXPR:
01025    case INTRN_FQI8EXPEXPR:
01026    case INTRN_C4I4EXPEXPR:
01027    case INTRN_C4I8EXPEXPR:
01028    case INTRN_C8I4EXPEXPR:
01029    case INTRN_C8I8EXPEXPR:
01030    case INTRN_CQI4EXPEXPR:
01031    case INTRN_CQI8EXPEXPR:
01032       WN2F_Intr_Infix(tokens, 
01033           "**", WN_kid0(wn), WN_kid1(wn), by_value, context);
01034       break;
01035       
01036    case INTRN_CEQEXPR:
01037       WN2F_Binary_Substr_Op(tokens, wn, ".EQ.", context);
01038       break;
01039    case INTRN_CNEEXPR:
01040       WN2F_Binary_Substr_Op(tokens, wn, ".NE.", context);
01041       break;
01042    case INTRN_CGEEXPR:
01043       WN2F_Binary_Substr_Op(tokens, wn, ".GE.", context);
01044       break;
01045    case INTRN_CGTEXPR:
01046       WN2F_Binary_Substr_Op(tokens, wn, ".GT.", context);
01047       break;
01048    case INTRN_CLEEXPR:
01049       WN2F_Binary_Substr_Op(tokens, wn, ".LE.", context);
01050       break;
01051    case INTRN_CLTEXPR:
01052       WN2F_Binary_Substr_Op(tokens, wn, ".LT.", context);
01053       break;
01054 
01055    case INTRN_U4I1ADRTMP: 
01056    case INTRN_U4I2ADRTMP: 
01057    case INTRN_U4I4ADRTMP:
01058    case INTRN_U4I8ADRTMP: 
01059    case INTRN_U4F4ADRTMP: 
01060    case INTRN_U4F8ADRTMP: 
01061    case INTRN_U4FQADRTMP:
01062    case INTRN_U4C4ADRTMP: 
01063    case INTRN_U4C8ADRTMP:
01064    case INTRN_U4CQADRTMP:
01065    case INTRN_U4VADRTMP :
01066    case INTRN_U8I1ADRTMP:
01067    case INTRN_U8I2ADRTMP:
01068    case INTRN_U8I4ADRTMP:
01069    case INTRN_U8I8ADRTMP: 
01070    case INTRN_U8F4ADRTMP: 
01071    case INTRN_U8F8ADRTMP: 
01072    case INTRN_U8FQADRTMP:
01073    case INTRN_U8C4ADRTMP: 
01074    case INTRN_U8C8ADRTMP: 
01075    case INTRN_U8CQADRTMP:
01076    case INTRN_U8VADRTMP:
01077       /* Implicit call by reference.  Emit the dereferenced parameter.
01078        */
01079       WN2F_translate(tokens, WN_kid0(wn), context);
01080       break;
01081 
01082    case INTRN_I4VALTMP:
01083    case INTRN_I8VALTMP: 
01084    case INTRN_F4VALTMP: 
01085    case INTRN_F8VALTMP: 
01086    case INTRN_FQVALTMP:
01087    case INTRN_C4VALTMP: 
01088    case INTRN_C8VALTMP:
01089    case INTRN_CQVALTMP:
01090       /* Call-by-value.  Assume the context determines when it is
01091        * necessary to put a %val qualifier around the argument.
01092        */
01093       WN2F_translate(tokens, WN_kid0(wn), context);
01094       break;     
01095       
01096    default:
01097       WN2F_Intr_Funcall(tokens,
01098       wn,
01099       WN_intrinsic_name((INTRINSIC) WN_intrinsic(wn)),
01100       first_arg_idx,
01101       last_arg_idx,
01102       by_value,
01103       context);
01104       break;
01105    } /*switch*/
01106 
01107    /* TODO: See if we need to cast the resultant value.
01108     * TY * return_ty = 
01109     *         WN_intrinsic_return_ty(WN_opcode(wn), WN_intrinsic(wn));
01110     */
01111 
01112    return EMPTY_WN2F_STATUS;
01113 } /* WN2F_intrinsic_op */
01114 
01115 
01116 WN2F_STATUS 
01117 WN2F_tas(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01118 {
01119    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_TAS, 
01120         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_tas"));
01121 
01122    /* Just ignore TAS operators for now.  TODO: make sure this
01123     * is always ok.
01124     */
01125    return WN2F_translate(tokens, WN_kid0(wn), context);
01126 } /* WN2F_tas */
01127 
01128 
01129 WN2F_STATUS 
01130 WN2F_select(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01131 {
01132    /* SELECT is almost the same as the F90 MERGE intrinsic, 
01133       so I will output it that way for now */
01134    
01135    Append_Token_String(tokens, "MERGE");
01136    Append_Token_Special(tokens, '(');
01137    WN2F_translate(tokens, WN_kid1(wn), context);
01138    Append_Token_Special(tokens, ',');
01139 
01140    WN2F_translate(tokens, WN_kid2(wn), context);
01141    Append_Token_Special(tokens, ',');
01142 
01143    WN2F_translate(tokens, WN_kid0(wn), context);
01144    
01145    Append_Token_Special(tokens, ')');
01146 #if 0
01147    ASSERT_DBG_WARN(FALSE, (DIAG_UNIMPLEMENTED, "WN2F_select"));
01148 #endif
01149 
01150    return EMPTY_WN2F_STATUS;
01151 } /* WN2F_select */
01152 
01153 
01154 WN2F_STATUS 
01155 WN2F_cvt(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01156 {
01157    TOKEN_BUFFER expr_tokens = New_Token_Buffer();
01158 
01159    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_CVT, 
01160         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_cvt"));
01161 
01162    WN2F_translate(expr_tokens, WN_kid0(wn), context);
01163    WN2F_Convert(expr_tokens, WN_opc_dtype(wn), WN_opc_rtype(wn));
01164    Append_And_Reclaim_Token_List(tokens, &expr_tokens);
01165 
01166    return EMPTY_WN2F_STATUS;
01167 } /* WN2F_cvt */
01168 
01169 
01170 WN2F_STATUS 
01171 WN2F_cvtl(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01172 {
01173    TY_IDX  rtype, dtype;
01174    TOKEN_BUFFER expr_tokens;
01175 
01176    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_CVTL, 
01177         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_cvtl"));
01178 
01179    dtype = WN_Tree_Type(WN_kid0(wn));
01180    rtype = WN_Tree_Type(wn);
01181    
01182    /* Only convert if it is necessary */
01183    if (Conv_Op[TY_mtype(dtype)][TY_mtype(rtype)] != NULL)
01184    {
01185       expr_tokens = New_Token_Buffer();
01186       WN2F_translate(expr_tokens, WN_kid0(wn), context);
01187       WN2F_Convert(expr_tokens, TY_mtype(dtype), TY_mtype(rtype));
01188       Append_And_Reclaim_Token_List(tokens, &expr_tokens);
01189    }
01190    else
01191    {
01192       WN2F_translate(tokens, WN_kid0(wn), context);
01193    }
01194    return EMPTY_WN2F_STATUS;
01195 } /* WN2F_cvtl */
01196 
01197 
01198 WN2F_STATUS 
01199 WN2F_realpart(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01200 {
01201    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_REALPART, 
01202         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_realpart"));
01203    
01204    switch (WN_opc_rtype(wn))
01205    {
01206    case MTYPE_F4:
01207       Append_Token_String(tokens, "REAL");
01208       break;
01209    case MTYPE_F8:
01210       Append_Token_String(tokens, "DBLE");
01211       break;
01212    case MTYPE_FQ:
01213       Append_Token_String(tokens, "QEXT");
01214       break;
01215    default:
01216       ASSERT_DBG_FATAL(FALSE, 
01217            (DIAG_W2F_UNEXPECTED_BTYPE,
01218       MTYPE_name(WN_opc_rtype(wn)),
01219       "WN2F_realpart"));
01220       Append_Token_String(tokens, "WN2F_realpart");
01221       break;
01222    }
01223    Append_Token_Special(tokens, '(');
01224    WN2F_translate(tokens, WN_kid0(wn), context);
01225    Append_Token_Special(tokens, ')');
01226    
01227    return EMPTY_WN2F_STATUS;
01228 } /* WN2F_realpart */
01229 
01230 
01231 WN2F_STATUS 
01232 WN2F_imagpart(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01233 {
01234    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_IMAGPART, 
01235         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_imagpart"));
01236    
01237    switch (WN_opc_rtype(wn))
01238    {
01239    case MTYPE_F4:
01240       Append_Token_String(tokens, "AIMAG");
01241       break;
01242    case MTYPE_F8:
01243       Append_Token_String(tokens, "DIMAG");
01244       break;
01245    case MTYPE_FQ:
01246       Append_Token_String(tokens, "QIMAG");
01247       break;
01248    default:
01249       ASSERT_DBG_FATAL(FALSE, 
01250            (DIAG_W2F_UNEXPECTED_BTYPE,
01251       MTYPE_name(WN_opc_rtype(wn)),
01252       "WN2F_imagpart"));
01253       Append_Token_String(tokens, "WN2F_imagpart");
01254       break;
01255    }
01256    Append_Token_Special(tokens, '(');
01257    WN2F_translate(tokens, WN_kid0(wn), context);
01258    Append_Token_Special(tokens, ')');
01259    
01260    return EMPTY_WN2F_STATUS;
01261 } /* WN2F_imagpart */
01262 
01263 
01264 WN2F_STATUS 
01265 WN2F_paren(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01266 {
01267    WN2F_STATUS status;
01268    
01269    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_PAREN, 
01270         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_paren"));
01271 
01272    Append_Token_Special(tokens, '(');
01273    status = WN2F_translate(tokens, WN_kid0(wn), context);
01274    Append_Token_Special(tokens, ')');
01275 
01276    return status;
01277 } /* WN2F_paren */
01278 
01279 
01280 WN2F_STATUS 
01281 WN2F_complex(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01282 {
01283    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_COMPLEX, 
01284         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_complex"));
01285 
01286    switch (WN_opc_rtype(wn))
01287    {
01288    case MTYPE_C4:
01289       Append_Token_String(tokens, "CMPLX");
01290       break;
01291    case MTYPE_C8:
01292       Append_Token_String(tokens, "DCMPLX");
01293       break;
01294    case MTYPE_CQ:
01295       Append_Token_String(tokens, "QCMPLX");
01296       break;
01297    default:
01298       ASSERT_DBG_FATAL(FALSE, 
01299            (DIAG_W2F_UNEXPECTED_BTYPE,
01300       MTYPE_name(WN_opc_rtype(wn)),
01301       "WN2F_complex"));
01302       Append_Token_String(tokens, "WN2F_complex");
01303       break;
01304    }
01305    /* No need to parenthesize subexpressions */
01306    set_WN2F_CONTEXT_no_parenthesis(context);
01307 
01308    Append_Token_Special(tokens, '('); /* getting real part */
01309    (void)WN2F_translate(tokens, WN_kid0(wn), context);
01310    Append_Token_Special(tokens, ','); /* getting imaginary part */
01311    (void)WN2F_translate(tokens, WN_kid1(wn), context);
01312    Append_Token_Special(tokens, ')');
01313 
01314    return EMPTY_WN2F_STATUS;
01315 } /* WN2F_complex */
01316 
01317 
01318 WN2F_STATUS
01319 WN2F_ceil(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01320 {
01321    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_CEIL, 
01322         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_ceil"));
01323    ASSERT_DBG_FATAL(WN_kid_count(wn) == 1, 
01324         (DIAG_W2F_UNEXPECTED_NUM_KIDS, 
01325          WN_kid_count(wn), 1, WN_opc_name(wn)));
01326 
01327    /* Special handling for opcodes that do not have an intrinsic
01328     * counterpart in compiler versions < v7.00. TODO: define this one.
01329     */
01330    ASSERT_DBG_WARN(!W2F_Ansi_Format, 
01331        (DIAG_W2F_UNEXPECTED_OPC, "WN2F_ceil"));
01332 
01333    WN2F_Funcall_Op(tokens,
01334        WN_opcode(wn),
01335        NULL,
01336        WN_kid0(wn),
01337        context);
01338 
01339    return EMPTY_WN2F_STATUS;
01340 } /* WN2F_ceil */
01341 
01342 
01343 WN2F_STATUS
01344 WN2F_floor(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01345 {
01346    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_FLOOR, 
01347         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_floor"));
01348    ASSERT_DBG_FATAL(WN_kid_count(wn) == 1, 
01349         (DIAG_W2F_UNEXPECTED_NUM_KIDS, 
01350          WN_kid_count(wn), 1, WN_opc_name(wn)));
01351 
01352    /* Special handling for opcodes that do not have an intrinsic
01353     * counterpart in compiler versions < v7.00. TODO: define this one.
01354     */
01355    ASSERT_DBG_WARN(!W2F_Ansi_Format, 
01356        (DIAG_W2F_UNEXPECTED_OPC, "WN2F_floor"));
01357 
01358    WN2F_Funcall_Op(tokens,
01359        WN_opcode(wn),
01360        NULL,
01361        WN_kid0(wn),
01362        context);
01363 
01364    return EMPTY_WN2F_STATUS;
01365 } /* WN2F_floor */
01366 
01367 
01368 WN2F_STATUS
01369 WN2F_ashr(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01370 {
01371    TY_IDX const rty = Stab_Mtype_To_Ty(WN_rtype(wn));
01372 
01373    ASSERT_DBG_FATAL(WN_kid_count(wn) == 2, 
01374         (DIAG_W2F_UNEXPECTED_NUM_KIDS, 
01375          WN_kid_count(wn), 2, WN_opc_name(wn)));
01376 
01377    if (W2F_Ansi_Format)
01378    {
01379       /* Special handling for opcodes that do not have an intrinsic
01380        * counterpart in compiler versions < v7.00.
01381        */
01382       switch (WN_opcode(wn))
01383       {
01384       case OPC_I4ASHR:
01385    Append_Token_String(tokens, "I4ASHR");
01386    break;
01387       case OPC_U8ASHR:
01388    Append_Token_String(tokens, "U8ASHR");
01389    break;
01390       case OPC_I8ASHR:
01391    Append_Token_String(tokens, "I8ASHR");
01392    break;
01393       case OPC_U4ASHR:
01394    Append_Token_String(tokens, "I4ASHR");
01395    break;
01396       default:
01397    ASSERT_DBG_FATAL(FALSE, 
01398         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_ashr"));
01399    break;
01400       }
01401 
01402       /* No need to parenthesize subexpressions */
01403       set_WN2F_CONTEXT_no_parenthesis(context);
01404 
01405       Append_Token_Special(tokens, '(');
01406       WN2F_Translate_Arithmetic_Operand(tokens, WN_kid0(wn), rty,
01407           TRUE, /* call-by-value */
01408           context);
01409       Append_Token_Special(tokens, ',');
01410       WN2F_Translate_Arithmetic_Operand(tokens, WN_kid1(wn), rty,
01411           TRUE, /* call-by-value */
01412           context);
01413 
01414       Append_Token_Special(tokens, ')');
01415    }
01416    else
01417    {
01418       /* Has an intrinsic counterpart in compiler versions >= v7.00.
01419        */
01420       ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_ASHR, 
01421            (DIAG_W2F_UNEXPECTED_OPC, "WN2F_ashr"));
01422       WN2F_Funcall_Op(tokens,
01423           WN_opcode(wn),
01424           WN_kid0(wn),
01425           WN_kid1(wn),
01426           context);
01427    }
01428 
01429    return EMPTY_WN2F_STATUS;
01430 } /* WN2F_ashr */
01431 
01432 
01433 WN2F_STATUS 
01434 WN2F_lshr(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01435 {
01436    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01437    
01438    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_LSHR, 
01439         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_lshr"));
01440 
01441    /* No need to parenthesize subexpressions */
01442    set_WN2F_CONTEXT_no_parenthesis(context);
01443 
01444    Append_Token_String(tokens, "ISHIFT");
01445    Append_Token_Special(tokens, '(');
01446    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,0), result_ty,
01447              !TY_Is_Character_Reference(result_ty),
01448              context);
01449    Append_Token_Special(tokens, ',');
01450    Append_Token_Special(tokens, '-');
01451    Append_Token_Special(tokens, '(');
01452    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,1), result_ty,
01453              !TY_Is_Character_Reference(result_ty),
01454              context);
01455    Append_Token_Special(tokens, ')');
01456    Append_Token_Special(tokens, ')');
01457 
01458    return  EMPTY_WN2F_STATUS;
01459 } /* WN2F_lshr */
01460 
01461 
01462 WN2F_STATUS 
01463 WN2F_bnor(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01464 {
01465    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01466    
01467    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_BNOR, 
01468         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_bnor"));
01469 
01470    /* No need to parenthesize subexpressions */
01471    set_WN2F_CONTEXT_no_parenthesis(context);
01472 
01473    Append_Token_String(tokens, "NOT");
01474    Append_Token_Special(tokens, '(');
01475    Append_Token_String(tokens, "IOR");
01476    Append_Token_Special(tokens, '(');
01477    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,0), result_ty,
01478              !TY_Is_Character_Reference(result_ty),
01479              context);
01480    Append_Token_Special(tokens, ',');
01481    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,1), result_ty,
01482              !TY_Is_Character_Reference(result_ty),
01483              context);
01484    Append_Token_Special(tokens, ')');
01485    Append_Token_Special(tokens, ')');
01486 
01487    return  EMPTY_WN2F_STATUS;
01488 } /* WN2F_bnor */
01489 
01490 
01491 WN2F_STATUS 
01492 WN2F_recip(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01493 {
01494    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01495    
01496    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_RECIP, 
01497         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_recip"));
01498 
01499    Append_Token_Special(tokens, '(');
01500    if (TY_mtype(result_ty) == MTYPE_FQ || TY_mtype(result_ty) == MTYPE_CQ)
01501       Append_Token_String(tokens, "1Q00");
01502    else if (TY_mtype(result_ty) == MTYPE_F8 || TY_mtype(result_ty) == MTYPE_C8)
01503       Append_Token_String(tokens, "1D00");
01504    else
01505       Append_Token_String(tokens, "1E00");
01506 
01507    Append_Token_Special(tokens, '/');
01508    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,0), result_ty,
01509              !TY_Is_Character_Reference(result_ty),
01510              context);
01511    Append_Token_Special(tokens, ')');
01512 
01513    return EMPTY_WN2F_STATUS;
01514 } /* WN2F_recip */
01515 
01516 WN2F_STATUS 
01517 WN2F_rsqrt(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01518 {
01519    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01520    
01521    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_RSQRT, 
01522         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_rsqrt"));
01523 
01524    Append_Token_Special(tokens, '(');
01525    Append_Token_String(tokens, "1.0");
01526    Append_Token_Special(tokens, '/');
01527    Append_Token_String(tokens, "SQRT");
01528    Append_Token_Special(tokens, '(');
01529    set_WN2F_CONTEXT_no_parenthesis(context);
01530    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,0), result_ty,
01531              !TY_Is_Character_Reference(result_ty),
01532              context);
01533    Append_Token_Special(tokens, ')');
01534    Append_Token_Special(tokens, ')');
01535 
01536    return EMPTY_WN2F_STATUS;
01537 } /* WN2F_rsqrt */
01538 
01539 
01540 WN2F_STATUS 
01541 WN2F_madd(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01542 {
01543    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01544    
01545    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_MADD, 
01546         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_madd"));
01547 
01548    Append_Token_Special(tokens, '(');
01549    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,1), result_ty,
01550              !TY_Is_Character_Reference(result_ty),
01551              context);
01552    Append_Token_Special(tokens, '*');
01553    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,2), result_ty,
01554              !TY_Is_Character_Reference(result_ty),
01555              context);
01556    Append_Token_Special(tokens, '+');
01557    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn, 0), result_ty,
01558              !TY_Is_Character_Reference(result_ty),
01559              context);
01560    Append_Token_Special(tokens, ')');
01561 
01562    return  EMPTY_WN2F_STATUS;
01563 } /* WN2F_madd */
01564 
01565 
01566 WN2F_STATUS 
01567 WN2F_msub(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01568 {
01569    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01570    
01571    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_MSUB, 
01572         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_msub"));
01573 
01574    Append_Token_Special(tokens, '(');
01575    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,1), result_ty,
01576              !TY_Is_Character_Reference(result_ty),
01577              context);
01578    Append_Token_Special(tokens, '*');
01579    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,2), result_ty,
01580              !TY_Is_Character_Reference(result_ty),
01581              context);
01582    Append_Token_Special(tokens, '-');
01583    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn, 0), result_ty,
01584              !TY_Is_Character_Reference(result_ty),
01585              context);
01586    Append_Token_Special(tokens, ')');
01587 
01588    return  EMPTY_WN2F_STATUS;
01589 } /* WN2F_msub */
01590 
01591 
01592 WN2F_STATUS 
01593 WN2F_nmadd(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01594 {
01595    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01596 
01597    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_NMADD, 
01598         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_nmadd"));
01599 
01600    Append_Token_Special(tokens, '-');
01601    Append_Token_Special(tokens, '(');
01602    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,1), result_ty,
01603              !TY_Is_Character_Reference(result_ty),
01604              context);
01605    Append_Token_Special(tokens, '*');
01606    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,2), result_ty,
01607              !TY_Is_Character_Reference(result_ty),
01608              context);
01609    Append_Token_Special(tokens, '+');
01610    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn, 0), result_ty,
01611              !TY_Is_Character_Reference(result_ty),
01612              context);
01613    Append_Token_Special(tokens, ')');
01614 
01615    return  EMPTY_WN2F_STATUS;
01616 } /* WN2F_nmadd */
01617 
01618 
01619 WN2F_STATUS 
01620 WN2F_nmsub(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01621 {
01622    TY_IDX const result_ty = Stab_Mtype_To_Ty(WN_opc_rtype(wn));
01623    
01624    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_NMSUB, 
01625         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_nmsub"));
01626 
01627    Append_Token_Special(tokens, '-');
01628    Append_Token_Special(tokens, '(');
01629    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,1), result_ty,
01630              !TY_Is_Character_Reference(result_ty),
01631              context);
01632    Append_Token_Special(tokens, '*');
01633    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn,2), result_ty,
01634              !TY_Is_Character_Reference(result_ty),
01635              context);
01636    Append_Token_Special(tokens, '-');
01637    WN2F_Translate_Arithmetic_Operand(tokens, WN_kid(wn, 0), result_ty,
01638              !TY_Is_Character_Reference(result_ty),
01639              context);
01640    Append_Token_Special(tokens, ')');
01641 
01642    return  EMPTY_WN2F_STATUS;
01643 } /* WN2F_nmsub */
01644 
01645 
01646 WN2F_STATUS 
01647 WN2F_const(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01648 {
01649    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_CONST, 
01650         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_const"));
01651 
01652    TCON2F_translate(tokens,
01653         STC_val(WN_st(wn)),
01654         (TY_is_logical(ST_type(WN_st(wn))) ||
01655          WN2F_CONTEXT_is_logical_arg(context)));
01656 
01657    return EMPTY_WN2F_STATUS;
01658 } /* WN2F_const */
01659 
01660 
01661 WN2F_STATUS 
01662 WN2F_intconst(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01663 {
01664    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_INTCONST, 
01665         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_intconst"));
01666 
01667    TCON2F_translate(tokens,
01668         Host_To_Targ(WN_opc_rtype(wn), WN_const_val(wn)),
01669         WN2F_CONTEXT_is_logical_arg(context));
01670 
01671    return EMPTY_WN2F_STATUS;
01672 } /* WN2F_intconst */
01673 
01674 
01675 WN2F_STATUS 
01676 WN2F_eq(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01677 {
01678    /* Try to reduce "bool .EQ. 0" to simply ".NOT. (bool)", whenever possible.
01679     */
01680 
01681    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_EQ, 
01682         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_eq"));
01683 
01684    if (WN_opc_operator(WN_kid0(wn)) == OPR_INTCONST &&
01685        WN_const_val(WN_kid0(wn)) == 0LL             &&
01686        (OPCODE_is_boolean(WN_opcode(WN_kid1(wn))) ||
01687   TY_is_logical(WN_Tree_Type(WN_kid1(wn)))))
01688    {
01689       Append_Token_String(tokens, ".NOT.");
01690       Append_Token_Special(tokens, '(');
01691       set_WN2F_CONTEXT_no_parenthesis(context);
01692       WN2F_translate(tokens, WN_kid1(wn), context);
01693       Append_Token_Special(tokens, ')');
01694    }
01695    else if (WN_opc_operator(WN_kid1(wn)) == OPR_INTCONST &&
01696       WN_const_val(WN_kid1(wn)) == 0LL             &&
01697       (OPCODE_is_boolean(WN_opcode(WN_kid0(wn))) ||
01698        TY_is_logical(WN_Tree_Type(WN_kid0(wn)))))
01699    {
01700       Append_Token_String(tokens, ".NOT.");
01701       Append_Token_Special(tokens, '(');
01702       set_WN2F_CONTEXT_no_parenthesis(context);
01703       WN2F_translate(tokens, WN_kid0(wn), context);
01704       Append_Token_Special(tokens, ')');
01705    }
01706    else
01707    {
01708       WN2F_binaryop(tokens, wn, context);
01709    }
01710    
01711    return EMPTY_WN2F_STATUS;
01712 } /* WN2F_eq */
01713 
01714 
01715 WN2F_STATUS 
01716 WN2F_ne(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01717 {
01718    /* Try to reduce "bool .NE. 0" to simply "bool", whenever possible.
01719     */
01720 
01721    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_NE, 
01722         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_ne"));
01723 
01724    if (WN_opc_operator(WN_kid0(wn)) == OPR_INTCONST &&
01725        WN_const_val(WN_kid0(wn)) == 0LL             &&
01726        (OPCODE_is_boolean(WN_opcode(WN_kid1(wn))) ||
01727   TY_is_logical(WN_Tree_Type(WN_kid1(wn)))))
01728    {
01729       WN2F_translate(tokens, WN_kid1(wn), context);
01730    }
01731    else if (WN_opc_operator(WN_kid1(wn)) == OPR_INTCONST &&
01732       WN_const_val(WN_kid1(wn)) == 0LL             &&
01733       (OPCODE_is_boolean(WN_opcode(WN_kid0(wn))) ||
01734        TY_is_logical(WN_Tree_Type(WN_kid0(wn)))))
01735    {
01736       WN2F_translate(tokens, WN_kid0(wn), context);
01737    }
01738    else
01739    {
01740       WN2F_binaryop(tokens, wn, context);
01741    }
01742    
01743    return EMPTY_WN2F_STATUS;
01744 } /* WN2F_ne */
01745 
01746 
01747 
01748 WN2F_STATUS 
01749 WN2F_parm(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01750 {
01751    /* TODO: handle opcode parms properly, i.e. take some advantage
01752     * of the information provided in this packaging of argument 
01753     * expressions.  For now, just skip these nodes.
01754     */
01755    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_PARM, 
01756         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_parm"));
01757 
01758    return WN2F_translate(tokens, WN_kid0(wn), context);
01759 } /* WN2F_parm */
01760 
01761 
01762 /*---------------- Memory allocation ops -------------------*/
01763 
01764 WN2F_STATUS 
01765 WN2F_alloca(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01766 {
01767    ASSERT_DBG_FATAL(WN_operator(wn) == OPR_ALLOCA, 
01768         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_alloca"));
01769 
01770 
01771    Append_Token_String(tokens,"OPR_ALLOCA");
01772    Append_Token_Special(tokens,'(');
01773    WN2F_translate(tokens,WN_kid0(wn),context);
01774    Append_Token_Special(tokens,')');
01775 
01776    return EMPTY_WN2F_STATUS;
01777 } /* WN2F_alloca */
01778 
01779 
01780 WN2F_STATUS 
01781 WN2F_dealloca(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01782 {
01783   INT16 n,i;
01784 
01785    ASSERT_DBG_FATAL(WN_operator(wn) == OPR_DEALLOCA, 
01786         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_dealloca"));
01787 
01788    n = WN_kid_count(wn);
01789 
01790    WN2F_Stmt_Newline(tokens, NULL/*label*/, WN_linenum(wn), context);
01791    Append_Token_String(tokens,"CALL OPR_DEALLOCA");
01792    Append_Token_Special(tokens,'(');
01793 
01794    i = 0 ;
01795    while (i < n)
01796    {
01797      WN2F_translate(tokens,WN_kid(wn,i),context);
01798      if (++i < n)
01799        Append_Token_Special(tokens,',');
01800    }
01801 
01802    Append_Token_Special(tokens,')');
01803    return EMPTY_WN2F_STATUS;
01804 } /* WN2F_dealloca */
01805