scilab » libs » f2c » libf2c

lwrite.c File Reference

#include "f2c.h"
#include "fio.h"
#include "fmt.h"
#include "lio.h"

Include dependency graph for lwrite.c:

Go to the source code of this file.

Defines

#define Ptr   ((flex *)ptr)

Functions

static VOID donewrec (Void)
static VOID lwrt_I (longint n)
static VOID lwrt_L (ftnint n, ftnlen len)
static VOID lwrt_A (char *p, ftnlen len)
static int l_g (char *buf, double n)
static VOID l_put (register char *s)
static VOID lwrt_F (double n)
static VOID lwrt_C (double a, double b)
int l_write (ftnint *number, char *ptr, ftnlen len, ftnint type)

Variables

ftnint L_len
int f__Aquote

Define Documentation

#define Ptr   ((flex *)ptr)

Function Documentation

static VOID donewrec ( Void   )  [static]

Definition at line 13 of file lwrite.c.

References f__recpos.

Referenced by lwrt_A(), lwrt_C(), lwrt_F(), lwrt_I(), and lwrt_L().

00014 {
00015         if (f__recpos)
00016                 (*f__donewrec)();
00017         }

Here is the caller graph for this function:

static int l_g ( char *  buf,
double  n 
) [static]

Definition at line 98 of file lwrite.c.

References b, c1, f__ret, fmt, LGFMT, and signbit_f2c().

Referenced by lwrt_C(), and lwrt_F().

00100 {
00101 #ifdef Old_list_output
00102         doublereal absn;
00103         char *fmt;
00104 
00105         absn = n;
00106         if (absn < 0)
00107                 absn = -absn;
00108         fmt = LLOW <= absn && absn < LHIGH ? LFFMT : LEFMT;
00109 #ifdef USE_STRLEN
00110         sprintf(buf, fmt, n);
00111         return strlen(buf);
00112 #else
00113         return sprintf(buf, fmt, n);
00114 #endif
00115 
00116 #else
00117         register char *b, c, c1;
00118 
00119         b = buf;
00120         *b++ = ' ';
00121         if (n < 0) {
00122                 *b++ = '-';
00123                 n = -n;
00124                 }
00125         else
00126                 *b++ = ' ';
00127         if (n == 0) {
00128 #ifdef SIGNED_ZEROS
00129                 if (signbit_f2c(&n))
00130                         *b++ = '-';
00131 #endif
00132                 *b++ = '0';
00133                 *b++ = '.';
00134                 *b = 0;
00135                 goto f__ret;
00136                 }
00137         sprintf(b, LGFMT, n);
00138         switch(*b) {
00139 #ifndef WANT_LEAD_0
00140                 case '0':
00141                         while(b[0] = b[1])
00142                                 b++;
00143                         break;
00144 #endif
00145                 case 'i':
00146                 case 'I':
00147                         /* Infinity */
00148                 case 'n':
00149                 case 'N':
00150                         /* NaN */
00151                         while(*++b);
00152                         break;
00153 
00154                 default:
00155         /* Fortran 77 insists on having a decimal point... */
00156                     for(;; b++)
00157                         switch(*b) {
00158                         case 0:
00159                                 *b++ = '.';
00160                                 *b = 0;
00161                                 goto f__ret;
00162                         case '.':
00163                                 while(*++b);
00164                                 goto f__ret;
00165                         case 'E':
00166                                 for(c1 = '.', c = 'E';  *b = c1;
00167                                         c1 = c, c = *++b);
00168                                 goto f__ret;
00169                         }
00170                 }
00171  f__ret:
00172         return b - buf;
00173 #endif
00174         }

Here is the call graph for this function:

Here is the caller graph for this function:

static VOID l_put ( register char *  s  )  [static]

Definition at line 180 of file lwrite.c.

References f__putn, int, and void().

Referenced by lwrt_C(), and lwrt_F().

00182 {
00183 #ifdef KR_headers
00184         register void (*pn)() = f__putn;
00185 #else
00186         register void (*pn)(int) = f__putn;
00187 #endif
00188         register int c;
00189 
00190         while(c = *s++)
00191                 (*pn)(c);
00192         }

Here is the call graph for this function:

Here is the caller graph for this function:

int l_write ( ftnint *  number,
char *  ptr,
ftnlen  len,
ftnint  type 
)

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:

static VOID lwrt_A ( char *  p,
ftnlen  len 
) [static]

Definition at line 53 of file lwrite.c.

References a, donewrec(), f__recpos, and PUT.

Referenced by l_write().

00055 {
00056         int a;
00057         char *p1, *pe;
00058 
00059         a = 0;
00060         pe = p + len;
00061         if (f__Aquote) {
00062                 a = 3;
00063                 if (len > 1 && p[len-1] == ' ') {
00064                         while(--len > 1 && p[len-1] == ' ');
00065                         pe = p + len;
00066                         }
00067                 p1 = p;
00068                 while(p1 < pe)
00069                         if (*p1++ == '\'')
00070                                 a++;
00071                 }
00072         if(f__recpos+len+a >= L_len)
00073                 donewrec();
00074         if (a
00075 #ifndef OMIT_BLANK_CC
00076                 || !f__recpos
00077 #endif
00078                 )
00079                 PUT(' ');
00080         if (a) {
00081                 PUT('\'');
00082                 while(p < pe) {
00083                         if (*p == '\'')
00084                                 PUT('\'');
00085                         PUT(*p++);
00086                         }
00087                 PUT('\'');
00088                 }
00089         else
00090                 while(p < pe)
00091                         PUT(*p++);
00092 }

Here is the call graph for this function:

Here is the caller graph for this function:

static VOID lwrt_C ( double  a,
double  b 
) [static]

Definition at line 211 of file lwrite.c.

References bb, donewrec(), f__recpos, l_g(), l_put(), LEFBL, and PUT.

Referenced by l_write().

00213 {
00214         char *ba, *bb, bufa[LEFBL], bufb[LEFBL];
00215         int al, bl;
00216 
00217         al = l_g(bufa, a);
00218         for(ba = bufa; *ba == ' '; ba++)
00219                 --al;
00220         bl = l_g(bufb, b) + 1;  /* intentionally high by 1 */
00221         for(bb = bufb; *bb == ' '; bb++)
00222                 --bl;
00223         if(f__recpos + al + bl + 3 >= L_len)
00224                 donewrec();
00225 #ifdef OMIT_BLANK_CC
00226         else
00227 #endif
00228         PUT(' ');
00229         PUT('(');
00230         l_put(ba);
00231         PUT(',');
00232         if (f__recpos + bl >= L_len) {
00233                 (*f__donewrec)();
00234 #ifndef OMIT_BLANK_CC
00235                 PUT(' ');
00236 #endif
00237                 }
00238         l_put(bb);
00239         PUT(')');
00240 }

Here is the call graph for this function:

Here is the caller graph for this function:

static VOID lwrt_F ( double  n  )  [static]

Definition at line 198 of file lwrite.c.

References donewrec(), f__recpos, l_g(), l_put(), and LEFBL.

Referenced by l_write().

00200 {
00201         char buf[LEFBL];
00202 
00203         if(f__recpos + l_g(buf,n) >= L_len)
00204                 donewrec();
00205         l_put(buf);
00206 }

Here is the call graph for this function:

Here is the caller graph for this function:

static VOID lwrt_I ( longint  n  )  [static]

Definition at line 23 of file lwrite.c.

References donewrec(), f__icvt(), f__recpos, ndigit, p, PUT, and sign.

Referenced by l_write().

00025 {
00026         char *p;
00027         int ndigit, sign;
00028 
00029         p = f__icvt(n, &ndigit, &sign, 10);
00030         if(f__recpos + ndigit >= L_len)
00031                 donewrec();
00032         PUT(' ');
00033         if (sign)
00034                 PUT('-');
00035         while(*p)
00036                 PUT(*p++);
00037 }

Here is the call graph for this function:

Here is the caller graph for this function:

static VOID lwrt_L ( ftnint  n,
ftnlen  len 
) [static]

Definition at line 42 of file lwrite.c.

References donewrec(), f__recpos, LLOGW, and wrt_L().

Referenced by l_write().

00044 {
00045         if(f__recpos+LLOGW>=L_len)
00046                 donewrec();
00047         wrt_L((Uint *)&n,LLOGW, len);
00048 }

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

int f__Aquote

Definition at line 10 of file lwrite.c.

Referenced by x_wsne().

ftnint L_len

Definition at line 9 of file lwrite.c.

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

Generated on Sun Mar 4 15:04:57 2007 for Scilab [trunk] by  doxygen 1.5.1