Scilab [trunk]: scilab/libs/f2c/libf2c/lio.h File Reference

00656 {
00657 #define Ptr ((flex *)ptr)
00658         int i,n,ch;
00659         doublereal *yy;
00660         real *xx;
00661         for(i=0;i<*number;i++)
00662         {
00663                 if(f__lquit) return(0);
00664                 if(l_eof)
00665                         err(f__elist->ciend, EOF, "list in")
00666                 if(f__lcount == 0) {
00667                         f__ltype = 0;
00668                         for(;;)  {
00669                                 GETC(ch);
00670                                 switch(ch) {
00671                                 case EOF:
00672                                         err(f__elist->ciend,(EOF),"list in")
00673                                 case ' ':
00674                                 case '\t':
00675                                 case '\n':
00676                                         continue;
00677                                 case '/':
00678                                         f__lquit = 1;
00679                                         goto loopend;
00680                                 case ',':
00681                                         f__lcount = 1;
00682                                         goto loopend;
00683                                 default:
00684                                         (void) Ungetc(ch, f__cf);
00685                                         goto rddata;
00686                                 }
00687                         }
00688                 }
00689         rddata:
00690                 switch((int)type)
00691                 {
00692                 case TYINT1:
00693                 case TYSHORT:
00694                 case TYLONG:
00695 #ifndef ALLOW_FLOAT_IN_INTEGER_LIST_INPUT
00696                         ERR(l_R(0,1));
00697                         break;
00698 #endif
00699                 case TYREAL:
00700                 case TYDREAL:
00701                         ERR(l_R(0,0));
00702                         break;
00703 #ifdef TYQUAD
00704                 case TYQUAD:
00705                         n = l_R(0,2);
00706                         if (n)
00707                                 return n;
00708                         break;
00709 #endif
00710                 case TYCOMPLEX:
00711                 case TYDCOMPLEX:
00712                         ERR(l_C());
00713                         break;
00714                 case TYLOGICAL1:
00715                 case TYLOGICAL2:
00716                 case TYLOGICAL:
00717                         ERR(l_L());
00718                         break;
00719                 case TYCHAR:
00720                         ERR(l_CHAR());
00721                         break;
00722                 }
00723         while (GETC(ch) == ' ' || ch == '\t');
00724         if (ch != ',' || f__lcount > 1)
00725                 Ungetc(ch,f__cf);
00726         loopend:
00727                 if(f__lquit) return(0);
00728                 if(f__cf && ferror(f__cf)) {
00729                         clearerr(f__cf);
00730                         errfl(f__elist->cierr,errno,"list in");
00731                         }
00732                 if(f__ltype==0) goto bump;
00733                 switch((int)type)
00734                 {
00735                 case TYINT1:
00736                 case TYLOGICAL1:
00737                         Ptr->flchar = (char)f__lx;
00738                         break;
00739                 case TYLOGICAL2:
00740                 case TYSHORT:
00741                         Ptr->flshort = (short)f__lx;
00742                         break;
00743                 case TYLOGICAL:
00744                 case TYLONG:
00745                         Ptr->flint = (ftnint)f__lx;
00746                         break;
00747 #ifdef Allow_TYQUAD
00748                 case TYQUAD:
00749                         if (!(Ptr->fllongint = f__llx))
00750                                 Ptr->fllongint = f__lx;
00751                         break;
00752 #endif
00753                 case TYREAL:
00754                         Ptr->flreal=(real)(f__lx);
00755                         break;
00756                 case TYDREAL:
00757                         Ptr->fldouble=f__lx;
00758                         break;
00759                 case TYCOMPLEX:
00760                         xx=(real *)ptr;
00761                         *xx++ = (real)f__lx;
00762                         *xx = (real)f__ly;
00763                         break;
00764                 case TYDCOMPLEX:
00765                         yy=(doublereal *)ptr;
00766                         *yy++ = f__lx;
00767                         *yy = f__ly;
00768                         break;
00769                 case TYCHAR:
00770                         b_char(f__lchar,ptr,len);
00771                         break;
00772                 }
00773         bump:
00774                 if(f__lcount>0) f__lcount--;
00775                 ptr += len;
00776                 if (nml_read)
00777                         nml_read++;
00778         }
00779         return(0);
00780 #undef Ptr
00781 }

Here is the caller graph for this function:

int l_write	(	ftnint *	,
		char *	,
		ftnlen	,
		ftnint
	)

Definition at line 246 of file lwrite.c.

References f__fatal(), i, longint, lwrt_A(), lwrt_C(), lwrt_F(), lwrt_I(), lwrt_L(), Ptr, TYCHAR, TYCOMPLEX, TYDCOMPLEX, TYDREAL, TYINT1, TYLOGICAL, TYLOGICAL1, TYLOGICAL2, TYLONG, TYQUAD, TYREAL, TYSHORT, x, y, and z.

Referenced by s_wsle(), s_wsli(), and x_wsne().

00248 {
00249 #define Ptr ((flex *)ptr)
00250         int i;
00251         longint x;
00252         double y,z;
00253         real *xx;
00254         doublereal *yy;
00255         for(i=0;i< *number; i++)
00256         {
00257                 switch((int)type)
00258                 {
00259                 default: f__fatal(117,"unknown type in lio");
00260                 case TYINT1:
00261                         x = Ptr->flchar;
00262                         goto xint;
00263                 case TYSHORT:
00264                         x=Ptr->flshort;
00265                         goto xint;
00266 #ifdef Allow_TYQUAD
00267                 case TYQUAD:
00268                         x = Ptr->fllongint;
00269                         goto xint;
00270 #endif
00271                 case TYLONG:
00272                         x=Ptr->flint;
00273                 xint:   lwrt_I(x);
00274                         break;
00275                 case TYREAL:
00276                         y=Ptr->flreal;
00277                         goto xfloat;
00278                 case TYDREAL:
00279                         y=Ptr->fldouble;
00280                 xfloat: lwrt_F(y);
00281                         break;
00282                 case TYCOMPLEX:
00283                         xx= &Ptr->flreal;
00284                         y = *xx++;
00285                         z = *xx;
00286                         goto xcomplex;
00287                 case TYDCOMPLEX:
00288                         yy = &Ptr->fldouble;
00289                         y= *yy++;
00290                         z = *yy;
00291                 xcomplex:
00292                         lwrt_C(y,z);
00293                         break;
00294                 case TYLOGICAL1:
00295                         x = Ptr->flchar;
00296                         goto xlog;
00297                 case TYLOGICAL2:
00298                         x = Ptr->flshort;
00299                         goto xlog;
00300                 case TYLOGICAL:
00301                         x = Ptr->flint;
00302                 xlog:   lwrt_L(Ptr->flint, len);
00303                         break;
00304                 case TYCHAR:
00305                         lwrt_A(ptr,len);
00306                         break;
00307                 }
00308                 ptr += len;
00309         }
00310         return(0);
00311 }

Here is the call graph for this function:

Here is the caller graph for this function:

integer s_wsne ( cilist * )

Definition at line 12 of file wsne.c.

References a, c_le(), e_wsle(), err, errno, f__curunit, f__donewrec, f__external, f__formatted, f__nowwriting(), f__putn, f__reading, L_len, LINE, n, unit::uwrt, x_putc(), x_wSL, and x_wsne().

Referenced by print_ne().

00014 {
00015         int n;
00016 
00017         if(n=c_le(a))
00018                 return(n);
00019         f__reading=0;
00020         f__external=1;
00021         f__formatted=1;
00022         f__putn = x_putc;
00023         L_len = LINE;
00024         f__donewrec = x_wSL;
00025         if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
00026                 err(a->cierr, errno, "namelist output start");
00027         x_wsne(a);
00028         return e_wsle();
00029         }

Here is the call graph for this function:

Here is the caller graph for this function:

void x_wsne ( cilist * )

Definition at line 24 of file xwsne.c.

References a, dims, f__Aquote, f__recpos, f__typesize, L_len, l_write(), nl, nl_donewrec(), number, PUT, s, size, TYCHAR, type, and v.

Referenced by s_wsne(), and s_wsni().

00026 {
00027         Namelist *nl;
00028         char *s;
00029         Vardesc *v, **vd, **vde;
00030         ftnint number, type;
00031         ftnlen *dims;
00032         ftnlen size;
00033         extern ftnlen f__typesize[];
00034 
00035         nl = (Namelist *)a->cifmt;
00036         PUT('&');
00037         for(s = nl->name; *s; s++)
00038                 PUT(*s);
00039         PUT(' ');
00040         f__Aquote = 1;
00041         vd = nl->vars;
00042         vde = vd + nl->nvars;
00043         while(vd < vde) {
00044                 v = *vd++;
00045                 s = v->name;
00046 #ifdef No_Extra_Namelist_Newlines
00047                 if (f__recpos+strlen(s)+2 >= L_len)
00048 #endif
00049                         nl_donewrec();
00050                 while(*s)
00051                         PUT(*s++);
00052                 PUT(' ');
00053                 PUT('=');
00054                 number = (dims = v->dims) ? dims[1] : 1;
00055                 type = v->type;
00056                 if (type < 0) {
00057                         size = -type;
00058                         type = TYCHAR;
00059                         }
00060                 else
00061                         size = f__typesize[type];
00062                 l_write(&number, v->addr, size, type);
00063                 if (vd < vde) {
00064                         if (f__recpos+2 >= L_len)
00065                                 nl_donewrec();
00066                         PUT(',');
00067                         PUT(' ');
00068                         }
00069                 else if (f__recpos+1 >= L_len)
00070                         nl_donewrec();
00071                 }
00072         f__Aquote = 0;
00073         PUT('/');
00074         }

Here is the call graph for this function:

Here is the caller graph for this function:

int z_rnew ( void )

int(*) f__lioproc(ftnint *, char *, ftnlen, ftnint)

int f__scale

Definition at line 46 of file err.c.

Referenced by c_dfe(), c_le(), c_si(), do_fio(), rd_F(), s_rsfe(), s_wsfe(), wrt_E(), wrt_F(), and wrt_G().

int(* l_getc)(void)

Referenced by c_lir(), Lfinish(), nmL_getc(), s_rsle(), and s_rsne().

ftnint L_len

Definition at line 9 of file lwrite.c.

Referenced by c_lir(), c_liw(), s_wsle(), s_wsne(), and x_wsne().

int(*)(*) l_ungetc(int, FILE *)

Definition at line 66 of file lio.h.

Referenced by c_lir(), Lfinish(), nmL_getc(), s_rsle(), and s_rsne().

lio.h File Reference

Data Structures

Defines

Functions

Variables

Define Documentation

Function Documentation

Variable Documentation


Data Structures
union	flex
Defines
#define	TYUNKNOWN 0
#define	TYADDR 1
#define	TYSHORT 2
#define	TYLONG 3
#define	TYREAL 4
#define	TYDREAL 5
#define	TYCOMPLEX 6
#define	TYDCOMPLEX 7
#define	TYLOGICAL 8
#define	TYCHAR 9
#define	TYSUBR 10
#define	TYINT1 11
#define	TYLOGICAL1 12
#define	TYLOGICAL2 13
#define	LINTW 24
#define	LINE 80
#define	LLOGW 2
#define	LGFMT "%.9G"
#define	LEFBL 24
Functions
int	l_write (ftnint , char , ftnlen, ftnint)
void	x_wsne (cilist *)
int	c_le (cilist *)
int	l_read (ftnint , char , ftnlen, ftnint)
integer	e_rsle (void)
integer	e_wsle (void)
integer	s_wsne (cilist *)
int	z_rnew (void)
Variables
int	f__scale
int(*)	f__lioproc (ftnint , char , ftnlen, ftnint)
int(*	l_getc )(void)
int()()	l_ungetc (int, FILE *)
ftnint	L_len