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 #ifndef FMT_INCLUDED
00040 #define FMT_INCLUDED
00041
00042 #include "cmplrs/host.h"
00043 #include <stdlib.h>
00044
00045 #define RET 1
00046 #define REVERT 2
00047 #define GOTO 3
00048 #define X 4
00049 #define SLASH 5
00050 #define STACK 6
00051 #define I 7
00052 #define ED 8
00053 #define NED 9
00054 #define IM 10
00055 #define APOS 11
00056 #define H 12
00057 #define TL 13
00058 #define TR 14
00059 #define T 15
00060 #define COLON 16
00061 #define S 17
00062 #define SP 18
00063 #define SS 19
00064 #define P 20
00065 #define BN 21
00066 #define BZ 22
00067 #define F 23
00068 #define E 24
00069 #define EE 25
00070 #define D 26
00071 #define G 27
00072 #define GE 28
00073 #define L 29
00074 #define A 30
00075 #define AW 31
00076 #define O 32
00077 #define OM 33
00078 #define Z 34
00079 #define ZM 35
00080 #define NONL 36
00081 #define Q 37
00082
00083 #ifdef I90
00084 #define EN 38
00085 #define ENE 39
00086 #define ES 40
00087 #define ESE 41
00088 #define B 42
00089 #define BM 43
00090 #endif
00091
00092
00093
00094
00095
00096 extern int pars_f(unit *, char *);
00097 extern int ne_d(unit *, char *, char **);
00098 extern int e_d(unit *, char *, char **);
00099 extern int op_gen(unit *, int, long, long, int);
00100 extern int en_fio(unit **);
00101 extern int do_fio(ftnint *, ftnint *, char *, ftnlen);
00102 extern int do_fio_1dim(ftnint *, char *, flex *, ftnint *,ftnint *, ftnint *, ftnlen, ftnlen);
00103 extern int do_fio_mp(ftnint *, ftnint *, char *, unit **, ftnlen);
00104 #ifdef I90
00105 extern int test_type(int op, ftnint type);
00106 #endif
00107 extern void fmt_bg(unit *);
00108 extern char *ap_end(unit *, char *);
00109
00110 extern int do_fioi4(unsigned int);
00111 extern int do_fioi8(long long);
00112 extern int do_fior4(float);
00113 extern int do_fio8(double);
00114 extern int do_f4f8(void *, ftnlen);
00115 extern int do_fioi4_mp(unsigned int, unit *);
00116 extern int do_fioi8_mp(long long, unit *);
00117 extern int do_fior4_mp(float, unit *);
00118 extern int do_fio8_mp(double, unit *);
00119 extern int do_f4f8_mp(ftnint *, void *, unit *, ftnlen);
00120
00121 extern int do_fioxa4 (char *, XINT);
00122 extern int do_fioxa8 (char *, XINT);
00123 extern int do_fioxh1 (char *, XINT, XINT);
00124 extern int do_fioxi1 (char *, XINT);
00125 extern int do_fioxi2 (char *, XINT);
00126 extern int do_fioxi4 (char *, XINT);
00127 extern int do_fioxi8 (char *, XINT);
00128 extern int do_fioxl1 (char *, XINT);
00129 extern int do_fioxl2 (char *, XINT);
00130 extern int do_fioxl4 (char *, XINT);
00131 extern int do_fioxl8 (char *, XINT);
00132 extern int do_fioxr4 (char *, XINT);
00133 extern int do_fioxr8 (char *, XINT);
00134 extern int do_fioxr16 (char *, XINT);
00135 extern int do_fioxc4 (char *, XINT);
00136 extern int do_fioxc8 (char *, XINT);
00137 extern int do_fioxc16 (char *, XINT);
00138 extern int do_fioxa4v (ftnint);
00139 extern int do_fioxa8v (ftnll);
00140 extern int do_fioxh1v (char);
00141 extern int do_fioxi1v (char);
00142 extern int do_fioxi2v (short);
00143 extern int do_fioxi4v (ftnint);
00144 extern int do_fioxi8v (ftnll);
00145 extern int do_fioxl1v (char);
00146 extern int do_fioxl2v (short);
00147 extern int do_fioxl4v (ftnint);
00148 extern int do_fioxl8v (ftnll);
00149 extern int do_fioxr4v (float);
00150 extern int do_fioxr8v (double);
00151 extern int do_fioxr16v (long double);
00152 extern int do_fioxc4v (float, float);
00153 extern int do_fioxc8v (double, double);
00154 extern int do_fioxc16v (long double, long double);
00155 extern int do_fioxa4_mp (char *, XINT, unit **);
00156 extern int do_fioxa8_mp (char *, XINT, unit **);
00157 extern int do_fioxh1_mp (char *, XINT, XINT, unit **);
00158 extern int do_fioxi1_mp (char *, XINT, unit **);
00159 extern int do_fioxi2_mp (char *, XINT, unit **);
00160 extern int do_fioxi4_mp (char *, XINT, unit **);
00161 extern int do_fioxi8_mp (char *, XINT, unit **);
00162 extern int do_fioxl1_mp (char *, XINT, unit **);
00163 extern int do_fioxl2_mp (char *, XINT, unit **);
00164 extern int do_fioxl4_mp (char *, XINT, unit **);
00165 extern int do_fioxl8_mp (char *, XINT, unit **);
00166 extern int do_fioxr4_mp (char *, XINT, unit **);
00167 extern int do_fioxr8_mp (char *, XINT, unit **);
00168 extern int do_fioxr16_mp (char *, XINT, unit **);
00169 extern int do_fioxc4_mp (char *, XINT, unit **);
00170 extern int do_fioxc8_mp (char *, XINT, unit **);
00171 extern int do_fioxc16_mp (char *, XINT, unit **);
00172 extern int do_fioxa4v_mp (ftnint, unit **);
00173 extern int do_fioxa8v_mp (ftnll, unit **);
00174 extern int do_fioxh1v_mp (char, unit **);
00175 extern int do_fioxi1v_mp (char, unit **);
00176 extern int do_fioxi2v_mp (short, unit **);
00177 extern int do_fioxi4v_mp (ftnint, unit **);
00178 extern int do_fioxi8v_mp (ftnll, unit **);
00179 extern int do_fioxl1v_mp (char, unit **);
00180 extern int do_fioxl2v_mp (short, unit **);
00181 extern int do_fioxl4v_mp (ftnint, unit **);
00182 extern int do_fioxl8v_mp (ftnll, unit **);
00183 extern int do_fioxr4v_mp (float, unit **);
00184 extern int do_fioxr8v_mp (double, unit **);
00185 extern int do_fioxr16v_mp (long double, unit **);
00186 extern int do_fioxc4v_mp (float, float, unit **);
00187 extern int do_fioxc8v_mp (double, double, unit **);
00188 extern int do_fioxc16v_mp (long double, long double, unit **);
00189
00190 #if 11
00191 extern int do_fio64(ftnint *, XINT *, char *, ftnlen);
00192 extern int do_fio64_1dim(ftnint *, char *, flex *, XINT *,XINT *, XINT *, ftnlen, ftnlen);
00193 extern int do_fio64_mp_1dim( ftnint *type, char *ptr,
00194 flex *do_idx, XINT *lb,
00195 XINT *ub, XINT *step,
00196 unit **fu,
00197 ftnlen len, ftnlen idxlen);
00198 extern int do_fio64_mp(ftnint *, XINT *, char *, unit **, ftnlen);
00199 #define do_fio_SIZE_mp do_fio64_mp
00200 #else
00201 #define do_fio_SIZE_mp do_fio_mp
00202 #endif
00203
00204
00205
00206 #define FIO_ALLOC 8*1024
00207 typedef union
00208 { float pf;
00209 double pd;
00210 long double pld;
00211 } ufloat;
00212 typedef union
00213 { short is;
00214 signed char ic;
00215 int ii;
00216 #if defined(_LONGLONG)
00217 long long ill;
00218 #else
00219 long ill;
00220 #endif
00221 } uinteger;
00222 #define GET(x) if((x=(*ftnunit->f77getn)(ftnunit))<0) return(x)
00223 #define VAL(x) (x!='\n'?x:' ')
00224 #define PUT(c,y,s) (*ftnunit->f77putn)(ftnunit, c,y,s)
00225 #define UNGETC(x) ((*ftnunit->f77ungetn)(ftnunit, x))
00226 #define GETC(x) (x=(*ftnunit->f77getn)(ftnunit))
00227 #define GETS(s,w,c) ((*ftnunit->f77gets)(ftnunit,s,w,c))
00228
00229
00230
00231
00232
00233
00234
00235
00236 #define TYUNKNOWN 0
00237 #define TYADDR 1
00238 #define TYBYTE 2
00239 #define TYSHORT 3
00240 #define TYINT 4
00241 #define TYLONGLONG 5
00242 #define TYREAL 6
00243 #define TYDREAL 7
00244 #define TYCOMPLEX 8
00245 #define TYDCOMPLEX 9
00246 #define TYLOGICAL1 10
00247 #define TYLOGICAL2 11
00248 #define TYLOGICAL4 12
00249 #define TYLOGICAL8 13
00250 #define TYCHAR 14
00251 #define TYSUBR 15
00252 #define TYSTRUCTURE 16
00253 #define TYNML 17
00254 #define TYQUAD 18
00255 #define TYQUADCOMPLEX 19
00256 #define TYQUADLONG 20
00257 #define TYERROR 21
00258
00259 #define NTYPES (TYERROR+1)
00260
00261
00262
00263
00264
00265 #define OLD_TYUNKNOWN 0
00266 #define OLD_TYADDR 1
00267 #define OLD_TYBYTE 2
00268 #define OLD_TYSHORT 3
00269 #define OLD_TYINT 4
00270 #define OLD_TYREAL 5
00271 #define OLD_TYDREAL 6
00272 #define OLD_TYCOMPLEX 7
00273 #define OLD_TYDCOMPLEX 8
00274 #define OLD_TYLOGICAL1 9
00275 #define OLD_TYLOGICAL2 10
00276 #define OLD_TYLOGICAL4 11
00277 #define OLD_TYCHAR 12
00278 #define OLD_TYSUBR 13
00279 #define OLD_TYSTRUCTURE 14
00280 #define OLD_TYNML 15
00281 #define OLD_TYQUAD 16
00282 #define OLD_TYERROR 17
00283
00284 extern ftnint match_type[];
00285
00286 #endif