00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044 #include <stdio.h>
00045 #include <stdlib.h>
00046 #include <cmplrs/rcodes.h>
00047
00048 #define TRUE 1
00049 #define FALSE 0
00050
00051 #include "defs.h"
00052 #include "wintrinsic.h"
00053 #include "wio.h"
00054 #include "wutil.h"
00055
00056
00057 static const struct {
00058 INTRINSIC opcode;
00059 const char *name;
00060 } intrinsic_name_table [] = {
00061
00062 INTRINSIC_NONE, "NONE",
00063
00064
00065 #define NEED_INTRN_ID_NAME
00066 # include "intrn_entry.def"
00067 #undef NEED_INTRN_ID_NAME
00068
00069 INTRINSIC_LAST, "INTRINSIC_LAST",
00070 };
00071
00072
00073 struct iostatement_name_table_t {
00074 IOSTATEMENT opcode;
00075 char * name;
00076 };
00077
00078 struct iostatement_name_table_t iostatement_name_table [] = {
00079 (IOSTATEMENT) 0, NULL,
00080 IOS_BACKSPACE, "BACKSPACE",
00081 IOS_CLOSE, "CLOSE",
00082 IOS_DEFINEFILE, "DEFINEFILE",
00083 IOS_DELETE, "DELETE",
00084 IOS_ENDFILE, "ENDFILE",
00085 IOS_FIND, "FIND",
00086 IOS_INQUIRE, "INQUIRE",
00087 IOS_NAMELIST, "NAMELIST",
00088 IOS_OPEN, "OPEN",
00089 IOS_REWIND, "REWIND",
00090 IOS_UNLOCK, "UNLOCK",
00091 IOS_ACCEPT, "ACCEPT",
00092 IOS_DECODE, "DECODE",
00093 IOS_ENCODE, "ENCODE",
00094 IOS_PRINT, "PRINT",
00095 IOS_READ, "READ",
00096 IOS_REWRITE, "REWRITE",
00097 IOS_TYPE, "TYPE",
00098 IOS_WRITE, "WRITE",
00099 IOS_CR_FWU, "UNFORMATTED_WRITE",
00100 IOS_CR_FRU, "UNFORMATTED_READ",
00101 IOS_CR_FWF, "FORMATTED_WRITE",
00102 IOS_CR_FRF, "FORMATTED_READ",
00103 IOS_CR_FWN, "NAMELIST_WRITE",
00104 IOS_CR_FRN, "NAMELIST_READ",
00105 IOS_INQLENGTH, "INQUIRE_LENGTH",
00106 IOS_CR_OPEN, "OPEN",
00107 IOS_CR_CLOSE, "CLOSE",
00108 IOS_CR_ENDFILE, "ENDFILE",
00109 IOS_CR_REWIND, "REWIND",
00110 IOS_CR_INQUIRE, "INQUIRE",
00111 IOS_CR_BACKSPACE, "BACKSPACE",
00112 IOS_CR_BUFFERIN, "BUFFERIN",
00113 IOS_CR_BUFFEROUT, "BUFFEROUT"
00114 };
00115
00116 struct ioitem_name_table_t {
00117 IOITEM opcode;
00118 char * name;
00119 };
00120
00121 struct ioitem_name_table_t ioitem_name_table [] = {
00122 (IOITEM) 0, NULL,
00123 IOU_NONE, "NONE",
00124 IOU_DEFAULT, "DEFAULT",
00125 IOU_EXTERNAL, "EXTERNAL",
00126 IOU_INTERNAL, "INTERNAL",
00127 IOU_DOPE, "DOPE",
00128 (IOITEM) 6, NULL,
00129 (IOITEM) 7, NULL,
00130 (IOITEM) 8, NULL,
00131 (IOITEM) 9, NULL,
00132 IOF_NONE, "NONE",
00133 IOF_ASSIGNED_VAR, "ASSIGNED_VAR",
00134 IOF_CHAR_EXPR, "CHAR_EXPR",
00135 IOF_LABEL, "LABEL",
00136 IOF_LIST_DIRECTED, "LIST_DIRECTED",
00137 IOF_NAMELIST_DIRECTED,"NAMELIST_DIRECTED",
00138 IOF_UNFORMATTED, "UNFORMATTED",
00139 IOF_CR_PARSFMT, "PREPARSED_FORMAT",
00140 IOF_CR_FMTSRC, "FORMAT_SOURCE",
00141 IOF_CR_FMTSRC_DOPE, "FORMAT_SOURCE_DOPE",
00142 (IOITEM) 20, NULL,
00143 (IOITEM) 21, NULL,
00144 (IOITEM) 22, NULL,
00145 (IOITEM) 23, NULL,
00146 (IOITEM) 24, NULL,
00147 IOC_ACCESS, "ACCESS",
00148 IOC_ASSOCIATEVARIABLE,"ASSOCIATEVARIABLE",
00149 IOC_BLANK, "BLANK",
00150 IOC_CARRIAGECONTROL, "CARRIAGECONTROL",
00151 IOC_DEFAULTFILE, "DEFAULTFILE",
00152 IOC_DIRECT, "DIRECT",
00153 IOC_DISPOSE, "DISPOSE",
00154 IOC_END, "END",
00155 IOC_ERR, "ERR",
00156 IOC_EXIST, "EXIST",
00157 IOC_FILE, "FILE",
00158 IOC_FORM, "FORM",
00159 IOC_FORMATTED, "FORMATTED",
00160 IOC_IOSTAT, "IOSTAT",
00161 IOC_KEY, "KEY",
00162 IOC_KEYEQ, "KEYEQ",
00163 IOC_KEYGE, "KEYGE",
00164 IOC_KEYGT, "KEYGT",
00165 IOC_KEY_START, "KEY_START",
00166 IOC_KEY_END, "KEY_END",
00167 IOC_KEY_CHARACTER, "KEY_CHARACTER",
00168 IOC_KEY_INTEGER, "KEY_INTEGER",
00169 IOC_KEYED, "KEYED",
00170 IOC_KEYID, "KEYID",
00171 IOC_MAXREC, "MAXREC",
00172 IOC_NAME, "NAME",
00173 IOC_NAMED, "NAMED",
00174 IOC_NEXTREC, "NEXTREC",
00175 IOC_NML, "NML",
00176 IOC_NUMBER, "NUMBER",
00177 IOC_OPENED, "OPENED",
00178 IOC_ORGANIZATION, "ORGANIZATION",
00179 IOC_READONLY, "READONLY",
00180 IOC_REC, "REC",
00181 IOC_RECCOUNT, "RECCOUNT",
00182 IOC_RECL, "RECL",
00183 IOC_RECORDTYPE, "RECORDTYPE",
00184 IOC_SEQUENTIAL, "SEQUENTIAL",
00185 IOC_SHARED, "SHARED",
00186 IOC_STATUS, "STATUS",
00187 IOC_TYPE, "TYPE",
00188 IOC_U, "U",
00189 IOC_UNFORMATTED, "UNFORMATTED",
00190 IOC_VARFMT, "VARFMT",
00191 IOC_VARFMT_ORIGFMT, "VARFMT_ORIGFMT",
00192 IOC_CR_EEEFLAG, "END_EOR_EOF_FLAG",
00193 IOC_ADVANCE, "ADVANCE",
00194 IOC_SIZE, "SIZE",
00195 IOC_CR_FLFLAG, "FIRST_LAST_FLAG",
00196 IOC_EOR, "EOR",
00197 IOC_INQLENGTH_VAR, "INQLENGTH_VAR",
00198 IOC_CR_EDFLAG, "ENCODE_DECODE_FLAG",
00199 IOC_PAD, "PAD",
00200 IOC_DELIM, "DELIM",
00201 IOC_ACTION, "ACTION",
00202 IOC_POSITION, "POSITION",
00203 IOC_READWRITE, "READWRITE",
00204 IOC_WRITE, "WRITE",
00205 IOC_READ, "READ",
00206 IOC_ERRFLAG, "ERRFLAG",
00207 (IOITEM) 85, NULL,
00208 (IOITEM) 86, NULL,
00209 (IOITEM) 87, NULL,
00210 (IOITEM) 88, NULL,
00211 (IOITEM) 89, NULL,
00212 (IOITEM) 90, NULL,
00213 (IOITEM) 91, NULL,
00214 (IOITEM) 92, NULL,
00215 (IOITEM) 93, NULL,
00216 (IOITEM) 94, NULL,
00217 IOL_ARRAY, "ARRAY",
00218 IOL_CHAR, "CHAR",
00219 IOL_CHAR_ARRAY, "CHAR_ARRAY",
00220 IOL_EXPR, "EXPR",
00221 IOL_IMPLIED_DO, "IMPLIED_DO",
00222 IOL_IMPLIED_DO_1TRIP, "IMPLIED_DO_1TRIP",
00223 IOL_LOGICAL, "LOGICAL",
00224 IOL_RECORD, "RECORD",
00225 IOL_VAR, "VAR",
00226 IOL_DOPE, "DOPE",
00227 (IOITEM) 105, NULL,
00228 (IOITEM) 106, NULL,
00229 (IOITEM) 107, NULL,
00230 (IOITEM) 108, NULL,
00231 (IOITEM) 109, NULL,
00232 (IOITEM) 110, NULL,
00233 (IOITEM) 111, NULL,
00234 (IOITEM) 112, NULL,
00235 (IOITEM) 113, NULL,
00236 (IOITEM) 114, NULL,
00237 };
00238
00239
00240
00241 const char *
00242 get_intrinsic_name ( INTRINSIC opcode )
00243 {
00244 static INT32 init_intrinsic = FALSE;
00245
00246 if ( ! init_intrinsic ) {
00247 init_intrinsic = TRUE;
00248
00249 for (INT opc = INTRINSIC_FIRST; opc <= INTRINSIC_LAST; opc++ ) {
00250 if ( opc != intrinsic_name_table [opc].opcode ) {
00251 printf ( "get_intrinsic_name : %d %d %s\n", opc,
00252 intrinsic_name_table [opc].opcode,
00253 intrinsic_name_table [opc].name );
00254 printf ( "intrinsic names out of sync\n" );
00255 exit (RC_INTERNAL_ERROR);
00256 }
00257 }
00258 }
00259
00260 return intrinsic_name_table [opcode].name;
00261 }
00262
00263
00264 const char *
00265 get_iostatement_name ( IOSTATEMENT opcode )
00266 {
00267 static INT32 init_iostatement = FALSE;
00268
00269 if ( ! init_iostatement ) {
00270 init_iostatement = TRUE;
00271
00272 for (INT opc = IOSTATEMENT_FIRST; opc <= IOSTATEMENT_LAST; opc++ ) {
00273 if ( opc != iostatement_name_table [opc].opcode ) {
00274 printf ( "get_iostatement_name : %d %d %s\n", opc,
00275 iostatement_name_table [opc].opcode,
00276 iostatement_name_table [opc].name );
00277 printf ( "iostatement names out of sync\n" );
00278 exit (RC_INTERNAL_ERROR);
00279 }
00280 }
00281 }
00282
00283 return iostatement_name_table [opcode].name;
00284 }
00285
00286 const char *
00287 get_ioitem_name ( IOITEM opcode )
00288 {
00289 static INT32 init_ioitem = FALSE;
00290
00291 if ( ! init_ioitem ) {
00292 init_ioitem = TRUE;
00293
00294 for (INT opc = IOITEM_FIRST; opc <= IOITEM_LAST; opc++ ) {
00295 if ( opc != ioitem_name_table [opc].opcode ) {
00296 printf ( "get_ioitem_name : %d %d %s\n", opc,
00297 ioitem_name_table [opc].opcode,
00298 ioitem_name_table [opc].name );
00299 printf ( "ioitem names out of sync\n" );
00300 exit (RC_INTERNAL_ERROR);
00301 }
00302 }
00303 }
00304
00305 return ioitem_name_table [opcode].name;
00306 }
00307
00308 const char *
00309 get_iolibrary_name( IOLIB lib)
00310 {
00311 switch (lib) {
00312 case IOLIB_UNSPECIFIED:
00313 return ("unspec");
00314 case IOLIB_MIPS:
00315 return ("mips");
00316 case IOLIB_CRAY:
00317 return ("cray");
00318 default:
00319 return ("unknown");
00320 }
00321 }
