#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_data * | iob_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 Labelblock * | skiplabel |
| 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 FORMATTED 1 |
| #define IOSACCESS 10 |
| #define IOSBLANK 12 |
| #define IOSDIRECT 19 |
| #define IOSEND 4 |
| #define IOSERR 3 |
| #define IOSEXISTS 13 |
| #define IOSFILE 8 |
| #define IOSFORM 11 |
| #define IOSFORMATTED 20 |
| #define IOSIOSTAT 5 |
| #define IOSNAME 17 |
| #define IOSNAMED 16 |
| #define IOSNEXTREC 22 |
| #define IOSNML 23 |
| #define IOSNUMBER 15 |
| #define IOSOPENED 14 |
| #define IOSRECL 7 |
| #define IOSSEQUENTIAL 18 |
| #define IOSSTATUS 9 |
| #define IOSTP V(IOSIOSTAT) |
| #define IOSUNFORMATTED 21 |
| #define LISTDIRECTED 2 |
| #define NAMEDIRECTED 3 |
| #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 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 |
| #define XBLANK SZFLAG + 3*SZIOINT + 4*SZADDR |
| #define XCLSTATUS SZFLAG + SZIOINT |
| #define XDIRECT SZFLAG + 5*SZIOINT + 8*SZADDR |
| #define XDIRLEN SZFLAG + 5*SZIOINT + 9*SZADDR |
| #define XERR 0 |
| #define XEXISTS SZFLAG + 2*SZIOINT + SZADDR |
| #define XFILE SZFLAG + SZIOINT |
| #define XFILELEN SZFLAG + SZIOINT + SZADDR |
| #define XFMTED SZFLAG + 7*SZIOINT + 10*SZADDR |
| #define XFMTEDLEN SZFLAG + 7*SZIOINT + 11*SZADDR |
| #define XFNAMELEN SZFLAG + SZIOINT + SZADDR |
| #define XFORM SZFLAG + 6*SZIOINT + 9*SZADDR |
| #define XFORMATTED SZFLAG + 2*SZIOINT + 3*SZADDR |
| #define XFORMLEN SZFLAG + 6*SZIOINT + 10*SZADDR |
| #define XIRNUM 2*SZFLAG + 2*SZADDR + SZIOINT |
| #define XNAME SZFLAG + 2*SZIOINT + 5*SZADDR |
| #define XNAMED SZFLAG + 2*SZIOINT + 4*SZADDR |
| #define XNAMELEN SZFLAG + 2*SZIOINT + 6*SZADDR |
| #define XNEXTREC SZFLAG + 9*SZIOINT + 13*SZADDR |
| #define XNUMBER SZFLAG + 2*SZIOINT + 3*SZADDR |
| #define XOPEN SZFLAG + 2*SZIOINT + 2*SZADDR |
| #define XQACCESS SZFLAG + 3*SZIOINT + 6*SZADDR |
| #define XQACCLEN SZFLAG + 3*SZIOINT + 7*SZADDR |
| #define XQBLANK SZFLAG + 9*SZIOINT + 14*SZADDR |
| #define XQBLANKLEN SZFLAG + 9*SZIOINT + 15*SZADDR |
| #define XQRECL SZFLAG + 9*SZIOINT + 12*SZADDR |
| #define XREC 2*SZFLAG + SZIOINT + SZADDR |
| #define XRECLEN SZFLAG + 2*SZIOINT + 4*SZADDR |
| #define XSEQ SZFLAG + 4*SZIOINT + 7*SZADDR |
| #define XSEQLEN SZFLAG + 4*SZIOINT + 8*SZADDR |
| #define XSTATUS SZFLAG + 2*SZIOINT + SZADDR |
| #define XUNFMT SZFLAG + 8*SZIOINT + 11*SZADDR |
| #define XUNFMTLEN SZFLAG + 8*SZIOINT + 12*SZADDR |
| #define XUNIT SZFLAG |
Definition at line 146 of file io.c.
Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), and startrw().
| static void putiocall Argdcl | ( | (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:

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:

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:

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:

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:

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:

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:

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:

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 | ( | ) |
| 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:

| LOCAL char* alist_names[] |
| LOCAL char* cilist_names[] |
| LOCAL char* cllist_names[] |
| LOCAL char* icilist_names[] |
| 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"
}
| Addrp io_structs[9] |
Initial value:
{
zork(cilist_names, TYCILIST),
zork(inlist_names, TYINLIST),
zork(olist_names, TYOLIST),
zork(cllist_names, TYCLLIST),
zork(alist_names, TYALIST),
zork(alist_names, TYALIST),
zork(alist_names, TYALIST),
zork(icilist_names,TYICILIST),
zork(icilist_names,TYICILIST)
}
Definition at line 51 of file io.c.
Referenced by ioset(), ioseta(), new_iob_data(), procinit(), and write_ioblocks().
Definition at line 65 of file io.c.
Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioset(), and startrw().
Referenced by ioclause(), iocname(), and iosetip().
| int iocalladdr = TYADDR |
| LOCAL int ioformatted |
int ioset_assign = OPASSIGN [static] |
| LOCAL char* olist_names[] |
| LOCAL struct Labelblock* skiplabel |
| LOCAL int statstruct = NO |
1.5.1