Open64: osprey/be/whirl2f/wn2f

00001 /*
00002 
00003   Copyright (C) 2000, 2001 Silicon Graphics, Inc.  All Rights Reserved.
00004 
00005   This program is free software; you can redistribute it and/or modify it
00006   under the terms of version 2 of the GNU General Public License as
00007   published by the Free Software Foundation.
00008 
00009   This program is distributed in the hope that it would be useful, but
00010   WITHOUT ANY WARRANTY; without even the implied warranty of
00011   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  
00012 
00013   Further, this software is distributed without any warranty that it is
00014   free of the rightful claim of any third person regarding infringement 
00015   or the like.  Any license provided herein, whether implied or 
00016   otherwise, applies only to this software file.  Patent licenses, if 
00017   any, provided herein do not apply to combinations of this program with 
00018   other software, or any other product whatsoever.  
00019 
00020   You should have received a copy of the GNU General Public License along
00021   with this program; if not, write the Free Software Foundation, Inc., 59
00022   Temple Place - Suite 330, Boston MA 02111-1307, USA.
00023 
00024   Contact information:  Silicon Graphics, Inc., 1600 Amphitheatre Pky,
00025   Mountain View, CA 94043, or:
00026 
00027   http://www.sgi.com
00028 
00029   For further information regarding this notice, see:
00030 
00031   http://oss.sgi.com/projects/GenInfo/NoticeExplan
00032 
00033 */
00034 
00035 
00036 /* ====================================================================
00037  * ====================================================================
00038  *
00039  * Module: wn2f_io.c
00040  * $Revision: 1.1 $
00041  * $Date: 2005/07/27 02:13:43 $
00042  * $Author: kevinlo $
00043  * $Source: /depot/CVSROOT/javi/src/sw/cmplr/be/whirl2f/wn2f_io.cxx,v $
00044  *
00045  * Revision history:
00046  *  5-June-95 - Original Version
00047  *
00048  * Description:
00049  *
00050  *   Translate an OPC_IO subtree into the appropriate Fortran constructs.
00051  *   Recursive translation of WN nodes should only use WN2F_Translate(),
00052  *   with exception of IO_ITEMS which are handled locally!
00053  *
00054  *   The Fortran I/O statements have the following syntax:
00055  *
00056  *      <statement_keyword> <control_list> <I/O list>
00057  *
00058  *   where
00059  *
00060  *      <statement_keyword> ::= <IOS enumeration as defined in wio.h>
00061  *      <control_list>      ::= <IOU, IOF, and IOC items from wio.h>
00062  *      <I/O list>          ::= <IOL items from wio.h>
00063  *
00064  * ====================================================================
00065  * ====================================================================
00066  */
00067 
00068 #ifdef _KEEP_RCS_ID
00069 /*REFERENCED*/
00070 static char *rcs_id = "$Source: /depot/CVSROOT/javi/src/sw/cmplr/be/whirl2f/wn2f_io.cxx,v $ $Revision: 1.1 $";
00071 #endif
00072 
00073 #include "whirl2f_common.h"
00074 #include "wio.h"
00075 #include "wutil.h"
00076 #include "PUinfo.h"          /* In be/whirl2c directory */
00077 #include "wn2f.h"
00078 #include "st2f.h"
00079 #include "ty2f.h"
00080 #include "tcon2f.h"
00081 #include "wn2f_io.h"
00082 #include "wn2f_load_store.h"
00083 
00084 
00085 /* A rather special IOC item to replace an IOF_LABEL item.  This
00086  * value is only valid when WN2F_CONTEXT_origfmt_ioctrl is TRUE!
00087  */
00088 static UINT32       Origfmt_Ioctrl_Label;
00089 static TOKEN_BUFFER Format_Stmts = NULL;
00090 static TOKEN_BUFFER Ios_Prefix_Tokens = NULL;
00091 
00092 typedef void (*IO_STMT_HANDLER)(TOKEN_BUFFER, WN *, WN2F_CONTEXT);
00093 static IO_STMT_HANDLER Ios_Handler[IOSTATEMENT_LAST+1];
00094 
00095 
00096 #define WN_IOITEM(x) (IOITEM) WN_io_item(x)
00097 #define WN_IOSTMT(x) (IOSTATEMENT) WN_io_statement(x)
00098 
00099 /* several craylib/dope items represent a no-op by a zero inconst...*/
00100 
00101 #define IS_IO_NULL_OPR(wn) ((WN_operator(wn) == OPR_INTCONST) && (WN_const_val(wn) == 0))
00102 
00103 /*------------------------- Io Utility Routines -----------------------*/
00104 /*---------------------------------------------------------------------*/
00105 
00106 static void 
00107 WN2F_Append_IO_CtrlList(TOKEN_BUFFER tokens, 
00108       WN          *ios,
00109       INT          from_kid,
00110       INT          to_kid,
00111       BOOL         use_keyword,
00112       WN2F_CONTEXT context)
00113 {
00114    /* Emit an IO control list (IOU, IOF, and IOC with explicit
00115     * keywords.
00116     */
00117    BOOL         emitted, emitted2;
00118    INT          ios_kid;
00119    TOKEN_BUFFER item_buffer;
00120    
00121    Append_Token_Special(tokens, '(');
00122 
00123    /* Should we use keyword notation? */
00124    if (use_keyword)
00125       set_WN2F_CONTEXT_keyword_ioctrl(context);
00126    
00127    emitted = FALSE; /* No item before the next one, as of yet */
00128    for (ios_kid = from_kid; ios_kid <= to_kid; ios_kid++)
00129    {
00130       item_buffer = New_Token_Buffer();
00131       emitted2 = WN2F_io_item(item_buffer, WN_kid(ios, ios_kid), context);
00132       if (emitted2)
00133       {
00134    if (emitted)
00135       Append_Token_Special(tokens, ','); /* an item emitted earlier */
00136    emitted = TRUE;
00137       }
00138       Append_And_Reclaim_Token_List(tokens, &item_buffer);
00139    }
00140    reset_WN2F_CONTEXT_origfmt_ioctrl(context);
00141 
00142    Append_Token_Special(tokens, ')');
00143 } /* WN2F_Append_IO_CtrlList */
00144 
00145 
00146 static void 
00147 WN2F_Append_IO_List(TOKEN_BUFFER tokens, 
00148         WN          *ios,
00149         INT          from_kid,
00150         WN2F_CONTEXT context)
00151 {
00152    /* Emit an IOL list, starting at the given kid index and
00153     * continuing to the last kid.
00154     */
00155    BOOL emitted;
00156    INT  ios_kid;
00157    
00158    for (ios_kid = from_kid; ios_kid < WN_kid_count(ios); ios_kid++)
00159    {
00160       emitted = WN2F_io_item(tokens, WN_kid(ios, ios_kid), context);
00161       if (emitted && (ios_kid+1 < WN_kid_count(ios)))
00162    Append_Token_Special(tokens, ',');
00163    }
00164 } /* WN2F_Append_IO_List */
00165 
00166 
00167 /*---------------------- IO Item Handler-routines ---------------------*/
00168 /*---------------------------------------------------------------------*/
00169 
00170 #define WN2F_IS_IOU(item) \
00171    (WN_IOITEM(item) >= IOU_NONE && WN_IOITEM(item) <= IOU_INTERNAL)
00172 #define WN2F_IS_IOF(item) \
00173    ((WN_IOITEM(item) >= IOF_NONE && WN_IOITEM(item) <= IOF_CR_FMTSRC_DOPE))
00174 #define WN2F_IS_IOC(item) \
00175    (WN_IOITEM(item) >= IOC_ACCESS && WN_IOITEM(item) <= IOC_ERRFLAG)
00176 #define WN2F_IS_IOL(item) \
00177    ((WN_IOITEM(item) >= IOL_ARRAY && WN_IOITEM(item) <= IOL_VAR) || \
00178     (WN_IOITEM(item) == IOL_DOPE))
00179 
00180 
00181 static void
00182 WN2F_emit_ctrl(TOKEN_BUFFER tokens, const char *p , WN2F_CONTEXT context)
00183 {
00184   if (WN2F_CONTEXT_keyword_ioctrl(context))
00185   {
00186     Append_Token_String(tokens,p);
00187     Append_Token_Special(tokens, '=');
00188   }
00189 }
00190 
00191 static BOOL
00192 WN2F_io_unit(TOKEN_BUFFER tokens, 
00193        WN          *item, 
00194        WN2F_CONTEXT context)
00195 {
00196    
00197    BOOL emitted = TRUE; /*  if a unit specifier was emitted */
00198    const char * p = "unit";
00199 
00200    /* Any arguments assumed to be by reference unless otherwise noted */
00201    set_WN2F_CONTEXT_deref_addr(context);
00202 
00203    switch (WN_io_item(item))
00204    {
00205    case IOU_NONE: 
00206      if (WN2F_CONTEXT_cray_io(context))
00207      {
00208        WN2F_emit_ctrl(tokens,p,context);
00209        Append_Token_Special(tokens, '*');
00210      } else
00211        emitted = FALSE;  /* eg: inquire by file */
00212       break;
00213       
00214    case IOU_DEFAULT: /* asterisk or double astrisk */
00215       WN2F_emit_ctrl(tokens,p,context);
00216       if (WN_const_val(WN_kid0(item)) == 0)
00217   Append_Token_String(tokens, "**");
00218       else
00219   Append_Token_Special(tokens, '*');
00220       break;
00221 
00222    case IOU_EXTERNAL:    /* unit number */
00223    case IOU_DOPE:
00224    case IOU_INTERNAL:    /* substring or array reference */
00225       WN2F_emit_ctrl(tokens,p,context);
00226       WN2F_translate(tokens, WN_kid0(item), context);
00227       break;
00228 
00229    default:
00230       ASSERT_DBG_WARN(FALSE, 
00231           (DIAG_W2F_UNEXPECTED_IOU,
00232            IOITEM_name(WN_IOITEM(item)), "WN2F_io_unit"));
00233       WN2F_emit_ctrl(tokens,p,context);
00234       Append_Token_String(tokens, IOITEM_name(WN_IOITEM(item)));
00235       break;
00236    } /*switch*/
00237 
00238    return emitted;
00239 } /* WN2F_io_unit */
00240 
00241 
00242 static BOOL
00243 WN2F_io_format(TOKEN_BUFFER tokens, 
00244          WN          *item, 
00245          WN2F_CONTEXT context)
00246 {
00247    /* Return TRUE if a format or name-list specifier was emitted */ 
00248 
00249    BOOL emitted = TRUE;
00250    const char *p = "fmt";
00251 
00252    /* Any arguments assumed to be by reference unless otherwise noted */
00253    set_WN2F_CONTEXT_deref_addr(context);
00254 
00255    switch (WN_io_item(item))
00256    {
00257    case IOF_NONE:
00258       if (WN2F_CONTEXT_cray_io(context) && 
00259     WN2F_CONTEXT_fmt_io(context))
00260       {
00261         WN2F_emit_ctrl(tokens,p,context);
00262   Append_Token_Special(tokens, '*');
00263       }
00264       else
00265         emitted = FALSE;
00266       break;
00267 
00268    case IOF_ASSIGNED_VAR:
00269 
00270       /* The front-end should never generate these, since they are converted
00271        * into IOF_CHAR_EXPR items.  Should we for any reason start regenerating
00272        * these, this is the place where it should occur.
00273        */
00274       ASSERT_DBG_WARN(FALSE, 
00275           (DIAG_W2F_UNEXPECTED_IOF,
00276            IOITEM_name(WN_IOITEM(item)), "WN2F_io_format"));
00277       Append_Token_String(tokens, IOITEM_name(WN_IOITEM(item)));
00278 #if 0
00279       WN2F_translate(tokens, WN_kid0(item), context);      
00280 #endif
00281       break;
00282 
00283    case IOF_LABEL:
00284       /* a FORMAT label or character-string expression */
00285 
00286       WN2F_emit_ctrl(tokens,p,context);
00287       if (WN2F_CONTEXT_origfmt_ioctrl(context))
00288    Append_Token_String(tokens, 
00289            Number_as_String(Origfmt_Ioctrl_Label, "%lld"));
00290       else
00291    WN2F_translate(tokens, WN_kid0(item), context);
00292       break;
00293 
00294    case IOF_CHAR_EXPR:
00295       /* a character-substring expression */
00296 
00297       WN2F_emit_ctrl(tokens,p,context);
00298       WN2F_String_Argument(tokens,
00299          WN_kid0(item), /* base */
00300          WN_kid1(item), /* length */
00301          context);
00302       break;
00303 
00304    case IOF_LIST_DIRECTED:
00305       WN2F_emit_ctrl(tokens,p,context);
00306       Append_Token_Special(tokens, '*');
00307       break;
00308 
00309    case IOF_NAMELIST_DIRECTED:
00310       WN2F_emit_ctrl(tokens,"nml",context);
00311       WN2F_translate(tokens, WN_kid0(item), context);
00312       break;
00313 
00314    case IOF_UNFORMATTED:
00315       emitted = FALSE;
00316       break;
00317 
00318    case IOF_CR_PARSFMT:
00319       emitted = FALSE;
00320       break;
00321        
00322    case IOF_CR_FMTSRC:
00323    case IOF_CR_FMTSRC_DOPE:
00324       {
00325   WN * kid0 = WN_kid0(item);
00326   if (IS_IO_NULL_OPR(kid0))
00327     emitted = FALSE;
00328   else
00329     WN2F_translate(tokens, kid0, context);
00330   break;
00331       }
00332    default:
00333       ASSERT_DBG_WARN(FALSE, 
00334           (DIAG_W2F_UNEXPECTED_IOF,
00335            IOITEM_name(WN_IOITEM(item)), "WN2F_io_format"));
00336       Append_Token_String(tokens, IOITEM_name(WN_IOITEM(item)));
00337       break;
00338    } /*switch*/
00339 
00340    return emitted;
00341 } /* WN2F_io_format */
00342 
00343 static BOOL
00344 WN2F_io_control(TOKEN_BUFFER tokens, 
00345     WN          *item, 
00346     WN2F_CONTEXT context)
00347 {
00348    /* Return TRUE if a control specifier was emitted.
00349     */
00350    BOOL         emitted = TRUE;
00351    const IOITEM item_kind = WN_IOITEM(item);
00352    
00353    switch (item_kind)
00354    {
00355    case IOC_KEY:
00356       /* TODO: associate this with IOC_KEY */
00357       ASSERT_WARN(FALSE, (DIAG_UNIMPLEMENTED, 
00358         Concat2_Strings("IOC", IOITEM_name(item_kind))));
00359       Append_Token_String(tokens, IOITEM_name(item_kind));
00360       Append_Token_Special(tokens, '=');
00361       Append_Token_String(tokens, "<???>");
00362       break;
00363       
00364    case IOC_KEY_START:
00365    case IOC_KEY_END:
00366    case IOC_KEY_CHARACTER:
00367    case IOC_KEY_INTEGER: 
00368    case IOC_NML: /* TODO: remove from IOC enumeration! It is redundant */
00369       ASSERT_WARN(FALSE, (DIAG_UNIMPLEMENTED, 
00370         Concat2_Strings("IOC", IOITEM_name(item_kind))));
00371       Append_Token_String(tokens, IOITEM_name(item_kind));
00372       break;
00373       
00374    case IOC_EXIST:
00375    case IOC_NAMED:
00376    case IOC_OPENED:
00377       /* LOGICAL argument */
00378       ASSERT_FATAL(WN_kid_count(item) >= 1,
00379        (DIAG_W2F_UNEXPECTED_NUM_KIDS, 
00380         WN_kid_count(item), 1, "WN2F_io_control"));
00381       Append_Token_String(tokens, IOITEM_name(item_kind));
00382       Append_Token_Special(tokens, '=');
00383       set_WN2F_CONTEXT_has_logical_arg(context);
00384       if (TY_kind(WN_Tree_Type(WN_kid0(item))) != KIND_SCALAR)
00385    set_WN2F_CONTEXT_deref_addr(context);
00386       WN2F_translate(tokens, WN_kid0(item), context);
00387       reset_WN2F_CONTEXT_has_logical_arg(context);
00388       break;
00389       
00390    case IOC_READONLY:
00391    case IOC_SHARED:
00392    case IOC_U:
00393       Append_Token_String(tokens, IOITEM_name(item_kind));
00394       /* No argument */
00395       break;
00396 
00397    case IOC_VARFMT:
00398       emitted = FALSE;
00399       break;
00400 
00401    case IOC_VARFMT_ORIGFMT:
00402       /* We assume a label-number already has been assigned for
00403        * this FORMAT statement into Origfmt_Ioctrl_Label.  See
00404        * also IOF_LABEL.  Expect the string argument to be an
00405        * LDA of a string-constant (ST of class CONST).  Note that
00406        * a string-constant always is '\0' terminated.
00407        */
00408       ASSERT_DBG_WARN((WN_opc_operator(WN_kid0(item)) == OPR_LDA &&
00409            ST_class(WN_st(WN_kid0(item))) == CLASS_CONST),
00410           (DIAG_W2F_UNEXPECTED_IOC,
00411            IOITEM_name(WN_IOITEM(item)), "WN2F_io_control"));
00412 
00413       if (Format_Stmts == NULL)
00414    Format_Stmts = New_Token_Buffer();
00415 
00416       reset_WN2F_CONTEXT_no_newline(context);
00417       WN2F_Stmt_Newline(
00418    Format_Stmts, 
00419    Number_as_String(Origfmt_Ioctrl_Label, "%lld"), 
00420    WN_linenum(item), context);
00421 
00422       Append_Token_String(Format_Stmts, "FORMAT");
00423       Append_Token_String(Format_Stmts, 
00424         Targ_String_Address(STC_val(WN_st(WN_kid0(item)))));
00425       emitted = FALSE; /* Only emitted into Format_Stmts */
00426       break;
00427 
00428    case IOC_ERR:
00429    case IOC_EOR:
00430    case IOC_END:
00431       Append_Token_String(tokens, IOITEM_name(item_kind));
00432       Append_Token_Special(tokens, '=');
00433       ASSERT_DBG_WARN((WN_opc_operator(WN_kid0(item)) == OPR_GOTO),
00434           (DIAG_W2F_UNEXPECTED_OPC,WN_opc_operator(item),"ERR/END/EOR="));
00435       Append_Token_String(tokens, 
00436         WHIRL2F_number_as_name(WN_label_number(WN_kid0(item))));
00437       break;
00438 
00439    case IOC_CR_FLFLAG:
00440    case IOC_CR_EDFLAG:
00441    case IOC_ERRFLAG:
00442    case IOC_CR_EEEFLAG:
00443      emitted = FALSE;
00444      break;
00445 
00446    default:
00447       /* The usual case; an arbitrary non-logic expression argument,
00448        * which is usually an integral value, an array, or a character
00449        * string.
00450        */
00451       Append_Token_String(tokens, IOITEM_name(item_kind));
00452       Append_Token_Special(tokens, '=');
00453       if (TY_kind(WN_Tree_Type(WN_kid0(item))) != KIND_SCALAR)
00454    set_WN2F_CONTEXT_deref_addr(context);
00455 
00456       /* if kid count > 1, then it's a character object */
00457 
00458       if (WN_kid_count(item) == 1)
00459   WN2F_translate(tokens, WN_kid0(item), context);
00460       else
00461   WN2F_String_Argument(tokens,WN_kid0(item),WN_kid1(item),context);
00462       break;
00463    }
00464    
00465    return emitted;
00466 } /* WN2F_io_control */
00467 
00468 
00469 extern void
00470    WN2F_implied_do(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context);
00471 
00472 static BOOL
00473 WN2F_io_list(TOKEN_BUFFER tokens, 
00474        WN          *item, 
00475        WN2F_CONTEXT context)
00476 {
00477    const IOITEM item_kind = WN_IOITEM(item);
00478 
00479    switch (item_kind)
00480    {
00481    case IOL_VAR:
00482    case IOL_ARRAY:
00483    case IOL_CHAR_ARRAY:
00484    case IOL_RECORD:
00485       if (WN_opc_operator(WN_kid0(item)) == OPR_LDID       &&
00486           ST_sclass(WN_st(WN_kid0(item))) == SCLASS_FORMAL &&
00487           TY_Is_Pointer(WN_ty(WN_kid0(item)))              &&
00488           TY_Is_Pointer(TY_pointed(WN_ty(WN_kid0(item)))))
00489       {
00490          /* Work around a f77 bug
00491           */
00492          WN_set_ty(WN_kid0(item), TY_pointed(WN_ty(WN_kid0(item))));
00493       }
00494       set_WN2F_CONTEXT_deref_addr(context); /* Assume pass-by-reference */
00495       WN2F_translate(tokens, WN_kid0(item), context);
00496       break;
00497 
00498    case IOL_CHAR: 
00499      { 
00500        WN * len = WN_kid1(item);
00501        if (WN2F_CONTEXT_cray_io(context))   /* typecode is kid1 */
00502   len = WN_kid2(item);
00503 
00504        WN2F_String_Argument(tokens,
00505           WN_kid0(item), /* base */
00506           len,           /* length */
00507           context);
00508      }
00509      break;
00510 
00511    case IOL_EXPR:
00512       reset_WN2F_CONTEXT_deref_addr(context); /* Assume pass-by-value */
00513       WN2F_translate(tokens, WN_kid0(item), context);
00514       break;
00515       
00516    case IOL_IMPLIED_DO:
00517    case IOL_IMPLIED_DO_1TRIP:
00518       reset_WN2F_CONTEXT_deref_addr(context); /* Handled specially */
00519       WN2F_implied_do(tokens, item, context); /* Defined in WN2F_stmt.c */
00520       break;
00521         
00522    case IOL_LOGICAL:
00523       set_WN2F_CONTEXT_has_logical_arg(context);
00524       reset_WN2F_CONTEXT_deref_addr(context); /* Assume pass-by-value */
00525       WN2F_translate(tokens, WN_kid0(item), context);
00526       break;
00527 
00528    case IOL_DOPE:
00529       {
00530         INT32 kids = WN_kid_count(item);
00531 
00532         /* base address */ 
00533 
00534   set_WN2F_CONTEXT_deref_addr(context); 
00535   WN2F_translate(tokens, WN_kid0(item), context);
00536 
00537   if (kids > 2)  /* implied do? */
00538         {
00539     Append_Token_Special(tokens, '(');
00540 
00541     /* Generate the subscript list - part may be in dope address, */
00542           /* set up several stmts ago. may just get INTCONST(0) here    */
00543   
00544     INT32 i = 2 ;
00545     while (i < kids)
00546           {
00547       WN2F_translate(tokens, WN_kid(item,i), context);
00548         
00549       if (i++ < kids-1)
00550         Append_Token_Special(tokens, ',');
00551     }
00552     Append_Token_Special(tokens, ')');
00553   }
00554       }
00555       break ;
00556 
00557    default:
00558       ASSERT_DBG_WARN(FALSE, 
00559           (DIAG_W2F_UNEXPECTED_IOL,
00560            IOITEM_name(WN_IOITEM(item)), "WN2F_io_list"));
00561       Append_Token_String(tokens, IOITEM_name(WN_IOITEM(item)));
00562       break;
00563    } /* switch */
00564    
00565    return TRUE;
00566 } /* WN2F_io_list */
00567 
00568 
00569 /*---------- IO Statement Handler-routines and Dispatch-array ---------*/
00570 /*---------------------------------------------------------------------*/
00571 
00572 static void 
00573 WN2F_ios_backspace(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00574 {
00575    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00576     * use the explicit UNIT keyword, unless there is exactly one kid an
00577     * it is an IOU.
00578     */
00579    ASSERT_WARN(WN_IOSTMT(wn) == IOS_BACKSPACE || WN_IOSTMT(wn) == IOS_CR_BACKSPACE, 
00580          (DIAG_W2F_UNEXPECTED_IOS, 
00581     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_backspace"));
00582    
00583    Append_Token_String(tokens, "BACKSPACE");
00584    if (WN_kid_count(wn) == 1 && WN2F_IS_IOU(WN_kid0(wn)))
00585       (void)WN2F_io_item(tokens, WN_kid0(wn), context);
00586    else
00587       WN2F_Append_IO_CtrlList(tokens,
00588             wn,                 /* ios */
00589             0,                  /* from kid*/
00590             WN_kid_count(wn)-1, /* to kid*/
00591             TRUE,               /* use keyword control */
00592             context);
00593 
00594 } /* WN2F_ios_backspace */
00595 
00596 
00597 static void 
00598 WN2F_ios_close(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00599 {
00600    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00601     * use the explicit UNIT keyword.
00602     */
00603    ASSERT_WARN(WN_IOSTMT(wn) == IOS_CLOSE || WN_IOSTMT(wn) == IOS_CR_CLOSE, 
00604          (DIAG_W2F_UNEXPECTED_IOS, 
00605     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_close"));
00606 
00607    Append_Token_String(tokens, "CLOSE");
00608    WN2F_Append_IO_CtrlList(tokens,
00609          wn,                 /* ios */
00610          0,                  /* from kid*/
00611          WN_kid_count(wn)-1, /* to kid*/
00612          TRUE,               /* use keyword control */
00613          context);
00614 } /* WN2F_ios_close */
00615 
00616 
00617 static void 
00618 WN2F_ios_definefile(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00619 {
00620    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00621     * use the explicit UNIT keyword.
00622     */
00623    ASSERT_FATAL(WN_io_statement(wn) == IOS_DEFINEFILE   &&
00624     WN_kid_count(wn) == 5                   &&
00625     WN_io_item(WN_kid(wn, 1)) == IOC_MAXREC &&
00626     WN_io_item(WN_kid(wn, 2)) == IOC_RECL   &&
00627     WN_io_item(WN_kid(wn, 3)) == IOC_U      &&
00628     WN_io_item(WN_kid(wn, 4)) == IOC_ASSOCIATEVARIABLE,
00629     (DIAG_W2F_UNEXPECTED_IOS, 
00630      IOSTATEMENT_name(WN_IOSTMT(wn)), 
00631      "WN2F_ios_definefile"));
00632 
00633    Append_Token_String(tokens, "DEFINE FILE");
00634 
00635    reset_WN2F_CONTEXT_keyword_ioctrl(context);
00636    WN2F_io_unit(tokens, WN_kid(wn, 0), context);
00637    Append_Token_Special(tokens, '(');
00638 
00639    if (TY_kind(WN_Tree_Type(WN_kid0(WN_kid(wn, 1)))) != KIND_SCALAR)
00640       set_WN2F_CONTEXT_deref_addr(context);
00641    WN2F_translate(tokens, WN_kid0(WN_kid(wn, 1)), context);
00642    reset_WN2F_CONTEXT_deref_addr(context);
00643    Append_Token_Special(tokens, ',');
00644 
00645    if (TY_kind(WN_Tree_Type(WN_kid0(WN_kid(wn, 2)))) != KIND_SCALAR)
00646       set_WN2F_CONTEXT_deref_addr(context);
00647    WN2F_translate(tokens, WN_kid0(WN_kid(wn, 2)), context);
00648    reset_WN2F_CONTEXT_deref_addr(context);
00649    Append_Token_Special(tokens, ',');
00650 
00651    Append_Token_String(tokens, "U");
00652    Append_Token_Special(tokens, ',');
00653 
00654    if (TY_kind(WN_Tree_Type(WN_kid0(WN_kid(wn, 4)))) != KIND_SCALAR)
00655       set_WN2F_CONTEXT_deref_addr(context);
00656    WN2F_translate(tokens, WN_kid0(WN_kid(wn, 4)), context);
00657    Append_Token_Special(tokens, ')');
00658    
00659 } /* WN2F_ios_definefile */
00660 
00661 
00662 static void 
00663 WN2F_ios_delete(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00664 {
00665    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00666     * use the explicit UNIT keyword.
00667     */
00668    ASSERT_WARN(WN_IOSTMT(wn) == IOS_DELETE, 
00669          (DIAG_W2F_UNEXPECTED_IOS, 
00670     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_delete"));
00671    
00672    Append_Token_String(tokens, "DELETE");
00673    WN2F_Append_IO_CtrlList(tokens,
00674          wn,                 /* ios */
00675          0,                  /* from kid*/
00676          WN_kid_count(wn)-1, /* to kid*/
00677          TRUE,               /* use keyword control */
00678          context);
00679 } /* WN2F_ios_delete */
00680 
00681 
00682 static void 
00683 WN2F_ios_endfile(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00684 {
00685    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00686     * use the explicit UNIT keyword, unless there is exactly one kid an
00687     * it is an IOU.
00688     */
00689    ASSERT_WARN(WN_IOSTMT(wn) == IOS_ENDFILE || WN_IOSTMT(wn) == IOS_CR_ENDFILE, 
00690          (DIAG_W2F_UNEXPECTED_IOS, 
00691     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_endfile"));
00692    
00693    Append_Token_String(tokens, "ENDFILE");
00694    if (WN_kid_count(wn) == 1 && WN2F_IS_IOU(WN_kid0(wn)))
00695       (void)WN2F_io_item(tokens, WN_kid0(wn), context);
00696    else
00697       WN2F_Append_IO_CtrlList(tokens,
00698             wn,                 /* ios */
00699             0,                  /* from kid*/
00700             WN_kid_count(wn)-1, /* to kid*/
00701             TRUE,               /* use keyword control */
00702             context);
00703 
00704 } /* WN2F_ios_endfile */
00705 
00706 
00707 static void 
00708 WN2F_ios_find(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00709 {
00710    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00711     * use the explicit UNIT keyword.
00712     */
00713    ASSERT_WARN(WN_IOSTMT(wn) == IOS_FIND, 
00714          (DIAG_W2F_UNEXPECTED_IOS, 
00715     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_find"));
00716 
00717    Append_Token_String(tokens, "FIND");
00718    WN2F_Append_IO_CtrlList(tokens,
00719          wn,                 /* ios */
00720          0,                  /* from kid*/
00721          WN_kid_count(wn)-1, /* to kid*/
00722          TRUE,               /* use keyword control */
00723          context);
00724 } /* WN2F_ios_find */
00725 
00726 
00727 static void 
00728 WN2F_ios_inquire(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00729 {
00730    /* The kids should be an optional IOU, followed a sequence of IOCs.
00731     * Always use the explicit UNIT keyword when the IOU is present.
00732     */
00733    ASSERT_WARN(WN_IOSTMT(wn) == IOS_INQUIRE || WN_IOSTMT(wn) == IOS_CR_INQUIRE,
00734          (DIAG_W2F_UNEXPECTED_IOS, 
00735     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_inquire"));
00736 
00737    Append_Token_String(tokens, "INQUIRE");
00738    WN2F_Append_IO_CtrlList(tokens,
00739          wn,                 /* ios */
00740          0,                  /* from kid*/
00741          WN_kid_count(wn)-1, /* to kid*/
00742          TRUE,               /* use keyword control */
00743          context);
00744 } /* WN2F_ios_inquire */
00745 
00746 
00747 static void 
00748 WN2F_ios_namelist(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00749 {
00750    ASSERT_WARN(WN_IOSTMT(wn) == IOS_NAMELIST, 
00751          (DIAG_W2F_UNEXPECTED_IOS, 
00752     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_namelist"));
00753 
00754    Append_Token_String(tokens, "NAMELIST");
00755    Append_Token_Special(tokens, '/');
00756    (void)WN2F_io_item(tokens, WN_kid1(wn), context);
00757    Append_Token_Special(tokens, '/');
00758 
00759    if (WN_kid_count(wn) > 2)
00760       WN2F_Append_IO_List(tokens, wn, 2, context);
00761 
00762 } /* WN2F_ios_namelist */
00763 
00764 
00765 static void 
00766 WN2F_ios_open(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00767 {
00768    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00769     * use the explicit UNIT keyword.
00770     */
00771    ASSERT_WARN(WN_IOSTMT(wn) == IOS_OPEN || WN_IOSTMT(wn) == IOS_CR_OPEN, 
00772          (DIAG_W2F_UNEXPECTED_IOS, 
00773     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_open"));
00774 
00775    Append_Token_String(tokens, "OPEN");
00776    WN2F_Append_IO_CtrlList(tokens,
00777          wn,                 /* ios */
00778          0,                  /* from kid*/
00779          WN_kid_count(wn)-1, /* to kid*/
00780          TRUE,               /* use keyword control */
00781          context);
00782 } /* WN2F_ios_open */
00783 
00784 
00785 static void 
00786 WN2F_ios_rewind(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00787 {
00788    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00789     * use the explicit UNIT keyword, unless there is exactly one kid
00790     * and it is an IOU.
00791     */
00792    ASSERT_WARN(WN_IOSTMT(wn) == IOS_REWIND || WN_IOSTMT(wn) == IOS_CR_REWIND, 
00793          (DIAG_W2F_UNEXPECTED_IOS, 
00794     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_rewind"));
00795    
00796    Append_Token_String(tokens, "REWIND");
00797    if (WN_kid_count(wn) == 1 && WN2F_IS_IOU(WN_kid0(wn)))
00798       (void)WN2F_io_item(tokens, WN_kid0(wn), context);
00799    else
00800       WN2F_Append_IO_CtrlList(tokens,
00801             wn,                 /* ios */
00802             0,                  /* from kid*/
00803             WN_kid_count(wn)-1, /* to kid*/
00804             TRUE,               /* use keyword control */
00805             context);
00806 } /* WN2F_ios_rewind */
00807 
00808 
00809 static void 
00810 WN2F_ios_unlock(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00811 {
00812    /* The kids should be an IOU, followed a sequence of IOCs.  Always
00813     * use the explicit UNIT keyword, unless there is exactly one kid an
00814     * it is an IOU.
00815     */
00816    ASSERT_WARN(WN_IOSTMT(wn) == IOS_UNLOCK, 
00817          (DIAG_W2F_UNEXPECTED_IOS, 
00818     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_unlock"));
00819    
00820    Append_Token_String(tokens, "UNLOCK");
00821    if (WN_kid_count(wn) == 1 && WN2F_IS_IOU(WN_kid0(wn)))
00822       (void)WN2F_io_item(tokens, WN_kid0(wn), context);
00823    else
00824       WN2F_Append_IO_CtrlList(tokens,
00825             wn,                 /* ios */
00826             0,                  /* from kid*/
00827             WN_kid_count(wn)-1, /* to kid*/
00828             TRUE,               /* use keyword control */
00829             context);
00830 
00831 } /* WN2F_ios_unlock */
00832 
00833 
00834 static void 
00835 WN2F_ios_accept(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00836 {
00837    /* The kids should be an IOF, followed a sequence of IOLs.
00838     */
00839    ASSERT_WARN(WN_IOSTMT(wn) == IOS_ACCEPT, 
00840          (DIAG_W2F_UNEXPECTED_IOS, 
00841     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_accept"));
00842    
00843    Append_Token_String(tokens, "ACCEPT");
00844    (void)WN2F_io_item(tokens, WN_kid0(wn), context);
00845    if (WN_kid_count(wn) > 1)
00846    {
00847       Append_Token_Special(tokens, ',');
00848       WN2F_Append_IO_List(tokens, wn, 1, context);
00849    }
00850 } /* WN2F_ios_accept */
00851 
00852 
00853 static void
00854 WN2F_ios_decode(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00855 {
00856    /* The kids should be an IOU, followed by an IOF, followed by a
00857     * sequence of IOCs and a sequence of IOLs.  Use keywords only
00858     * when the IOC list is non-empty.  Note that the IOU contains
00859     * both the integer expression (c) and the scalar or array 
00860     * reference (a) in "ENCODE (c, f, a [,IOSTAT=ios][,ERR=s]) iolist".
00861     */
00862    INT  iol_kid;
00863    
00864    ASSERT_WARN(WN_IOSTMT(wn) == IOS_DECODE, 
00865          (DIAG_W2F_UNEXPECTED_IOS, 
00866     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_decode"));
00867    
00868    /* This is needed for the translation of the number of characters and
00869     * the buffer we decode characters from.
00870     */
00871    set_WN2F_CONTEXT_deref_addr(context);
00872 
00873    Append_Token_String(tokens, "DECODE");
00874    Append_Token_Special(tokens, '(');
00875 
00876    /* Translate the number of characters */
00877    ASSERT_WARN(WN_IOITEM(WN_kid0(wn)) == IOU_INTERNAL &&
00878          WN_kid_count(WN_kid0(wn)) >= 2,
00879          (DIAG_W2F_UNEXPECTED_IOU, 
00880     IOITEM_name(WN_IOITEM(WN_kid0(wn))), "WN2F_ios_decode"));
00881    WN2F_translate(tokens, WN_kid1(WN_kid0(wn)), context);
00882 
00883    /* Translate the format */
00884    Append_Token_Special(tokens, ',');
00885    (void)WN2F_io_item(tokens, WN_kid1(wn), context);
00886 
00887    /* Translate the buffer we decode from */
00888    Append_Token_Special(tokens, ',');
00889    WN2F_translate(tokens, WN_kid0(WN_kid0(wn)), context);
00890 
00891    /* Translate the EOSTAT and the ERR items */
00892    iol_kid = 2;
00893    if (WN_kid_count(wn) > 2 && WN2F_IS_IOC(WN_kid(wn, 2)))
00894    {
00895       iol_kid = 3;
00896       Append_Token_Special(tokens, ',');
00897       (void)WN2F_io_item(tokens, WN_kid(wn, 2), context);
00898    }
00899    if (WN_kid_count(wn) > 3 && WN2F_IS_IOC(WN_kid(wn, 3)))
00900    {
00901       iol_kid = 4;
00902       Append_Token_Special(tokens, ',');
00903       (void)WN2F_io_item(tokens, WN_kid(wn, 3), context);
00904    }
00905    Append_Token_Special(tokens, ')');
00906       
00907    /* Get the io_list */
00908    if (WN_kid_count(wn) > iol_kid)
00909       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
00910 
00911 } /* WN2F_ios_decode */
00912 
00913 
00914 static void 
00915 WN2F_ios_encode(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00916 {
00917    /* The kids should be an IOU, followed by an IOF, followed by a
00918     * sequence of IOCs and a sequence of IOLs.  Use keywords only
00919     * when the IOC list is non-empty.  Note that the IOU contains
00920     * both the integer expression (c) and the scalar or array 
00921     * reference (a) in "ENCODE (c, f, a [,IOSTAT=ios][,ERR=s]) iolist".
00922     */
00923    INT  iol_kid;
00924    
00925    ASSERT_WARN(WN_IOSTMT(wn) == IOS_ENCODE, 
00926          (DIAG_W2F_UNEXPECTED_IOS, 
00927     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_ENcode"));
00928    
00929    /* This is needed for the translation of the number of characters and
00930     * the buffer we encode characters from.
00931     */
00932    set_WN2F_CONTEXT_deref_addr(context);
00933 
00934    Append_Token_String(tokens, "ENCODE");
00935    Append_Token_Special(tokens, '(');
00936 
00937    /* Translate the number of characters */
00938    ASSERT_WARN(WN_IOITEM(WN_kid0(wn)) == IOU_INTERNAL &&
00939          WN_kid_count(WN_kid0(wn)) >= 2,
00940          (DIAG_W2F_UNEXPECTED_IOU, 
00941     IOITEM_name(WN_IOITEM(WN_kid0(wn))), "WN2F_ios_encode"));
00942    WN2F_translate(tokens, WN_kid1(WN_kid0(wn)), context);
00943 
00944    /* Translate the format */
00945    Append_Token_Special(tokens, ',');
00946    (void)WN2F_io_item(tokens, WN_kid1(wn), context);
00947 
00948    /* Translate the buffer we encode from */
00949    Append_Token_Special(tokens, ',');
00950    WN2F_translate(tokens, WN_kid0(WN_kid0(wn)), context);
00951 
00952    /* Translate the EOSTAT and the ERR items */
00953    iol_kid = 2;
00954    if (WN_kid_count(wn) > 2 && WN2F_IS_IOC(WN_kid(wn, 2)))
00955    {
00956       iol_kid = 3;
00957       Append_Token_Special(tokens, ',');
00958       (void)WN2F_io_item(tokens, WN_kid(wn, 2), context);
00959    }
00960    if (WN_kid_count(wn) > 3 && WN2F_IS_IOC(WN_kid(wn, 3)))
00961    {
00962       iol_kid = 4;
00963       Append_Token_Special(tokens, ',');
00964       (void)WN2F_io_item(tokens, WN_kid(wn, 3), context);
00965    }
00966    Append_Token_Special(tokens, ')');
00967       
00968    /* Get the io_list */
00969    if (WN_kid_count(wn) > iol_kid)
00970       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
00971 
00972 } /* WN2F_ios_encode */
00973 
00974 
00975 static void 
00976 WN2F_ios_print(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
00977 {
00978    INT iol_kid;
00979    
00980    /* The kids should be an IOF, followed a sequence of IOLs.
00981     */
00982    ASSERT_WARN(WN_IOSTMT(wn) == IOS_PRINT, 
00983          (DIAG_W2F_UNEXPECTED_IOS, 
00984     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_print"));
00985    
00986    Append_Token_String(tokens, "PRINT");
00987 
00988    /* We do not really expect to have a unit specification for a "PRINT"
00989     * statement, but just in the case one occurs anyway, we skip it here.
00990     */
00991    if (WN2F_IS_IOU(WN_kid0(wn)))
00992       iol_kid = 2; /* kid 1 must be the format */
00993    else
00994       iol_kid = 1; /* Missing unit number */
00995    (void)WN2F_io_item(tokens, WN_kid(wn, iol_kid-1), context);
00996    if (WN_kid_count(wn) > iol_kid)
00997    {
00998       Append_Token_Special(tokens, ',');
00999       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
01000    }
01001 } /* WN2F_ios_print */
01002 
01003 
01004 static void 
01005 WN2F_ios_read(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01006 {
01007    /* The kids should be an IOU, followed by an IOF, followed by a
01008     * sequence of IOCs and a sequence of IOLs.  Use keywords only
01009     * when the IOC list is non-empty.  The IOL should be a sequence
01010     * of addresses into which the values read should be put.  In
01011     * the whirl2f output these addresses must be dereferenced.
01012     */
01013    INT  iol_kid;
01014    BOOL use_keyword;
01015    
01016    ASSERT_WARN(WN_IOSTMT(wn) == IOS_READ, 
01017          (DIAG_W2F_UNEXPECTED_IOS, 
01018     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_read"));
01019    
01020    Append_Token_String(tokens, "READ");
01021 
01022    /* Determine whether or not we have the "READ f [,iolist]" format.
01023     */
01024    if (WN_IOITEM(WN_kid0(wn)) == IOU_DEFAULT           && 
01025        WN2F_IS_IOF(WN_kid1(wn))                         &&
01026        WN_IOITEM(WN_kid1(wn)) != IOF_NAMELIST_DIRECTED &&
01027        (WN_kid_count(wn) == 2 || WN2F_IS_IOL(WN_kid(wn, 2))))
01028    {
01029       (void)WN2F_io_item(tokens, WN_kid0(wn), context);
01030       iol_kid = 2;
01031       if (WN_kid_count(wn) > 2)
01032    Append_Token_Special(tokens, ',');
01033    }
01034    else
01035    {
01036       /* Determine if we should use the "unit=" or "fmt=" keyword notation,
01037        * and which kid is the last control specification item.
01038        */
01039       use_keyword = (WN_kid_count(wn) > 2       &&
01040          WN2F_IS_IOF(WN_kid(wn, 1)) &&
01041          WN2F_IS_IOC(WN_kid(wn, 2)));
01042       for (iol_kid = 0; 
01043      (iol_kid < WN_kid_count(wn)) && !WN2F_IS_IOL(WN_kid(wn, iol_kid));
01044      iol_kid++);
01045    
01046       /* Get the IOU, IOF, and IOC items */
01047       WN2F_Append_IO_CtrlList(tokens,
01048             wn,          /* ios */
01049             0,           /* from kid*/
01050             iol_kid-1,   /* to kid*/
01051             use_keyword, /* use keyword control */
01052             context);
01053    }
01054       
01055    /* Get the io_list */
01056    if (iol_kid < WN_kid_count(wn))
01057    {
01058       set_WN2F_CONTEXT_deref_io_item(context); /* Assume pass-by-reference */
01059       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
01060    }
01061 } /* WN2F_ios_read */
01062 
01063 
01064 static void 
01065 WN2F_ios_rewrite(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01066 {
01067    /* The kids should be an IOU, followed by an IOF, followed by a
01068     * sequence of IOCs and a sequence of IOLs.  Use keywords only
01069     * when the IOC list is non-empty.
01070     */
01071    INT  iol_kid;
01072    BOOL use_keyword;
01073    
01074    ASSERT_WARN(WN_IOSTMT(wn) == IOS_REWRITE, 
01075          (DIAG_W2F_UNEXPECTED_IOS, 
01076     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_rewrite"));
01077    
01078    Append_Token_String(tokens, "REWRITE");
01079 
01080    /* Determine if we should use the "unit=" or "fmt=" keyword notation,
01081     * and which kid is the last control specification itemx.
01082     */
01083    use_keyword = (WN_kid_count(wn) > 2 &&
01084       WN2F_IS_IOF(WN_kid(wn, 1)) &&
01085       WN2F_IS_IOC(WN_kid(wn, 2)));
01086    for (iol_kid = 0; 
01087   (iol_kid < WN_kid_count(wn)) && !WN2F_IS_IOL(WN_kid(wn, iol_kid));
01088   iol_kid++);
01089    
01090    /* Get the IOU, IOF, and IOC items */
01091    WN2F_Append_IO_CtrlList(tokens,
01092          wn,          /* ios */
01093          0,           /* from kid*/
01094          iol_kid-1,     /* to kid*/
01095          use_keyword, /* use keyword control */
01096          context);
01097    
01098    /* Get the io_list */
01099    if (iol_kid < WN_kid_count(wn))
01100       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
01101 
01102 } /* WN2F_ios_rewrite */
01103 
01104 
01105 static void 
01106 WN2F_ios_type(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01107 {
01108    /* The kids should be an IOF, followed a sequence of IOLs.
01109     */
01110    ASSERT_WARN(WN_IOSTMT(wn) == IOS_TYPE, 
01111          (DIAG_W2F_UNEXPECTED_IOS, 
01112     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_type"));
01113    
01114    Append_Token_String(tokens, "TYPE");
01115    (void)WN2F_io_item(tokens, WN_kid0(wn), context);
01116    if (WN_kid_count(wn) > 1)
01117    {
01118       Append_Token_Special(tokens, ',');
01119       WN2F_Append_IO_List(tokens, wn, 1, context);
01120    }
01121 } /* WN2F_ios_type */
01122 
01123 
01124 static void 
01125 WN2F_ios_write(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01126 {
01127    /* The kids should be an IOU, followed by an IOF, followed by a
01128     * sequence of IOCs and a sequence of IOLs.  Use keywords only
01129     * when the IOC list is non-empty.
01130     */
01131    INT  iol_kid;
01132    BOOL use_keyword;
01133    
01134    ASSERT_WARN(WN_IOSTMT(wn) == IOS_WRITE, 
01135          (DIAG_W2F_UNEXPECTED_IOS, 
01136     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_write"));
01137    
01138    Append_Token_String(tokens, "WRITE");
01139 
01140    /* Determine if we should use the "unit=" or "fmt=" keyword notation,
01141     * and which kid is the last control specification item.
01142     */
01143    use_keyword = (WN_kid_count(wn) > 2 &&
01144       WN2F_IS_IOF(WN_kid(wn, 1)) &&
01145       WN2F_IS_IOC(WN_kid(wn, 2)));
01146    for (iol_kid = 0; 
01147   (iol_kid < WN_kid_count(wn)) && !WN2F_IS_IOL(WN_kid(wn, iol_kid));
01148   iol_kid++);
01149    
01150    /* Get the IOU, IOF, and IOC items */
01151    WN2F_Append_IO_CtrlList(tokens,
01152          wn,          /* ios */
01153          0,           /* from kid */
01154          iol_kid-1,   /* to kid */
01155          use_keyword, /* use keyword control */
01156          context);
01157    
01158    /* Get the io_list */
01159    if (iol_kid < WN_kid_count(wn))
01160       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
01161 
01162 } /* WN2F_ios_write */
01163 
01164 
01165 /*------------------------- Cray Library routines ---------------------*/
01166 /*---------------------------------------------------------------------*/
01167 
01168 static void 
01169 WN2F_ios_cr(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01170 {
01171    /* Craylibs IO - write/read The kids should be an IOS, with kids of IO_ITEMS */
01172 
01173    INT  iol_kid;
01174    const char * p ;
01175 
01176    ASSERT_WARN(WN_IOSTMT(wn) == IOS_CR_FWF || 
01177          WN_IOSTMT(wn) == IOS_CR_FWU || 
01178                WN_IOSTMT(wn) == IOS_CR_FRF || 
01179          WN_IOSTMT(wn) == IOS_CR_FRU,
01180          (DIAG_W2F_UNEXPECTED_IOS, 
01181     IOSTATEMENT_name(WN_IOSTMT(wn)), "WN2F_ios_cr"));
01182 
01183    /* See if this is the first/last part of a 3-call IO stmt. If so punt */
01184    /* - it just duplicates some detail from the main stmt.               */
01185 
01186    for (iol_kid = 0; iol_kid < WN_kid_count(wn); iol_kid++)
01187    {
01188      WN * item = WN_kid(wn,iol_kid);
01189      if (WN_io_item(item) == IOC_CR_FLFLAG)
01190      {
01191        INT32 i = (WN_const_val(WN_kid0(item)) & 3);
01192        if (i != 0 && i != 3)
01193    return;
01194        else
01195    break;
01196      }
01197    }
01198 
01199    /* decide if read/write formatted/unformatted */
01200 
01201    if (WN_IOSTMT(wn) == IOS_CR_FWF || WN_IOSTMT(wn) == IOS_CR_FRF)
01202      set_WN2F_CONTEXT_fmt_io(context) ;
01203 
01204    if (WN_IOSTMT(wn) == IOS_CR_FRF || WN_IOSTMT(wn) == IOS_CR_FRU)
01205      p = "READ" ;
01206    else 
01207      p = "WRITE";
01208 
01209    Append_Token_String(tokens,p);
01210 
01211 
01212    /* count items in control list */
01213 
01214    for (iol_kid = 0; 
01215   (iol_kid < WN_kid_count(wn)) && !WN2F_IS_IOL(WN_kid(wn, iol_kid));
01216   iol_kid++);
01217    
01218    /* Get the IOU, IOF, and IOC items */
01219 
01220    WN2F_Append_IO_CtrlList(tokens,
01221          wn,          /* ios */
01222          0,           /* from kid */
01223          iol_kid-1,   /* to kid */
01224          FALSE,       /* use keyword control */
01225          context);
01226    
01227    /* Get the io_list */
01228 
01229    if (iol_kid < WN_kid_count(wn))
01230       WN2F_Append_IO_List(tokens, wn, iol_kid, context);
01231 
01232 } /* WN2F_ios_cr */
01233 
01234 /*------------------------- Exported routines -------------------------*/
01235 /*---------------------------------------------------------------------*/
01236 
01237 void WN2F_Io_initialize(void)
01238 {
01239    Ios_Handler[IOS_BACKSPACE] = &WN2F_ios_backspace;
01240    Ios_Handler[IOS_CLOSE] = &WN2F_ios_close;
01241    Ios_Handler[IOS_DEFINEFILE] = &WN2F_ios_definefile;
01242    Ios_Handler[IOS_DELETE] = &WN2F_ios_delete;
01243    Ios_Handler[IOS_ENDFILE] = &WN2F_ios_endfile;
01244    Ios_Handler[IOS_FIND] = &WN2F_ios_find;
01245    Ios_Handler[IOS_INQUIRE] = &WN2F_ios_inquire;
01246    Ios_Handler[IOS_NAMELIST] = &WN2F_ios_namelist;
01247    Ios_Handler[IOS_OPEN] = &WN2F_ios_open;
01248    Ios_Handler[IOS_REWIND] = &WN2F_ios_rewind;
01249    Ios_Handler[IOS_UNLOCK] = &WN2F_ios_unlock;
01250    Ios_Handler[IOS_ACCEPT] = &WN2F_ios_accept;
01251    Ios_Handler[IOS_DECODE] = &WN2F_ios_decode;
01252    Ios_Handler[IOS_ENCODE] = &WN2F_ios_encode;
01253    Ios_Handler[IOS_PRINT] = &WN2F_ios_print;
01254    Ios_Handler[IOS_READ] = &WN2F_ios_read;
01255    Ios_Handler[IOS_REWRITE] = &WN2F_ios_rewrite;
01256    Ios_Handler[IOS_TYPE] = &WN2F_ios_type;
01257    Ios_Handler[IOS_WRITE] = &WN2F_ios_write;
01258    Ios_Handler[IOS_CR_FWF]   = &WN2F_ios_cr;
01259    Ios_Handler[IOS_CR_FWU]   = &WN2F_ios_cr;
01260    Ios_Handler[IOS_CR_FRF]   = &WN2F_ios_cr;
01261    Ios_Handler[IOS_CR_FRU]   = &WN2F_ios_cr;
01262    Ios_Handler[IOS_CR_OPEN]  = &WN2F_ios_open;
01263    Ios_Handler[IOS_CR_CLOSE] = &WN2F_ios_close;
01264    Ios_Handler[IOS_CR_REWIND] = &WN2F_ios_rewind;
01265    Ios_Handler[IOS_CR_INQUIRE] = &WN2F_ios_inquire;
01266    Ios_Handler[IOS_CR_ENDFILE] = &WN2F_ios_endfile;
01267    Ios_Handler[IOS_CR_BACKSPACE] = &WN2F_ios_backspace;
01268 
01269 
01270 
01271 } /* WN2F_Io_initialize */
01272 
01273 void WN2F_Io_finalize(void)
01274 {
01275    /* Do nothing for now! */
01276 } /* WN2F_Io_finalize */
01277 
01278 static BOOL
01279 Is_Cray_IO(IOSTATEMENT ios)
01280 {
01281   BOOL res ;
01282  
01283   res = (ios == IOS_CR_FWF) ||
01284         (ios == IOS_CR_FWU) ||
01285         (ios == IOS_CR_FRF) ||
01286         (ios == IOS_CR_FRU) ||
01287         (ios == IOS_CR_OPEN) ||
01288         (ios == IOS_CR_CLOSE) ||
01289         (ios == IOS_CR_REWIND) ||
01290         (ios == IOS_CR_INQUIRE) ||
01291         (ios == IOS_CR_ENDFILE) ||
01292         (ios == IOS_CR_BACKSPACE);
01293 
01294   return res ;
01295 }
01296 
01297 TOKEN_BUFFER
01298 WN2F_io_prefix_tokens(void)
01299 {
01300    return Ios_Prefix_Tokens;
01301 }
01302 
01303 WN2F_STATUS 
01304 WN2F_io(TOKEN_BUFFER tokens, WN *wn, WN2F_CONTEXT context)
01305 {
01306    INT          ios_kid;
01307    TOKEN_BUFFER ios_tokens = New_Token_Buffer();
01308 
01309    ASSERT_DBG_FATAL(WN_opc_operator(wn) == OPR_IO, 
01310         (DIAG_W2F_UNEXPECTED_OPC, "WN2F_io"));
01311    
01312    /* Should we use the string given by an IOC_VARFMT_ORIGFMT
01313     * for a IOF_LABEL?
01314     */
01315    for (ios_kid = 0; 
01316   (ios_kid < WN_kid_count(wn) &&
01317    WN_io_item(WN_kid(wn, ios_kid)) != IOC_VARFMT_ORIGFMT); 
01318   ios_kid++);
01319    if (ios_kid < WN_kid_count(wn))
01320    {
01321       set_WN2F_CONTEXT_origfmt_ioctrl(context);
01322       Origfmt_Ioctrl_Label = W2CF_Symtab_Unique_Label();
01323    }
01324 
01325    /* Now dispatch to the appropriate handler routine for each
01326     * kind of IO statement, after beginning the statement on a
01327     * new line and setting the appropriate context flags.
01328     */
01329    WN2F_Stmt_Newline(tokens, NULL/*label*/, WN_linenum(wn), context);
01330    set_WN2F_CONTEXT_io_stmt(context);
01331    set_WN2F_CONTEXT_no_newline(context);
01332    Ios_Prefix_Tokens = New_Token_Buffer();
01333 
01334    const IOSTATEMENT ios = WN_IOSTMT(wn);
01335 
01336    if (Is_Cray_IO(ios)) 
01337      set_WN2F_CONTEXT_cray_io(context) ;             
01338 
01339    if (Ios_Handler[ios] == NULL)
01340    {
01341       Append_Token_String(ios_tokens, "<<FLIST cannot handle ");
01342       Append_Token_String(ios_tokens, 
01343         get_iostatement_name(ios));
01344       Append_Token_String(ios_tokens, " io statement>>");
01345    }
01346    else
01347    {
01348       Ios_Handler[ios](ios_tokens, wn, context);
01349    }
01350 
01351    if (Ios_Prefix_Tokens != NULL)
01352       Append_And_Reclaim_Token_List(tokens, &Ios_Prefix_Tokens);
01353    Append_And_Reclaim_Token_List(tokens, &ios_tokens);
01354    if (Format_Stmts != NULL)
01355       Append_And_Reclaim_Token_List(tokens, &Format_Stmts);
01356    
01357    reset_WN2F_CONTEXT_cray_io(context) ;             
01358 
01359    return EMPTY_WN2F_STATUS;
01360 } /* WN2F_io */
01361 
01362 
01363 BOOL
01364 WN2F_io_item(TOKEN_BUFFER tokens, WN *item, WN2F_CONTEXT context)
01365 {
01366    /* Returns TRUE when something (anything) was emitted for this item.
01367     */
01368    BOOL emitted = FALSE;
01369 
01370    /* Any pointer-argument to an io-item should be dereferenced.  Most
01371     * notably, this applies for an LDA of a character string in a FMT
01372     * specifier, but it also applies for a variety of other arguments.
01373     * Such dereferences are specified within the WN2F_io routines.
01374     */
01375    if (WN2F_CONTEXT_deref_io_item(context))
01376       set_WN2F_CONTEXT_deref_addr(context);
01377    else
01378       reset_WN2F_CONTEXT_deref_addr(context);
01379 
01380    if (WN2F_IS_IOU(item))
01381       emitted = WN2F_io_unit(tokens, item, context);
01382    else if (WN2F_IS_IOF(item))
01383       emitted = WN2F_io_format(tokens, item, context);
01384    else if (WN2F_IS_IOC(item))
01385       emitted = WN2F_io_control(tokens, item, context);
01386    else if (WN2F_IS_IOL(item))
01387       emitted = WN2F_io_list(tokens, item, context);
01388    else
01389       ASSERT_DBG_WARN(FALSE, 
01390           (DIAG_W2F_UNEXPECTED_IOL, 
01391            (IOITEM_name(WN_IOITEM(item)) != NULL? 
01392       IOITEM_name(WN_IOITEM(item)):"unknown_name"), 
01393            "WN2F_io_item"));
01394 
01395    return emitted;
01396 } /* WN2F_io_item */
01397 
01398 
01399 
01400 
01401 
01402 
01403
osprey/be/whirl2f/wn2f_io.cxx
