Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
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.1 of the GNU Lesser General Public License 00007 as 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 Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 00038 #pragma ident "@(#) libf/fio/parse.c 92.2 06/21/99 10:37:21" 00039 #include <liberrno.h> 00040 #include <memory.h> 00041 #include <cray/format.h> 00042 #include <cray/mtlock.h> 00043 #include "fio.h" 00044 00045 /* 00046 * _parse Parse a Fortran format; called during initialization 00047 * of a formatted I/O statement. 00048 * 00049 * Parameters: 00050 * 00051 * css Pointer Fortran I/O statement state. 00052 * cup Pointer to unit table. 00053 * prsfmt Pointer to pointer to the preparsed format. 00054 * 00055 * Returns: 00056 * library error number, or zero if no error. 00057 * 00058 * Calls: 00059 * _fmt_parse() 00060 */ 00061 00062 int 00063 _parse ( 00064 FIOSPTR css, /* Pointer to I/O statement state */ 00065 unit *cup, /* Pointer to unit table */ 00066 fmt_type **prsfmt /* Pointer to pointer to parsed fmt. */ 00067 ) 00068 { 00069 char *fptr; /* Pointer to format */ 00070 int errn; /* Error indicator */ 00071 long flen; /* Length of format */ 00072 fmt_type *pfmt; /* Pointer to parsed format */ 00073 00074 errn = 0; 00075 fptr = css->u.fmt.u.fe.fmtbuf; 00076 flen = css->u.fmt.u.fe.fmtlen; 00077 00078 PARSELOCK(); /* Lock parsing */ 00079 00080 /* 00081 * If the format is a variable format, or if it has not yet 00082 * been parsed, or if it was parsed by an incompatible version 00083 * of the format parser, then parse it. 00084 */ 00085 00086 if (prsfmt == NULL || *prsfmt == NULL || 00087 (**prsfmt).offset != PARSER_LEVEL) { /* If not parsed */ 00088 00089 msg_type fmt_info; 00090 00091 pfmt = _fmt_parse(NULL, fptr, LIB_CALL, &flen, &fmt_info); 00092 00093 if (pfmt == (fmt_type *) NULL) { /* If error */ 00094 00095 /* 00096 * The following statement will map a format parser 00097 * error into one of the following errors: 00098 * 00099 * FEFMTELP Expecting left parenthesis 00100 * FEFMTERP Expecting right parenthesis 00101 * FEFMTEIN Expecting integer 00102 * FEFMTEPE Expecting period 00103 * FEFMTEPX Expecting P or X 00104 * FEFMTIRP Invalid repetition count 00105 * FEFMTZRP Zero repetition count 00106 * FEFMTZFW Zero field width 00107 * FEFMTFTL Field too large 00108 * FEFMTZMH Zero or missing hollerith count 00109 * FEFMTIED Invalid edit descriptor 00110 * FEFMTNLS Nonterminated literal string 00111 * FEFMTMEM Unable to allocate memory 00112 */ 00113 00114 #define OFFSET (FEFMTBAS - FIRST_FATAL_MESSAGE) 00115 00116 #if FEFMTELP != (OFFSET + EXPECTING_LEFT_PAREN) 00117 #error Error message alignment problem (FEFMTELP) 00118 #endif 00119 00120 #if FEFMTERP != (OFFSET + EXPECTING_RIGHT_PAREN) 00121 #error Error message alignment problem (FEFMTERP) 00122 #endif 00123 00124 #if FEFMTEIN != (OFFSET + EXPECTING_INTEGER) 00125 #error Error message alignment problem (FEFMTEIN) 00126 #endif 00127 00128 #if FEFMTEPE != (OFFSET + EXPECTING_PERIOD) 00129 #error Error message alignment problem (FEFMTEPE) 00130 #endif 00131 00132 #if FEFMTEPX != (OFFSET + EXPECTING_P_OR_X) 00133 #error Error message alignment problem (FEFMTEPX) 00134 #endif 00135 00136 #if FEFMTIRP != (OFFSET + INVALID_REP_COUNT) 00137 #error Error message alignment problem (FEFMTIRP) 00138 #endif 00139 00140 #if FEFMTZRP != (OFFSET + ZERO_REP_COUNT) 00141 #error Error message alignment problem (FEFMTZRP) 00142 #endif 00143 00144 #if FEFMTZFW != (OFFSET + FIELD_WIDTH_ZERO) 00145 #error Error message alignment problem (FEFMTZFW) 00146 #endif 00147 00148 #if FEFMTFTL != (OFFSET + FIELD_TOO_LARGE) 00149 #error Error message alignment problem (FEFMTFTL) 00150 #endif 00151 00152 #if FEFMTZMH != (OFFSET + ZERO_OR_NO_HOLLERITH_CNT) 00153 #error Error message alignment problem (FEFMTZMH) 00154 #endif 00155 00156 #if FEFMTIED != (OFFSET + UNKNOWN_EDIT_DESCRIPTOR) 00157 #error Error message alignment problem (FEFMTIED) 00158 #endif 00159 00160 #if FEFMTNLS != (OFFSET + NONTERMINATED_LITERAL) 00161 #error Error message alignment problem (FEFMTNLS) 00162 #endif 00163 00164 #if FEFMTMEM != (OFFSET + UNABLE_TO_MALLOC_MEMORY) 00165 #error Error message alignment problem (FEFMTMEM) 00166 #endif 00167 00168 errn = fmt_info.msg_number + OFFSET; 00169 00170 css->u.fmt.u.fe.fmtcol = fmt_info.msg_column; 00171 } 00172 else { 00173 css->u.fmt.u.fe.pfmt = pfmt; 00174 00175 if (prsfmt == NULL) /* If variable format */ 00176 css->u.fmt.freepfmt = 1; /* Dealloc flag */ 00177 else /* Else constant format */ 00178 *prsfmt = pfmt; 00179 } 00180 } 00181 else /* if format was already parsed */ 00182 css->u.fmt.u.fe.pfmt = *prsfmt; 00183 00184 PARSEUNLOCK(); 00185 00186 return (errn); 00187 }