io.c File Reference

#include "defs.h"
#include "names.h"
#include "iob.h"

Include dependency graph for io.c:

Go to the source code of this file.

Data Structures

struct  Ioclist

Defines

#define TYIOINT   TYLONG
#define SZIOINT   SZLONG
#define UNFORMATTED   0
#define FORMATTED   1
#define LISTDIRECTED   2
#define NAMEDIRECTED   3
#define V(z)   ioc[z].iocval
#define IOALL   07777
#define NIOS   (sizeof(ioc)/sizeof(struct Ioclist) - 1)
#define IOSERR   3
#define IOSEND   4
#define IOSIOSTAT   5
#define IOSREC   6
#define IOSRECL   7
#define IOSFILE   8
#define IOSSTATUS   9
#define IOSACCESS   10
#define IOSFORM   11
#define IOSBLANK   12
#define IOSEXISTS   13
#define IOSOPENED   14
#define IOSNUMBER   15
#define IOSNAMED   16
#define IOSNAME   17
#define IOSSEQUENTIAL   18
#define IOSDIRECT   19
#define IOSFORMATTED   20
#define IOSUNFORMATTED   21
#define IOSNEXTREC   22
#define IOSNML   23
#define IOSTP   V(IOSIOSTAT)
#define SZFLAG   SZIOINT
#define XERR   0
#define XUNIT   SZFLAG
#define XEND   SZFLAG + SZIOINT
#define XFMT   2*SZFLAG + SZIOINT
#define XREC   2*SZFLAG + SZIOINT + SZADDR
#define XIUNIT   SZFLAG
#define XIEND   SZFLAG + SZADDR
#define XIFMT   2*SZFLAG + SZADDR
#define XIRLEN   2*SZFLAG + 2*SZADDR
#define XIRNUM   2*SZFLAG + 2*SZADDR + SZIOINT
#define XIREC   2*SZFLAG + 2*SZADDR + 2*SZIOINT
#define XFNAME   SZFLAG + SZIOINT
#define XFNAMELEN   SZFLAG + SZIOINT + SZADDR
#define XSTATUS   SZFLAG + 2*SZIOINT + SZADDR
#define XACCESS   SZFLAG + 2*SZIOINT + 2*SZADDR
#define XFORMATTED   SZFLAG + 2*SZIOINT + 3*SZADDR
#define XRECLEN   SZFLAG + 2*SZIOINT + 4*SZADDR
#define XBLANK   SZFLAG + 3*SZIOINT + 4*SZADDR
#define XCLSTATUS   SZFLAG + SZIOINT
#define XFILE   SZFLAG + SZIOINT
#define XFILELEN   SZFLAG + SZIOINT + SZADDR
#define XEXISTS   SZFLAG + 2*SZIOINT + SZADDR
#define XOPEN   SZFLAG + 2*SZIOINT + 2*SZADDR
#define XNUMBER   SZFLAG + 2*SZIOINT + 3*SZADDR
#define XNAMED   SZFLAG + 2*SZIOINT + 4*SZADDR
#define XNAME   SZFLAG + 2*SZIOINT + 5*SZADDR
#define XNAMELEN   SZFLAG + 2*SZIOINT + 6*SZADDR
#define XQACCESS   SZFLAG + 3*SZIOINT + 6*SZADDR
#define XQACCLEN   SZFLAG + 3*SZIOINT + 7*SZADDR
#define XSEQ   SZFLAG + 4*SZIOINT + 7*SZADDR
#define XSEQLEN   SZFLAG + 4*SZIOINT + 8*SZADDR
#define XDIRECT   SZFLAG + 5*SZIOINT + 8*SZADDR
#define XDIRLEN   SZFLAG + 5*SZIOINT + 9*SZADDR
#define XFORM   SZFLAG + 6*SZIOINT + 9*SZADDR
#define XFORMLEN   SZFLAG + 6*SZIOINT + 10*SZADDR
#define XFMTED   SZFLAG + 7*SZIOINT + 10*SZADDR
#define XFMTEDLEN   SZFLAG + 7*SZIOINT + 11*SZADDR
#define XUNFMT   SZFLAG + 8*SZIOINT + 11*SZADDR
#define XUNFMTLEN   SZFLAG + 8*SZIOINT + 12*SZADDR
#define XQRECL   SZFLAG + 9*SZIOINT + 12*SZADDR
#define XNEXTREC   SZFLAG + 9*SZIOINT + 13*SZADDR
#define XQBLANK   SZFLAG + 9*SZIOINT + 14*SZADDR
#define XQBLANKLEN   SZFLAG + 9*SZIOINT + 15*SZADDR
#define zork(n, t)   n, sizeof(n)/sizeof(char *) - 1, t

Functions

static void dofclose Argdcl ((void))
static void dofmove Argdcl ((char *))
static void doiolist Argdcl ((chainp))
static void ioset Argdcl ((int, int, expptr))
static void ioseta Argdcl ((int, Addrp))
static void iosetc Argdcl ((int, expptr))
static void iosetip Argdcl ((int, int))
static void iosetlc Argdcl ((int, int, int))
static void putio Argdcl ((expptr, expptr))
static void putiocall Argdcl ((expptr))
int fmtstmt (register struct Labelblock *lp)
void setfmt (struct Labelblock *lp)
void startioctl ()
static long newiolabel (Void)
void endioctl (Void)
int iocname (Void)
void ioclause (register int n, register expptr p)
void doio (chainp list)
LOCAL void doiolist (chainp p0)
LOCAL void putio (expptr nelt, register expptr addr)
void endio (Void)
LOCAL void putiocall (register expptr q)
void fmtname (Namep np, register Addrp q)
LOCAL Addrp asg_addr (union Expression *p)
void startrw (Void)
LOCAL void dofopen (Void)
LOCAL void dofclose (Void)
LOCAL void dofinquire (Void)
LOCAL void dofmove (char *subname)
LOCAL void ioset (int type, int offset, register expptr p)
LOCAL void iosetc (int offset, register expptr p)
LOCAL void ioseta (int offset, register Addrp p)
LOCAL void iosetip (int i, int offset)
LOCAL void iosetlc (int i, int offp, int offl)

Variables

int byterev
int inqmask
iob_dataiob_list
Addrp io_structs [9]
LOCAL char ioroutine [12]
LOCAL long ioendlab
LOCAL long ioerrlab
LOCAL int endbit
LOCAL int errbit
LOCAL long jumplab
LOCAL long skiplab
LOCAL int ioformatted
LOCAL int statstruct = NO
LOCAL struct Labelblockskiplabel
Addrp ioblkp
LOCAL struct Ioclist ioc []
LOCAL char * cilist_names []
LOCAL char * icilist_names []
LOCAL char * olist_names []
LOCAL char * cllist_names []
LOCAL char * alist_names []
LOCAL char * inlist_names []
LOCAL char ** io_fields
LOCAL io_setup io_stuff []
int iocalladdr = TYADDR
int typeconv [TYERROR+1]
static int ioset_assign = OPASSIGN


Define Documentation

#define FORMATTED   1

Definition at line 68 of file io.c.

Referenced by ioclause(), putio(), and startrw().

#define IOALL   07777

Definition at line 74 of file io.c.

#define IOSACCESS   10

Definition at line 121 of file io.c.

Referenced by dofinquire(), and dofopen().

#define IOSBLANK   12

Definition at line 123 of file io.c.

Referenced by dofinquire(), and dofopen().

#define IOSDIRECT   19

Definition at line 130 of file io.c.

Referenced by dofinquire().

#define IOSEND   4

Definition at line 115 of file io.c.

Referenced by endioctl().

#define IOSERR   3

Definition at line 114 of file io.c.

Referenced by endioctl().

#define IOSEXISTS   13

Definition at line 124 of file io.c.

Referenced by dofinquire().

#define IOSFILE   8

Definition at line 119 of file io.c.

Referenced by dofinquire(), dofopen(), and ioclause().

#define IOSFORM   11

Definition at line 122 of file io.c.

Referenced by dofinquire(), and dofopen().

#define IOSFORMATTED   20

Definition at line 131 of file io.c.

Referenced by dofinquire().

#define IOSIOSTAT   5

Definition at line 116 of file io.c.

Referenced by endioctl().

#define IOSNAME   17

Definition at line 128 of file io.c.

Referenced by dofinquire().

#define IOSNAMED   16

Definition at line 127 of file io.c.

Referenced by dofinquire().

#define IOSNEXTREC   22

Definition at line 133 of file io.c.

Referenced by dofinquire().

#define IOSNML   23

Definition at line 134 of file io.c.

Referenced by ioclause().

#define IOSNUMBER   15

Definition at line 126 of file io.c.

Referenced by dofinquire().

#define IOSOPENED   14

Definition at line 125 of file io.c.

Referenced by dofinquire().

#define IOSREC   6

Definition at line 117 of file io.c.

Referenced by startrw().

#define IOSRECL   7

Definition at line 118 of file io.c.

Referenced by dofinquire(), and dofopen().

#define IOSSEQUENTIAL   18

Definition at line 129 of file io.c.

Referenced by dofinquire().

#define IOSSTATUS   9

Definition at line 120 of file io.c.

Referenced by dofclose(), and dofopen().

#define IOSTP   V(IOSIOSTAT)

Definition at line 136 of file io.c.

Referenced by endio(), endioctl(), and putiocall().

#define IOSUNFORMATTED   21

Definition at line 132 of file io.c.

Referenced by dofinquire().

#define LISTDIRECTED   2

Definition at line 69 of file io.c.

Referenced by ioclause(), putio(), and startrw().

#define NAMEDIRECTED   3

Definition at line 70 of file io.c.

Referenced by doio(), endio(), and startrw().

#define NIOS   (sizeof(ioc)/sizeof(struct Ioclist) - 1)

Definition at line 110 of file io.c.

Referenced by endioctl(), iocname(), and startioctl().

#define SZFLAG   SZIOINT

Definition at line 141 of file io.c.

#define SZIOINT   SZLONG

Definition at line 30 of file io.c.

#define TYIOINT   TYLONG

Definition at line 29 of file io.c.

Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioset(), iosetlc(), and startrw().

#define UNFORMATTED   0

Definition at line 67 of file io.c.

Referenced by startioctl(), and startrw().

#define V ( z   )     ioc[z].iocval

Definition at line 72 of file io.c.

Referenced by C2F(), dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), intsplin3d(), iosetip(), iosetlc(), startioctl(), and startrw().

#define XACCESS   SZFLAG + 2*SZIOINT + 2*SZADDR

Definition at line 165 of file io.c.

Referenced by dofopen().

#define XBLANK   SZFLAG + 3*SZIOINT + 4*SZADDR

Definition at line 168 of file io.c.

Referenced by dofopen().

#define XCLSTATUS   SZFLAG + SZIOINT

Definition at line 172 of file io.c.

Referenced by dofclose().

#define XDIRECT   SZFLAG + 5*SZIOINT + 8*SZADDR

Definition at line 188 of file io.c.

Referenced by dofinquire().

#define XDIRLEN   SZFLAG + 5*SZIOINT + 9*SZADDR

Definition at line 189 of file io.c.

Referenced by dofinquire().

#define XEND   SZFLAG + SZIOINT

Definition at line 147 of file io.c.

Referenced by startrw().

#define XERR   0

Definition at line 145 of file io.c.

Referenced by endioctl(), and startrw().

#define XEXISTS   SZFLAG + 2*SZIOINT + SZADDR

Definition at line 178 of file io.c.

Referenced by dofinquire().

#define XFILE   SZFLAG + SZIOINT

Definition at line 176 of file io.c.

Referenced by dofinquire().

#define XFILELEN   SZFLAG + SZIOINT + SZADDR

Definition at line 177 of file io.c.

Referenced by dofinquire().

#define XFMT   2*SZFLAG + SZIOINT

Definition at line 148 of file io.c.

Referenced by startrw().

#define XFMTED   SZFLAG + 7*SZIOINT + 10*SZADDR

Definition at line 192 of file io.c.

Referenced by dofinquire().

#define XFMTEDLEN   SZFLAG + 7*SZIOINT + 11*SZADDR

Definition at line 193 of file io.c.

Referenced by dofinquire().

#define XFNAME   SZFLAG + SZIOINT

Definition at line 162 of file io.c.

Referenced by dofopen().

#define XFNAMELEN   SZFLAG + SZIOINT + SZADDR

Definition at line 163 of file io.c.

Referenced by dofopen().

#define XFORM   SZFLAG + 6*SZIOINT + 9*SZADDR

Definition at line 190 of file io.c.

Referenced by dofinquire().

#define XFORMATTED   SZFLAG + 2*SZIOINT + 3*SZADDR

Definition at line 166 of file io.c.

Referenced by dofopen().

#define XFORMLEN   SZFLAG + 6*SZIOINT + 10*SZADDR

Definition at line 191 of file io.c.

Referenced by dofinquire().

#define XIEND   SZFLAG + SZADDR

Definition at line 154 of file io.c.

Referenced by startrw().

#define XIFMT   2*SZFLAG + SZADDR

Definition at line 155 of file io.c.

Referenced by startrw().

#define XIREC   2*SZFLAG + 2*SZADDR + 2*SZIOINT

Definition at line 158 of file io.c.

#define XIRLEN   2*SZFLAG + 2*SZADDR

Definition at line 156 of file io.c.

Referenced by startrw().

#define XIRNUM   2*SZFLAG + 2*SZADDR + SZIOINT

Definition at line 157 of file io.c.

Referenced by startrw().

#define XIUNIT   SZFLAG

Definition at line 153 of file io.c.

Referenced by startrw().

#define XNAME   SZFLAG + 2*SZIOINT + 5*SZADDR

Definition at line 182 of file io.c.

Referenced by dofinquire().

#define XNAMED   SZFLAG + 2*SZIOINT + 4*SZADDR

Definition at line 181 of file io.c.

Referenced by dofinquire().

#define XNAMELEN   SZFLAG + 2*SZIOINT + 6*SZADDR

Definition at line 183 of file io.c.

Referenced by dofinquire().

#define XNEXTREC   SZFLAG + 9*SZIOINT + 13*SZADDR

Definition at line 197 of file io.c.

Referenced by dofinquire().

#define XNUMBER   SZFLAG + 2*SZIOINT + 3*SZADDR

Definition at line 180 of file io.c.

Referenced by dofinquire().

#define XOPEN   SZFLAG + 2*SZIOINT + 2*SZADDR

Definition at line 179 of file io.c.

Referenced by dofinquire().

#define XQACCESS   SZFLAG + 3*SZIOINT + 6*SZADDR

Definition at line 184 of file io.c.

Referenced by dofinquire().

#define XQACCLEN   SZFLAG + 3*SZIOINT + 7*SZADDR

Definition at line 185 of file io.c.

Referenced by dofinquire().

#define XQBLANK   SZFLAG + 9*SZIOINT + 14*SZADDR

Definition at line 198 of file io.c.

Referenced by dofinquire().

#define XQBLANKLEN   SZFLAG + 9*SZIOINT + 15*SZADDR

Definition at line 199 of file io.c.

Referenced by dofinquire().

#define XQRECL   SZFLAG + 9*SZIOINT + 12*SZADDR

Definition at line 196 of file io.c.

Referenced by dofinquire().

#define XREC   2*SZFLAG + SZIOINT + SZADDR

Definition at line 149 of file io.c.

Referenced by startrw().

#define XRECLEN   SZFLAG + 2*SZIOINT + 4*SZADDR

Definition at line 167 of file io.c.

Referenced by dofopen().

#define XSEQ   SZFLAG + 4*SZIOINT + 7*SZADDR

Definition at line 186 of file io.c.

Referenced by dofinquire().

#define XSEQLEN   SZFLAG + 4*SZIOINT + 8*SZADDR

Definition at line 187 of file io.c.

Referenced by dofinquire().

#define XSTATUS   SZFLAG + 2*SZIOINT + SZADDR

Definition at line 164 of file io.c.

Referenced by dofopen().

#define XUNFMT   SZFLAG + 8*SZIOINT + 11*SZADDR

Definition at line 194 of file io.c.

Referenced by dofinquire().

#define XUNFMTLEN   SZFLAG + 8*SZIOINT + 12*SZADDR

Definition at line 195 of file io.c.

Referenced by dofinquire().

#define XUNIT   SZFLAG

Definition at line 146 of file io.c.

Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), and startrw().

#define zork ( n,
t   )     n, sizeof(n)/sizeof(char *) - 1, t

Definition at line 273 of file io.c.


Function Documentation

static void putiocall Argdcl ( (expptr  )  [static]

static void putio Argdcl ( (expptr, expptr  )  [static]

static void iosetlc Argdcl ( (int, int, int  )  [static]

static void iosetip Argdcl ( (int, int  )  [static]

static void iosetc Argdcl ( (int, expptr  )  [static]

static void ioseta Argdcl ( (int, Addrp  )  [static]

static void ioset Argdcl ( (int, int, expptr  )  [static]

static void doiolist Argdcl ( (chainp  )  [static]

static void dofmove Argdcl ( (char *)   )  [static]

static void dofclose Argdcl ( (void)   )  [static]

LOCAL Addrp asg_addr ( union Expression p  ) 

Definition at line 919 of file io.c.

References ALLOC, badtag(), fmtname(), ICON, Addrblock::isarray, Addrblock::memoffset, Addrblock::ntempelt, p, STGAUTO, TADDR, Addrblock::tag, TPRIM, TYCHAR, Addrblock::vstg, and Addrblock::vtype.

Referenced by startrw().

00921 {
00922         register Addrp q;
00923 
00924         if (p->tag != TPRIM)
00925                 badtag("asg_addr", p->tag);
00926         q = ALLOC(Addrblock);
00927         q->tag = TADDR;
00928         q->vtype = TYCHAR;
00929         q->vstg = STGAUTO;
00930         q->ntempelt = 1;
00931         q->isarray = 0;
00932         q->memoffset = ICON(0);
00933         fmtname(p->primblock.namep, q);
00934         return q;
00935         }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void dofclose ( Void   ) 

Definition at line 1221 of file io.c.

References call1(), cpexpr(), err, ioblkp, ioset(), iosetc(), IOSSTATUS, IOSUNIT, ISINT, p, putiocall(), TYINT, TYIOINT, V, XCLSTATUS, and XUNIT.

Referenced by endioctl().

01222 {
01223         register expptr p;
01224 
01225         if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
01226         {
01227                 ioset(TYIOINT, XUNIT, cpexpr(p) );
01228                 iosetc(XCLSTATUS, V(IOSSTATUS));
01229                 putiocall( call1(TYINT, "f_clos", cpexpr((expptr)ioblkp)) );
01230         }
01231         else
01232                 err("bad unit in close statement");
01233 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void dofinquire ( Void   ) 

Definition at line 1237 of file io.c.

References call1(), cpexpr(), err, ioblkp, IOSACCESS, IOSBLANK, IOSDIRECT, ioset(), iosetip(), iosetlc(), IOSEXISTS, IOSFILE, IOSFORM, IOSFORMATTED, IOSNAME, IOSNAMED, IOSNEXTREC, IOSNUMBER, IOSOPENED, IOSRECL, IOSSEQUENTIAL, IOSUNFORMATTED, IOSUNIT, p, putiocall(), TYINT, TYIOINT, V, XDIRECT, XDIRLEN, XEXISTS, XFILE, XFILELEN, XFMTED, XFMTEDLEN, XFORM, XFORMLEN, XNAME, XNAMED, XNAMELEN, XNEXTREC, XNUMBER, XOPEN, XQACCESS, XQACCLEN, XQBLANK, XQBLANKLEN, XQRECL, XSEQ, XSEQLEN, XUNFMT, XUNFMTLEN, and XUNIT.

Referenced by endioctl().

01238 {
01239         register expptr p;
01240         if(p = V(IOSUNIT))
01241         {
01242                 if( V(IOSFILE) )
01243                         err("inquire by unit or by file, not both");
01244                 ioset(TYIOINT, XUNIT, cpexpr(p) );
01245         }
01246         else if( ! V(IOSFILE) )
01247                 err("must inquire by unit or by file");
01248         iosetlc(IOSFILE, XFILE, XFILELEN);
01249         iosetip(IOSEXISTS, XEXISTS);
01250         iosetip(IOSOPENED, XOPEN);
01251         iosetip(IOSNUMBER, XNUMBER);
01252         iosetip(IOSNAMED, XNAMED);
01253         iosetlc(IOSNAME, XNAME, XNAMELEN);
01254         iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
01255         iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
01256         iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
01257         iosetlc(IOSFORM, XFORM, XFORMLEN);
01258         iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
01259         iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
01260         iosetip(IOSRECL, XQRECL);
01261         iosetip(IOSNEXTREC, XNEXTREC);
01262         iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);
01263 
01264         putiocall( call1(TYINT,  "f_inqu", cpexpr((expptr)ioblkp) ));
01265 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void dofmove ( char *  subname  ) 

Definition at line 1274 of file io.c.

References call1(), cpexpr(), err, ioblkp, ioset(), IOSUNIT, ISINT, p, putiocall(), TYINT, TYIOINT, V, and XUNIT.

Referenced by endioctl().

01276 {
01277         register expptr p;
01278 
01279         if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
01280         {
01281                 ioset(TYIOINT, XUNIT, cpexpr(p) );
01282                 putiocall( call1(TYINT, subname, cpexpr((expptr)ioblkp) ));
01283         }
01284         else
01285                 err("bad unit in I/O motion statement");
01286 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void dofopen ( Void   ) 

Definition at line 1187 of file io.c.

References call1(), cpexpr(), err, ICON, ioblkp, IOSACCESS, IOSBLANK, ioset(), iosetc(), IOSFILE, IOSFORM, IOSRECL, IOSSTATUS, IOSUNIT, ISINT, p, putiocall(), TYCHAR, TYINT, TYIOINT, V, XACCESS, XBLANK, XFNAME, XFNAMELEN, XFORMATTED, XRECLEN, XSTATUS, and XUNIT.

Referenced by endioctl().

01188 {
01189         register expptr p;
01190 
01191         if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
01192                 ioset(TYIOINT, XUNIT, cpexpr(p) );
01193         else
01194                 err("bad unit in open");
01195         if( (p = V(IOSFILE)) )
01196                 if(p->headblock.vtype == TYCHAR)
01197                         ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
01198                 else
01199                         err("bad file in open");
01200 
01201         iosetc(XFNAME, p);
01202 
01203         if(p = V(IOSRECL))
01204                 if( ISINT(p->headblock.vtype) )
01205                         ioset(TYIOINT, XRECLEN, cpexpr(p) );
01206                 else
01207                         err("bad recl");
01208         else
01209                 ioset(TYIOINT, XRECLEN, ICON(0) );
01210 
01211         iosetc(XSTATUS, V(IOSSTATUS));
01212         iosetc(XACCESS, V(IOSACCESS));
01213         iosetc(XFORMATTED, V(IOSFORM));
01214         iosetc(XBLANK, V(IOSBLANK));
01215 
01216         putiocall( call1(TYINT, "f_open", cpexpr((expptr)ioblkp) ));
01217 }

Here is the call graph for this function:

Here is the caller graph for this function:

void doio ( chainp  list  ) 

Definition at line 650 of file io.c.

References call0(), doiolist(), err, NAMEDIRECTED, putiocall(), and TYINT.

Referenced by yyparse().

00652 {
00653         if(ioformatted == NAMEDIRECTED)
00654         {
00655                 if(list)
00656                         err("no I/O list allowed in NAMELIST read/write");
00657         }
00658         else
00659         {
00660                 doiolist(list);
00661                 ioroutine[0] = 'e';
00662                 if (skiplab)
00663                         jumplab = 0;
00664                 putiocall( call0(TYINT, ioroutine) );
00665         }
00666 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void doiolist ( chainp  p0  ) 

Definition at line 677 of file io.c.

References Expression::addrblock, Primblock::argsp, Expression::constblock, cpexpr(), Impldoblock::datalist, enddo(), err, exdo(), fixtype(), free(), frexpr(), halign, Expression::headblock, ICON, Impldoblock::impdospec, Expression::impldoblock, iostmt, IOWRITE, ISCHAR, ISCOMPLEX, ISCONST, lencat(), memversion(), mkscalar(), mktmp(), Primblock::namep, Dimblock::nelt, newlabel(), NULL, ohalign, p, Expression::primblock, putconst(), puteq(), putio(), TADDR, Expression::tag, TCONST, TIMPLDO, TPRIM, TYCHAR, TYERROR, UNAM_CONST, Addrblock::uname_tag, vardcl(), Nameblock::vdim, Headblock::vleng, Headblock::vtype, and Constblock::vtype.

Referenced by doio().

00679 {
00680         chainp p;
00681         register tagptr q;
00682         register expptr qe;
00683         register Namep qn;
00684         Addrp tp;
00685         int range;
00686         extern char *ohalign;
00687 
00688         for (p = p0 ; p ; p = p->nextp)
00689         {
00690                 q = (tagptr)p->datap;
00691                 if(q->tag == TIMPLDO)
00692                 {
00693                         exdo(range = (int)newlabel(), (Namep)0,
00694                                 q->impldoblock.impdospec);
00695                         doiolist(q->impldoblock.datalist);
00696                         enddo(range);
00697                         free( (charptr) q);
00698                 }
00699                 else    {
00700                         if(q->tag==TPRIM && q->primblock.argsp==NULL
00701                             && q->primblock.namep->vdim!=NULL)
00702                         {
00703                                 vardcl(qn = q->primblock.namep);
00704                                 if(qn->vdim->nelt) {
00705                                         putio( fixtype(cpexpr(qn->vdim->nelt)),
00706                                             (expptr)mkscalar(qn) );
00707                                         qn->vlastdim = 0;
00708                                         }
00709                                 else
00710                                         err("attempt to i/o array of unknown size");
00711                         }
00712                         else if(q->tag==TPRIM && q->primblock.argsp==NULL &&
00713                             (qe = (expptr) memversion(q->primblock.namep)) )
00714                                 putio(ICON(1),qe);
00715                         else if (ISCONST(q) && q->constblock.vtype == TYCHAR) {
00716                                 halign = 0;
00717                                 putio(ICON(1), qe = fixtype(cpexpr(q)));
00718                                 halign = ohalign;
00719                                 }
00720                         else if(((qe = fixtype(cpexpr(q)))->tag==TADDR &&
00721                             (qe->addrblock.uname_tag != UNAM_CONST ||
00722                             !ISCOMPLEX(qe -> addrblock.vtype))) ||
00723                             (qe -> tag == TCONST && !ISCOMPLEX(qe ->
00724                             headblock.vtype))) {
00725                                 if (qe -> tag == TCONST)
00726                                         qe = (expptr) putconst((Constp)qe);
00727                                 putio(ICON(1), qe);
00728                         }
00729                         else if(qe->headblock.vtype != TYERROR)
00730                         {
00731                                 if(iostmt == IOWRITE)
00732                                 {
00733                                         expptr qvl;
00734                                         qvl = NULL;
00735                                         if( ISCHAR(qe) )
00736                                         {
00737                                                 qvl = (expptr)
00738                                                     cpexpr(qe->headblock.vleng);
00739                                                 tp = mktmp(qe->headblock.vtype,
00740                                                     ICON(lencat(qe)));
00741                                         }
00742                                         else
00743                                                 tp = mktmp(qe->headblock.vtype,
00744                                                     qe->headblock.vleng);
00745                                         puteq( cpexpr((expptr)tp), qe);
00746                                         if(qvl) /* put right length on block */
00747                                         {
00748                                                 frexpr(tp->vleng);
00749                                                 tp->vleng = qvl;
00750                                         }
00751                                         putio(ICON(1), (expptr)tp);
00752                                 }
00753                                 else
00754                                         err("non-left side in READ list");
00755                         }
00756                         frexpr(q);
00757                 }
00758         }
00759         frchain( &p0 );
00760 }

Here is the call graph for this function:

Here is the caller graph for this function:

void endio ( Void   ) 

Definition at line 832 of file io.c.

References cpexpr(), execlab(), exendif(), exgoto(), exif(), frexpr(), ICON, IOREAD, iostmt, IOSTP, IOWRITE, labeltab, mkexpr(), NAMEDIRECTED, OPGT, OPLT, OPNE, p1_label(), and skiplabel.

Referenced by yyparse().

00833 {
00834         if(skiplab)
00835         {
00836                 if (ioformatted != NAMEDIRECTED)
00837                         p1_label((long)(skiplabel - labeltab));
00838                 if(ioendlab) {
00839                         exif( mkexpr(OPLT, cpexpr(IOSTP), ICON(0)));
00840                         exgoto(execlab(ioendlab));
00841                         exendif();
00842                         }
00843                 if(ioerrlab) {
00844                         exif( mkexpr(iostmt==IOREAD||iostmt==IOWRITE
00845                                         ? OPGT : OPNE,
00846                                 cpexpr(IOSTP), ICON(0)));
00847                         exgoto(execlab(ioerrlab));
00848                         exendif();
00849                         }
00850         }
00851 
00852         if(IOSTP)
00853                 frexpr(IOSTP);
00854 }

Here is the call graph for this function:

Here is the caller graph for this function:

void endioctl ( Void   ) 

Definition at line 425 of file io.c.

References autovar(), dofclose(), dofinquire(), dofmove(), dofopen(), ENULL, err, execlab(), fatali(), io_setup::fields, frexpr(), i, ICON, inioctl, io_structs, IOBACKSPACE, ioblkp, IOCLOSE, IOENDFILE, IOINQUIRE, IOOPEN, IOREAD, IOREWIND, IOSEND, IOSERR, ioset(), IOSIOSTAT, iostmt, IOSTP, IOWRITE, ISICON, ISINT, mktmp(), newiolabel(), NIOS, NO, NULL, p, startrw(), TADDR, TYINT, TYIOINT, io_setup::type, V, and XERR.

Referenced by yyparse().

00426 {
00427         int i;
00428         expptr p;
00429         struct io_setup *ios;
00430 
00431         inioctl = NO;
00432 
00433         /* set up for error recovery */
00434 
00435         ioerrlab = ioendlab = skiplab = jumplab = 0;
00436 
00437         if(p = V(IOSEND))
00438                 if(ISICON(p))
00439                         execlab(ioendlab = p->constblock.Const.ci);
00440                 else
00441                         err("bad end= clause");
00442 
00443         if(p = V(IOSERR))
00444                 if(ISICON(p))
00445                         execlab(ioerrlab = p->constblock.Const.ci);
00446                 else
00447                         err("bad err= clause");
00448 
00449         if(IOSTP)
00450                 if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) )
00451                 {
00452                         err("iostat must be an integer variable");
00453                         frexpr(IOSTP);
00454                         IOSTP = NULL;
00455                 }
00456 
00457         if(iostmt == IOREAD)
00458         {
00459                 if(IOSTP)
00460                 {
00461                         if(ioerrlab && ioendlab && ioerrlab==ioendlab)
00462                                 jumplab = ioerrlab;
00463                         else
00464                                 skiplab = jumplab = newiolabel();
00465                 }
00466                 else    {
00467                         if(ioerrlab && ioendlab && ioerrlab!=ioendlab)
00468                         {
00469                                 IOSTP = (expptr) mktmp(TYINT, ENULL);
00470                                 skiplab = jumplab = newiolabel();
00471                         }
00472                         else
00473                                 jumplab = (ioerrlab ? ioerrlab : ioendlab);
00474                 }
00475         }
00476         else if(iostmt == IOWRITE)
00477         {
00478                 if(IOSTP && !ioerrlab)
00479                         skiplab = jumplab = newiolabel();
00480                 else
00481                         jumplab = ioerrlab;
00482         }
00483         else
00484                 jumplab = ioerrlab;
00485 
00486         endbit = IOSTP!=NULL || ioendlab!=0;    /* for use in startrw() */
00487         errbit = IOSTP!=NULL || ioerrlab!=0;
00488         if (jumplab && !IOSTP)
00489                 IOSTP = (expptr) mktmp(TYINT, ENULL);
00490 
00491         if(iostmt!=IOREAD && iostmt!=IOWRITE)
00492         {
00493                 ios = io_stuff + iostmt;
00494                 io_fields = ios->fields;
00495                 ioblkp = io_structs[iostmt];
00496                 if(ioblkp == NULL)
00497                         io_structs[iostmt] = ioblkp =
00498                                 autovar(1, ios->type, ENULL, "");
00499                 ioset(TYIOINT, XERR, ICON(errbit));
00500         }
00501 
00502         switch(iostmt)
00503         {
00504         case IOOPEN:
00505                 dofopen();
00506                 break;
00507 
00508         case IOCLOSE:
00509                 dofclose();
00510                 break;
00511 
00512         case IOINQUIRE:
00513                 dofinquire();
00514                 break;
00515 
00516         case IOBACKSPACE:
00517                 dofmove("f_back");
00518                 break;
00519 
00520         case IOREWIND:
00521                 dofmove("f_rew");
00522                 break;
00523 
00524         case IOENDFILE:
00525                 dofmove("f_end");
00526                 break;
00527 
00528         case IOREAD:
00529         case IOWRITE:
00530                 startrw();
00531                 break;
00532 
00533         default:
00534                 fatali("impossible iostmt %d", iostmt);
00535         }
00536         for(i = 1 ; i<=NIOS ; ++i)
00537                 if(i!=IOSIOSTAT && V(i)!=NULL)
00538                         frexpr(V(i));
00539 }

Here is the call graph for this function:

Here is the caller graph for this function:

void fmtname ( Namep  np,
register Addrp  q 
)

Definition at line 891 of file io.c.

References assigned_fmts, Nameblock::fvarname, IDENT_LEN, mem(), mkchain(), s, t, UNAM_CHARP, UNAM_IDENT, and Nameblock::vfmt_asg.

Referenced by asg_addr(), and exassign().

00893 {
00894         register int k;
00895         register char *s, *t;
00896         extern chainp assigned_fmts;
00897 
00898         if (!np->vfmt_asg) {
00899                 np->vfmt_asg = 1;
00900                 assigned_fmts = mkchain((char *)np, assigned_fmts);
00901                 }
00902         k = strlen(s = np->fvarname);
00903         if (k < IDENT_LEN - 4) {
00904                 q->uname_tag = UNAM_IDENT;
00905                 t = q->user.ident;
00906                 }
00907         else {
00908                 q->uname_tag = UNAM_CHARP;
00909                 q->user.Charp = t = mem(k + 5,0);
00910                 }
00911         sprintf(t, "%s_fmt", s);
00912         }

Here is the call graph for this function:

Here is the caller graph for this function:

int fmtstmt ( register struct Labelblock lp  ) 

Definition at line 294 of file io.c.

References CNULL, execerr(), int, LABFORMAT, LABUNKNOWN, newlabel(), and NULL.

Referenced by startrw(), and yyparse().

00296 {
00297         if(lp == NULL)
00298         {
00299                 execerr("unlabeled format statement" , CNULL);
00300                 return(-1);
00301         }
00302         if(lp->labtype == LABUNKNOWN)
00303         {
00304                 lp->labtype = LABFORMAT;
00305                 lp->labelno = (int)newlabel();
00306         }
00307         else if(lp->labtype != LABFORMAT)
00308         {
00309                 execerr("bad format number", CNULL);
00310                 return(-1);
00311         }
00312         return(lp->labelno);
00313 }

Here is the call graph for this function:

Here is the caller graph for this function:

void ioclause ( register int  n,
register expptr  p 
)

Definition at line 578 of file io.c.

References CLUNKNOWN, err, errstr(), fixtype(), FORMATTED, ioc, Ioclist::iocname, Ioclist::iocval, IOOPEN, IOREAD, IOSBAD, IOSFILE, IOSFMT, IOSNML, IOSPOSITIONAL, IOSTDIN, IOSTDOUT, iostmt, IOSUNIT, LISTDIRECTED, nioctl, NOEXT, NULL, TPRIM, TYCHAR, and vardcl().

Referenced by yyparse().

00580 {
00581         struct Ioclist *iocp;
00582 
00583         ++nioctl;
00584         if(n == IOSBAD)
00585                 return;
00586         if(n == IOSPOSITIONAL)
00587                 {
00588                 n = nioctl;
00589                 if (n == IOSFMT) {
00590                         if (iostmt == IOOPEN) {
00591                                 n = IOSFILE;
00592                                 NOEXT("file= specifier omitted from open");
00593                                 }
00594                         else if (iostmt < IOREAD)
00595                                 goto illegal;
00596                         }
00597                 else if(n > IOSFMT)
00598                         {
00599  illegal:
00600                         err("illegal positional iocontrol");
00601                         return;
00602                         }
00603                 }
00604         else if (n == IOSNML)
00605                 n = IOSFMT;
00606 
00607         if(p == NULL)
00608         {
00609                 if(n == IOSUNIT)
00610                         p = (expptr) (iostmt==IOREAD ? IOSTDIN : IOSTDOUT);
00611                 else if(n != IOSFMT)
00612                 {
00613                         err("illegal * iocontrol");
00614                         return;
00615                 }
00616         }
00617         if(n == IOSFMT)
00618                 ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED);
00619 
00620         iocp = & ioc[n];
00621         if(iocp->iocval == NULL)
00622         {
00623                 if(n!=IOSFMT && ( n!=IOSUNIT || (p && p->headblock.vtype!=TYCHAR) ) )
00624                         p = fixtype(p);
00625                 else if (p && p->tag == TPRIM
00626                            && p->primblock.namep->vclass == CLUNKNOWN) {
00627                         /* kludge made necessary by attempt to infer types
00628                          * for untyped external parameters: given an error
00629                          * in calling sequences, an integer argument might
00630                          * tentatively be assumed TYCHAR; this would otherwise
00631                          * be corrected too late in startrw after startrw
00632                          * had decided this to be an internal file.
00633                          */
00634                         vardcl(p->primblock.namep);
00635                         p->primblock.vtype = p->primblock.namep->vtype;
00636                         }
00637                 iocp->iocval = p;
00638         }
00639         else
00640                 errstr("iocontrol %s repeated", iocp->iocname);
00641 }

Here is the call graph for this function:

Here is the caller graph for this function:

int iocname ( Void   ) 

Definition at line 543 of file io.c.

References errstr(), i, ioc, iocname(), IOOPEN, IOSBAD, iostmt, M, NIOS, NOEXT, and token.

Referenced by iocname(), iosetip(), and yyparse().

00544 {
00545         register int i;
00546         int found, mask;
00547 
00548         found = 0;
00549         mask = M(iostmt);
00550         for(i = 1 ; i <= NIOS ; ++i)
00551                 if(!strcmp(ioc[i].iocname, token))
00552                         if(ioc[i].iotype & mask)
00553                                 return(i);
00554                         else {
00555                                 found = i;
00556                                 break;
00557                                 }
00558         if(found) {
00559                 if (iostmt == IOOPEN && !strcmp(ioc[i].iocname, "name")) {
00560                         NOEXT("open with \"name=\" treated as \"file=\"");
00561                         for(i = 1; strcmp(ioc[i].iocname, "file"); i++);
00562                         return i;
00563                         }
00564                 errstr("invalid control %s for statement", ioc[found].iocname);
00565                 }
00566         else
00567                 errstr("unknown iocontrol %s", token);
00568         return(IOSBAD);
00569 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void ioset ( int  type,
int  offset,
register expptr  p 
)

Definition at line 1297 of file io.c.

References ALLOC, badtype(), iob_data::fields, frexpr(), ICON, Addrblock::ident, iob_list, ioblkp, Addrblock::isarray, ISCONST, Addrblock::memoffset, mkexpr(), iob_data::name, Addrblock::ntempelt, putexpr(), s, STGAUTO, string_num(), SZLONG, TADDR, Addrblock::tag, TCONST, TYADDR, TYCHAR, TYIOINT, UNAM_IDENT, Addrblock::uname_tag, Addrblock::user, Addrblock::vstg, and Addrblock::vtype.

Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioseta(), iosetc(), iosetip(), iosetlc(), and startrw().

01299 {
01300         offset /= SZLONG;
01301         if(statstruct && ISCONST(p)) {
01302                 register char *s;
01303                 switch(type) {
01304                         case TYADDR:    /* stmt label */
01305                                 s = "fmt_";
01306                                 break;
01307                         case TYIOINT:
01308                                 s = "";
01309                                 break;
01310                         default:
01311                                 badtype("ioset", type);
01312                         }
01313                 iob_list->fields[offset] =
01314                         string_num(s, p->constblock.Const.ci);
01315                 frexpr(p);
01316                 }
01317         else {
01318                 register Addrp q;
01319 
01320                 q = ALLOC(Addrblock);
01321                 q->tag = TADDR;
01322                 q->vtype = type;
01323                 q->vstg = STGAUTO;
01324                 q->ntempelt = 1;
01325                 q->isarray = 0;
01326                 q->memoffset = ICON(0);
01327                 q->uname_tag = UNAM_IDENT;
01328                 sprintf(q->user.ident, "%s.%s",
01329                         statstruct ? iob_list->name : ioblkp->user.ident,
01330                         io_fields[offset + 1]);
01331                 if (type == TYADDR && p->tag == TCONST
01332                                    && p->constblock.vtype == TYADDR) {
01333                         /* kludge */
01334                         register Addrp p1;
01335                         p1 = ALLOC(Addrblock);
01336                         p1->tag = TADDR;
01337                         p1->vtype = type;
01338                         p1->vstg = STGAUTO;     /* wrong, but who cares? */
01339                         p1->ntempelt = 1;
01340                         p1->isarray = 0;
01341                         p1->memoffset = ICON(0);
01342                         p1->uname_tag = UNAM_IDENT;
01343                         sprintf(p1->user.ident, "fmt_%ld",
01344                                 p->constblock.Const.ci);
01345                         frexpr(p);
01346                         p = (expptr)p1;
01347                         }
01348                 if (type == TYADDR && p->headblock.vtype == TYCHAR)
01349                         q->vtype = TYCHAR;
01350                 putexpr(mkexpr(ioset_assign, (expptr)q, p));
01351                 }
01352 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void ioseta ( int  offset,
register Addrp  p 
)

Definition at line 1384 of file io.c.

References addrof(), badtag(), badthing(), buf, Extsym::cextname, Constant::ci, ci, Constblock::Const, Expression::constblock, cpstring(), Extsym::curno, Nameblock::cvarname, ENULL, extsymtab, iob_data::fields, ICON, iob_list, ioset(), mem(), mkexpr(), NOEXT, OPCHARCAST, s, s1, STGCOMMON, SZLONG, TADDR, Expression::tag, TCONST, tostring(), TYADDR, TYCHAR, UNAM_CONST, UNAM_NAME, usedefsforcommon, Nameblock::vardesc, Nameblock::varno, Nameblock::vcommequiv, Nameblock::visused, Nameblock::voffset, and Nameblock::vstg.

Referenced by startrw().

01386 {
01387         char *s, *s1;
01388         static char who[] = "ioseta";
01389         expptr e, mo;
01390         Namep np;
01391         ftnint ci;
01392         int k;
01393         char buf[24], buf1[24];
01394         Extsym *comm;
01395         extern int usedefsforcommon;
01396 
01397         if(statstruct)
01398         {
01399                 if (!p)
01400                         return;
01401                 if (p->tag != TADDR)
01402                         badtag(who, p->tag);
01403                 offset /= SZLONG;
01404                 switch(p->uname_tag) {
01405                     case UNAM_NAME:
01406                         mo = p->memoffset;
01407                         if (mo->tag != TCONST)
01408                                 badtag("ioseta/memoffset", mo->tag);
01409                         np = p->user.name;
01410                         np->visused = 1;
01411                         ci = mo->constblock.Const.ci - np->voffset;
01412                         if (np->vstg == STGCOMMON
01413                         && !np->vcommequiv
01414                         && !usedefsforcommon) {
01415                                 comm = &extsymtab[np->vardesc.varno];
01416                                 sprintf(buf, "%d.", comm->curno);
01417                                 k = strlen(buf) + strlen(comm->cextname)
01418                                         + strlen(np->cvarname);
01419                                 if (ci) {
01420                                         sprintf(buf1, "+%ld", ci);
01421                                         k += strlen(buf1);
01422                                         }
01423                                 else
01424                                         buf1[0] = 0;
01425                                 s = mem(k + 1, 0);
01426                                 sprintf(s, "%s%s%s%s", comm->cextname, buf,
01427                                         np->cvarname, buf1);
01428                                 }
01429                         else if (ci) {
01430                                 sprintf(buf,"%ld", ci);
01431                                 s1 = p->user.name->cvarname;
01432                                 k = strlen(buf) + strlen(s1);
01433                                 sprintf(s = mem(k+2,0), "%s+%s", s1, buf);
01434                                 }
01435                         else
01436                                 s = cpstring(np->cvarname);
01437                         break;
01438                     case UNAM_CONST:
01439                         s = tostring(p->user.Const.ccp1.ccp0,
01440                                 (int)p->vleng->constblock.Const.ci);
01441                         break;
01442                     default:
01443                         badthing("uname_tag", who, p->uname_tag);
01444                     }
01445                 /* kludge for Hollerith */
01446                 if (p->vtype != TYCHAR) {
01447                         s1 = mem(strlen(s)+10,0);
01448                         sprintf(s1, "(char *)%s%s", p->isarray ? "" : "&", s);
01449                         s = s1;
01450                         }
01451                 iob_list->fields[offset] = s;
01452         }
01453         else {
01454                 if (!p)
01455                         e = ICON(0);
01456                 else if (p->vtype != TYCHAR) {
01457                         NOEXT("non-character variable as format or internal unit");
01458                         e = mkexpr(OPCHARCAST, (expptr)p, ENULL);
01459                         }
01460                 else
01461                         e = addrof((expptr)p);
01462                 ioset(TYADDR, offset, e);
01463                 }
01464 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void iosetc ( int  offset,
register expptr  p 
)

Definition at line 1363 of file io.c.

References addrof(), cpexpr(), err, fixtype(), ICON, ioset(), NULL, p, putchop(), putx(), TYADDR, and TYCHAR.

Referenced by dofclose(), dofopen(), and iosetlc().

01365 {
01366         if(p == NULL)
01367                 ioset(TYADDR, offset, ICON(0) );
01368         else if(p->headblock.vtype == TYCHAR) {
01369                 p = putx(fixtype((expptr)putchop(cpexpr(p))));
01370                 ioset(TYADDR, offset, addrof(p));
01371                 }
01372         else
01373                 err("non-character control clause");
01374 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void iosetip ( int  i,
int  offset 
)

Definition at line 1475 of file io.c.

References addrof(), cpexpr(), errstr(), ICON, inqmask, ioc, iocname(), ioset(), ONEOF, OPASSIGN, OPASSIGNI, p, TADDR, TYADDR, and V.

Referenced by dofinquire().

01477 {
01478         register expptr p;
01479 
01480         if(p = V(i))
01481                 if(p->tag==TADDR &&
01482                     ONEOF(p->addrblock.vtype, inqmask) ) {
01483                         ioset_assign = OPASSIGNI;
01484                         ioset(TYADDR, offset, addrof(cpexpr(p)) );
01485                         ioset_assign = OPASSIGN;
01486                         }
01487                 else
01488                         errstr("impossible inquire parameter %s", ioc[i].iocname);
01489         else
01490                 ioset(TYADDR, offset, ICON(0) );
01491 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void iosetlc ( int  i,
int  offp,
int  offl 
)

Definition at line 1502 of file io.c.

References cpexpr(), ioset(), iosetc(), p, TYCHAR, TYIOINT, and V.

Referenced by dofinquire().

01504 {
01505         register expptr p;
01506         if( (p = V(i)) && p->headblock.vtype==TYCHAR)
01507                 ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
01508         iosetc(offp, p);
01509 }

Here is the call graph for this function:

Here is the caller graph for this function:

static long newiolabel ( Void   )  [static]

Definition at line 416 of file io.c.

References Labelblock::labdefined, lastiolabno, mklabel(), and skiplabel.

Referenced by endioctl().

00416                  {
00417         long rv;
00418         rv = ++lastiolabno;
00419         skiplabel = mklabel(rv);
00420         skiplabel->labdefined = 1;
00421         return rv;
00422         }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void putio ( expptr  nelt,
register expptr  addr 
)

Definition at line 777 of file io.c.

References addr, ALLOC, byterev, call2(), call3(), call4(), Addrblock::charleng, ENULL, fixtype(), FORMATTED, ICON, Addrblock::ident, Addrblock::isarray, ISCOMPLEX, ISCONST, LISTDIRECTED, M, Addrblock::memoffset, mkconv(), mkexpr(), Addrblock::ntempelt, ONEOF, OPCHARCAST, OPSTAR, putconst(), putiocall(), s, STGAUTO, TADDR, Addrblock::tag, TYADDR, TYCHAR, TYCOMPLEX, TYINT, TYINT1, tyioint, TYLENG, TYLOGICAL1, type, Typename, TYREAL, UNAM_IDENT, Addrblock::uname_tag, Addrblock::user, Addrblock::vstg, and Addrblock::vtype.

Referenced by doiolist().

00779 {
00780         int type;
00781         register expptr q;
00782         register Addrp c = 0;
00783 
00784         type = addr->headblock.vtype;
00785         if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) )
00786         {
00787                 nelt = mkexpr(OPSTAR, ICON(2), nelt);
00788                 type -= (TYCOMPLEX-TYREAL);
00789         }
00790 
00791         /* pass a length with every item.  for noncharacter data, fake one */
00792         if(type != TYCHAR)
00793         {
00794 
00795                 if( ISCONST(addr) )
00796                         addr = (expptr) putconst((Constp)addr);
00797                 c = ALLOC(Addrblock);
00798                 c->tag = TADDR;
00799                 c->vtype = TYLENG;
00800                 c->vstg = STGAUTO;
00801                 c->ntempelt = 1;
00802                 c->isarray = 1;
00803                 c->memoffset = ICON(0);
00804                 c->uname_tag = UNAM_IDENT;
00805                 c->charleng = 1;
00806                 sprintf(c->user.ident, "(ftnlen)sizeof(%s)", Typename[type]);
00807                 addr = mkexpr(OPCHARCAST, addr, ENULL);
00808                 }
00809 
00810         nelt = fixtype( mkconv(tyioint,nelt) );
00811         if(ioformatted == LISTDIRECTED) {
00812                 expptr mc = mkconv(tyioint, ICON(typeconv[type]));
00813                 q = c   ? call4(TYINT, "do_lio", mc, nelt, addr, (expptr)c)
00814                         : call3(TYINT, "do_lio", mc, nelt, addr);
00815                 }
00816         else {
00817                 char *s = (char*)(ioformatted==FORMATTED ? "do_fio"
00818                         : !byterev ? "do_uio"
00819                         : ONEOF(type, M(TYCHAR)|M(TYINT1)|M(TYLOGICAL1))
00820                         ? "do_ucio" : "do_unio");
00821                 q = c   ? call3(TYINT, s, nelt, addr, (expptr)c)
00822                         : call2(TYINT, s, nelt, addr);
00823                 }
00824         iocalladdr = TYCHAR;
00825         putiocall(q);
00826         iocalladdr = TYADDR;
00827 }

Here is the call graph for this function:

Here is the caller graph for this function:

LOCAL void putiocall ( register expptr  q  ) 

Definition at line 863 of file io.c.

References cpexpr(), execlab(), exendif(), exgoto(), exif(), fixexpr(), ICON, IOSTP, mkexpr(), OPASSIGN, OPNE, putexpr(), TYINT, tyint, and tyioint.

Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), doio(), putio(), and startrw().

00865 {
00866         int tyintsave;
00867 
00868         tyintsave = tyint;
00869         tyint = tyioint;        /* for -I2 and -i2 */
00870 
00871         if(IOSTP)
00872         {
00873                 q->headblock.vtype = TYINT;
00874                 q = fixexpr((Exprp)mkexpr(OPASSIGN, cpexpr(IOSTP), q));
00875         }
00876         putexpr(q);
00877         if(jumplab) {
00878                 exif(mkexpr(OPNE, cpexpr(IOSTP), ICON(0)));
00879                 exgoto(execlab(jumplab));
00880                 exendif();
00881                 }
00882         tyint = tyintsave;
00883 }

Here is the call graph for this function:

Here is the caller graph for this function:

void setfmt ( struct Labelblock lp  ) 

Definition at line 321 of file io.c.

References flline(), lexline(), lp, mem(), n, s, str_fmt, t, warn(), warn1(), and warni().

Referenced by yyparse().

00323 {
00324         char *s, *s0, *sc, *se, *t;
00325         int k, n, parity;
00326 
00327         s0 = s = lexline(&n);
00328         se = t = s + n;
00329 
00330         /* warn of trivial errors, e.g. "  11 CONTINUE" (one too few spaces) */
00331         /* following FORMAT... */
00332 
00333         if (n <= 0)
00334                 warn("No (...) after FORMAT");
00335         else if (*s != '(')
00336                 warni("%c rather than ( after FORMAT", *s);
00337         else if (se[-1] != ')') {
00338                 *se = 0;
00339                 while(--t > s && *t != ')') ;
00340                 if (t <= s)
00341                         warn("No ) at end of FORMAT statement");
00342                 else if (se - t > 30)
00343                         warn1("Extraneous text at end of FORMAT: ...%s", se-12);
00344                 else
00345                         warn1("Extraneous text at end of FORMAT: %s", t+1);
00346                 t = se;
00347                 }
00348 
00349         /* fix MYQUOTES (\002's) and \\'s */
00350 
00351         parity = 1;
00352         str_fmt['%'] = "%";
00353         while(s < se) {
00354                 k = *(unsigned char *)s++;
00355                 if (k == 2) {
00356                         if ((parity ^= 1) && *s == 2) {
00357                                 t -= 2;
00358                                 ++s;
00359                                 }
00360                         else
00361                                 t += 3;
00362                         }
00363                 else {
00364                         sc = str_fmt[k];
00365                         while(*++sc)
00366                                 t++;
00367                         }
00368                 }
00369         s = s0;
00370         parity = 1;
00371         if (lp) {
00372                 lp->fmtstring = t = mem((int)(t - s + 1), 0);
00373                 while(s < se) {
00374                         k = *(unsigned char *)s++;
00375                         if (k == 2) {
00376                                 if ((parity ^= 1) && *s == 2)
00377                                         s++;
00378                                 else {
00379                                         t[0] = '\\';
00380                                         t[1] = '0';
00381                                         t[2] = '0';
00382                                         t[3] = '2';
00383                                         t += 4;
00384                                         }
00385                                 }
00386                         else {
00387                                 sc = str_fmt[k];
00388                                 do *t++ = *sc++;
00389                                    while(*sc);
00390                                 }
00391                         }
00392                 *t = 0;
00393                 }
00394         str_fmt['%'] = "%%";
00395         flline();
00396 }

Here is the call graph for this function:

Here is the caller graph for this function:

void startioctl (  ) 

Definition at line 403 of file io.c.

References i, inioctl, nioctl, NIOS, NULL, UNFORMATTED, V, and YES.

00405 {
00406         register int i;
00407 
00408         inioctl = YES;
00409         nioctl = 0;
00410         ioformatted = UNFORMATTED;
00411         for(i = 1 ; i<=NIOS ; ++i)
00412                 V(i) = NULL;
00413 }

void startrw ( Void   ) 

Definition at line 938 of file io.c.

References ALLOC, asg_addr(), autovar(), call1(), CLNAMELIST, CLVAR, cpexpr(), ENULL, err, io_setup::fields, fixtype(), fmtstmt(), FORMATTED, frexpr(), ICON, Addrblock::ident, intfile(), io_structs, ioblkp, IOREAD, ioset(), ioseta(), IOSFMT, IOSREC, IOSTDIN, iostmt, IOSUNIT, ISCONST, ISICON, ISINT, isstatic(), lastvarno, LISTDIRECTED, lp, Addrblock::memno, Addrblock::memoffset, mkaddcon(), mklabel(), mkscalar(), MSKSTATIC, NAMEDIRECTED, new_iob_data(), nioctl, NO, NULL, ok, ONEOF, p, putiocall(), STGINIT, TADDR, Addrblock::tag, temp_name(), TPRIM, TYADDR, TYCHAR, TYINT, TYIOINT, io_setup::type, UNAM_IDENT, UNFORMATTED, Addrblock::user, V, vardcl(), Addrblock::vclass, Nameblock::vclass, Nameblock::vdim, Addrblock::vleng, Addrblock::vstg, Nameblock::vstg, Addrblock::vtype, Nameblock::vtype, XEND, XERR, XFMT, XIEND, XIFMT, XIRLEN, XIRNUM, XIUNIT, XREC, XUNIT, and YES.

Referenced by endioctl().

00939 {
00940         register expptr p;
00941         register Namep np;
00942         register Addrp unitp, fmtp, recp;
00943         register expptr nump;
00944         int iostmt1;
00945         flag intfile, sequential, ok, varfmt;
00946         struct io_setup *ios;
00947 
00948         /* First look at all the parameters and determine what is to be done */
00949 
00950         ok = YES;
00951         statstruct = YES;
00952 
00953         intfile = NO;
00954         if(p = V(IOSUNIT))
00955         {
00956                 if( ISINT(p->headblock.vtype) ) {
00957  int_unit:
00958                         unitp = (Addrp) cpexpr(p);
00959                         }
00960                 else if(p->headblock.vtype == TYCHAR)
00961                 {
00962                         if (nioctl == 1 && iostmt == IOREAD) {
00963                                 /* kludge to recognize READ(format expr) */
00964                                 V(IOSFMT) = p;
00965                                 V(IOSUNIT) = p = (expptr) IOSTDIN;
00966                                 ioformatted = FORMATTED;
00967                                 goto int_unit;
00968                                 }
00969                         intfile = YES;
00970                         if(p->tag==TPRIM && p->primblock.argsp==NULL &&
00971                             (np = p->primblock.namep)->vdim!=NULL)
00972                         {
00973                                 vardcl(np);
00974                                 if(nump = np->vdim->nelt)
00975                                 {
00976                                         nump = fixtype(cpexpr(nump));
00977                                         if( ! ISCONST(nump) ) {
00978                                                 statstruct = NO;
00979                                                 np->vlastdim = 0;
00980                                                 }
00981                                 }
00982                                 else
00983                                 {
00984                                         err("attempt to use internal unit array of unknown size");
00985                                         ok = NO;
00986                                         nump = ICON(1);
00987                                 }
00988                                 unitp = mkscalar(np);
00989                         }
00990                         else    {
00991                                 nump = ICON(1);
00992                                 unitp = (Addrp /*pjw */) fixtype(cpexpr(p));
00993                         }
00994                         if(! isstatic((expptr)unitp) )
00995                                 statstruct = NO;
00996                 }
00997                 else {
00998                         err("unit specifier not of type integer or character");
00999                         ok = NO;
01000                         }
01001         }
01002         else
01003         {
01004                 err("bad unit specifier");
01005                 ok = NO;
01006         }
01007 
01008         sequential = YES;
01009         if(p = V(IOSREC))
01010                 if( ISINT(p->headblock.vtype) )
01011                 {
01012                         recp = (Addrp) cpexpr(p);
01013                         sequential = NO;
01014                 }
01015                 else    {
01016                         err("bad REC= clause");
01017                         ok = NO;
01018                 }
01019         else
01020                 recp = NULL;
01021 
01022 
01023         varfmt = YES;
01024         fmtp = NULL;
01025         if(p = V(IOSFMT))
01026         {
01027                 if(p->tag==TPRIM && p->primblock.argsp==NULL)
01028                 {
01029                         np = p->primblock.namep;
01030                         if(np->vclass == CLNAMELIST)
01031                         {
01032                                 ioformatted = NAMEDIRECTED;
01033                                 fmtp = (Addrp) fixtype(p);
01034                                 V(IOSFMT) = (expptr)fmtp;
01035                                 if (skiplab)
01036                                         jumplab = 0;
01037                                 goto endfmt;
01038                         }
01039                         vardcl(np);
01040                         if(np->vdim)
01041                         {
01042                                 if( ! ONEOF(np->vstg, MSKSTATIC) )
01043                                         statstruct = NO;
01044                                 fmtp = mkscalar(np);
01045                                 goto endfmt;
01046                         }
01047                         if( ISINT(np->vtype) )  /* ASSIGNed label */
01048                         {
01049                                 statstruct = NO;
01050                                 varfmt = YES;
01051                                 fmtp = asg_addr(p);
01052                                 goto endfmt;
01053                         }
01054                 }
01055                 p = V(IOSFMT) = fixtype(p);
01056                 if(p->headblock.vtype == TYCHAR
01057                         /* Since we allow write(6,n)            */
01058                         /* we may as well allow write(6,n(2))   */
01059                 || p->tag == TADDR && ISINT(p->addrblock.vtype))
01060                 {
01061                         if( ! isstatic(p) )
01062                                 statstruct = NO;
01063                         fmtp = (Addrp) cpexpr(p);
01064                 }
01065                 else if( ISICON(p) )
01066                 {
01067                         struct Labelblock *lp;
01068                         lp = mklabel(p->constblock.Const.ci);
01069                         if (fmtstmt(lp) > 0)
01070                         {
01071                                 fmtp = (Addrp)mkaddcon(lp->stateno);
01072                                 /* lp->stateno for names fmt_nnn */
01073                                 lp->fmtlabused = 1;
01074                                 varfmt = NO;
01075                         }
01076                         else
01077                                 ioformatted = UNFORMATTED;
01078                 }
01079                 else    {
01080                         err("bad format descriptor");
01081                         ioformatted = UNFORMATTED;
01082                         ok = NO;
01083                 }
01084         }
01085         else
01086                 fmtp = NULL;
01087 
01088 endfmt:
01089         if(intfile) {
01090                 if (ioformatted==UNFORMATTED) {
01091                         err("unformatted internal I/O not allowed");
01092                         ok = NO;
01093                         }
01094                 if (recp) {
01095                         err("direct internal I/O not allowed");
01096                         ok = NO;
01097                         }
01098                 }
01099         if(!sequential && ioformatted==LISTDIRECTED)
01100         {
01101                 err("direct list-directed I/O not allowed");
01102                 ok = NO;
01103         }
01104         if(!sequential && ioformatted==NAMEDIRECTED)
01105         {
01106                 err("direct namelist I/O not allowed");
01107                 ok = NO;
01108         }
01109 
01110         if( ! ok ) {
01111                 statstruct = NO;
01112                 return;
01113                 }
01114 
01115         /*
01116    Now put out the I/O structure, statically if all the clauses
01117    are constants, dynamically otherwise
01118 */
01119 
01120         if (intfile) {
01121                 ios = io_stuff + iostmt;
01122                 iostmt1 = IOREAD;
01123                 }
01124         else {
01125                 ios = io_stuff;
01126                 iostmt1 = 0;
01127                 }
01128         io_fields = ios->fields;
01129         if(statstruct)
01130         {
01131                 ioblkp = ALLOC(Addrblock);
01132                 ioblkp->tag = TADDR;
01133                 ioblkp->vtype = ios->type;
01134                 ioblkp->vclass = CLVAR;
01135                 ioblkp->vstg = STGINIT;
01136                 ioblkp->memno = ++lastvarno;
01137                 ioblkp->memoffset = ICON(0);
01138                 ioblkp -> uname_tag = UNAM_IDENT;
01139                 new_iob_data(ios,
01140                         temp_name("io_", lastvarno, ioblkp->user.ident));                       }
01141         else if(!(ioblkp = io_structs[iostmt1]))
01142                 io_structs[iostmt1] = ioblkp =
01143                         autovar(1, ios->type, ENULL, "");
01144 
01145         ioset(TYIOINT, XERR, ICON(errbit));
01146         if(iostmt == IOREAD)
01147                 ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );
01148 
01149         if(intfile)
01150         {
01151                 ioset(TYIOINT, XIRNUM, nump);
01152                 ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
01153                 ioseta(XIUNIT, unitp);
01154         }
01155         else
01156                 ioset(TYIOINT, XUNIT, (expptr) unitp);
01157 
01158         if(recp)
01159                 ioset(TYIOINT, /* intfile ? XIREC : */ XREC, (expptr) recp);
01160 
01161         if(varfmt)
01162                 ioseta( intfile ? XIFMT : XFMT , fmtp);
01163         else
01164                 ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);
01165 
01166         ioroutine[0] = 's';
01167         ioroutine[1] = '_';
01168         ioroutine[2] = iostmt==IOREAD ? 'r' : 'w';
01169         ioroutine[3] = "ds"[sequential];
01170         ioroutine[4] = "ufln"[ioformatted];
01171         ioroutine[5] = "ei"[intfile];
01172         ioroutine[6] = '\0';
01173 
01174         putiocall( call1(TYINT, ioroutine, cpexpr((expptr)ioblkp) ));
01175 
01176         if(statstruct)
01177         {
01178                 frexpr((expptr)ioblkp);
01179                 statstruct = NO;
01180                 ioblkp = 0;     /* unnecessary */
01181         }
01182 }

Here is the call graph for this function:

Here is the caller graph for this function:


Variable Documentation

LOCAL char* alist_names[]

Initial value:

 {
        "alist",
        "aerr",
        "aunit"
        }

Definition at line 236 of file io.c.

int byterev

Definition at line 51 of file main.c.

Referenced by putio().

LOCAL char* cilist_names[]

Initial value:

 {
        "cilist",
        "cierr",
        "ciunit",
        "ciend",
        "cifmt",
        "cirec"
        }

Definition at line 201 of file io.c.

LOCAL char* cllist_names[]

Initial value:

 {
        "cllist",
        "cerr",
        "cunit",
        "csta"
        }

Definition at line 230 of file io.c.

LOCAL int endbit

Definition at line 58 of file io.c.

LOCAL int errbit

Definition at line 59 of file io.c.

LOCAL char* icilist_names[]

Initial value:

 {
        "icilist",
        "icierr",
        "iciunit",
        "iciend",
        "icifmt",
        "icirlen",
        "icirnum"
        }

Definition at line 209 of file io.c.

LOCAL char* inlist_names[]

Initial value:

 {
        "inlist",
        "inerr",
        "inunit",
        "infile",
        "infilen",
        "inex",
        "inopen",
        "innum",
        "innamed",
        "inname",
        "innamlen",
        "inacc",
        "inacclen",
        "inseq",
        "inseqlen",
        "indir",
        "indirlen",
        "infmt",
        "infmtlen",
        "inform",
        "informlen",
        "inunf",
        "inunflen",
        "inrecl",
        "innrec",
        "inblank",
        "inblanklen"
        }

Definition at line 241 of file io.c.

int inqmask

Definition at line 87 of file main.c.

Referenced by iosetip(), and set_externs().

LOCAL char** io_fields

Definition at line 271 of file io.c.

Addrp io_structs[9]

Definition at line 52 of file io.c.

Referenced by endioctl(), procinit(), and startrw().

LOCAL io_setup io_stuff[]

Initial value:

Definition at line 275 of file io.c.

iob_data* iob_list

Definition at line 51 of file io.c.

Referenced by ioset(), ioseta(), new_iob_data(), procinit(), and write_ioblocks().

Addrp ioblkp

Definition at line 65 of file io.c.

Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioset(), and startrw().

LOCAL struct Ioclist ioc[ ]

Referenced by ioclause(), iocname(), and iosetip().

int iocalladdr = TYADDR

Definition at line 762 of file io.c.

Referenced by typekludge().

LOCAL long ioendlab

Definition at line 56 of file io.c.

LOCAL long ioerrlab

Definition at line 57 of file io.c.

LOCAL int ioformatted

Definition at line 62 of file io.c.

LOCAL char ioroutine[12]

Definition at line 54 of file io.c.

int ioset_assign = OPASSIGN [static]

Definition at line 1288 of file io.c.

LOCAL long jumplab

Definition at line 60 of file io.c.

LOCAL char* olist_names[]

Initial value:

 {
        "olist",
        "oerr",
        "ounit",
        "ofnm",
        "ofnmlen",
        "osta",
        "oacc",
        "ofm",
        "orl",
        "oblnk"
        }

Definition at line 218 of file io.c.

LOCAL long skiplab

Definition at line 61 of file io.c.

LOCAL struct Labelblock* skiplabel

Definition at line 64 of file io.c.

Referenced by endio(), and newiolabel().

LOCAL int statstruct = NO

Definition at line 63 of file io.c.

int typeconv[TYERROR+1]

Initial value:

 {

                0, 1, 11, 2, 3, 14, 4, 5, 6, 7, 12, 13, 8, 9, 10, 15



                }

Definition at line 763 of file io.c.


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