Doxygen Source Code Documentation
io.c File Reference
#include "defs.h"
#include "names.h"
#include "iob.h"
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 | |
void dofclose | Argdcl ((void)) |
void dofmove | Argdcl ((char *)) |
void doiolist | Argdcl ((chainp)) |
void ioset | Argdcl ((int, int, expptr)) |
void ioseta | Argdcl ((int, Addrp)) |
void iosetc | Argdcl ((int, expptr)) |
void iosetip | Argdcl ((int, int)) |
void iosetlc | Argdcl ((int, int, int)) |
void putio | Argdcl ((expptr, expptr)) |
void putiocall | Argdcl ((expptr)) |
int | fmtstmt (register struct Labelblock *lp) |
void | setfmt (struct Labelblock *lp) |
void | startioctl () |
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] |
int | ioset_assign = OPASSIGN |
Define Documentation
|
Definition at line 68 of file f2cdir/io.c. Referenced by ioclause(), putio(), and startrw(). |
|
Definition at line 74 of file f2cdir/io.c. |
|
Definition at line 121 of file f2cdir/io.c. Referenced by dofinquire(), and dofopen(). |
|
Definition at line 123 of file f2cdir/io.c. Referenced by dofinquire(), and dofopen(). |
|
Definition at line 130 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 115 of file f2cdir/io.c. Referenced by endioctl(). |
|
Definition at line 114 of file f2cdir/io.c. Referenced by endioctl(). |
|
Definition at line 124 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 119 of file f2cdir/io.c. Referenced by dofinquire(), dofopen(), and ioclause(). |
|
Definition at line 122 of file f2cdir/io.c. Referenced by dofinquire(), and dofopen(). |
|
Definition at line 131 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 116 of file f2cdir/io.c. Referenced by endioctl(). |
|
Definition at line 128 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 127 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 133 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 134 of file f2cdir/io.c. Referenced by ioclause(). |
|
Definition at line 126 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 125 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 117 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 118 of file f2cdir/io.c. Referenced by dofinquire(), and dofopen(). |
|
Definition at line 129 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 120 of file f2cdir/io.c. Referenced by dofclose(), and dofopen(). |
|
Definition at line 136 of file f2cdir/io.c. Referenced by endio(), endioctl(), and putiocall(). |
|
Definition at line 132 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 69 of file f2cdir/io.c. Referenced by ioclause(), putio(), and startrw(). |
|
Definition at line 70 of file f2cdir/io.c. |
|
Definition at line 110 of file f2cdir/io.c. Referenced by endioctl(), iocname(), and startioctl(). |
|
Definition at line 141 of file f2cdir/io.c. |
|
Definition at line 30 of file f2cdir/io.c. |
|
Definition at line 29 of file f2cdir/io.c. Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioset(), iosetlc(), and startrw(). |
|
Definition at line 67 of file f2cdir/io.c. Referenced by startioctl(), and startrw(). |
|
Definition at line 72 of file f2cdir/io.c. Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), iosetip(), iosetlc(), startioctl(), and startrw(). |
|
Definition at line 165 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 168 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 172 of file f2cdir/io.c. Referenced by dofclose(). |
|
Definition at line 188 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 189 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 147 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 145 of file f2cdir/io.c. Referenced by endioctl(), and startrw(). |
|
Definition at line 178 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 176 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 177 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 148 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 192 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 193 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 162 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 163 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 190 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 166 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 191 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 154 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 155 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 158 of file f2cdir/io.c. |
|
Definition at line 156 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 157 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 153 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 182 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 181 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 183 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 197 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 180 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 179 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 184 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 185 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 198 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 199 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 196 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 149 of file f2cdir/io.c. Referenced by startrw(). |
|
Definition at line 167 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 186 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 187 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 164 of file f2cdir/io.c. Referenced by dofopen(). |
|
Definition at line 194 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 195 of file f2cdir/io.c. Referenced by dofinquire(). |
|
Definition at line 146 of file f2cdir/io.c. Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), and startrw(). |
|
Definition at line 273 of file f2cdir/io.c. Referenced by killit_CB(), and matrix_print(). |
Function Documentation
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Definition at line 918 of file f2cdir/io.c. References ALLOC, badtag(), fmtname(), ICON, Addrblock::isarray, Addrblock::memoffset, Primblock::namep, Addrblock::ntempelt, Expression::primblock, STGAUTO, TADDR, Addrblock::tag, Expression::tag, TPRIM, Addrblock::vstg, and Addrblock::vtype. Referenced by startrw().
00920 { 00921 register Addrp q; 00922 00923 if (p->tag != TPRIM) 00924 badtag("asg_addr", p->tag); 00925 q = ALLOC(Addrblock); 00926 q->tag = TADDR; 00927 q->vtype = TYCHAR; 00928 q->vstg = STGAUTO; 00929 q->ntempelt = 1; 00930 q->isarray = 0; 00931 q->memoffset = ICON(0); 00932 fmtname(p->primblock.namep, q); 00933 return q; 00934 } |
|
Definition at line 1220 of file f2cdir/io.c. References call1(), cpexpr(), err, Expression::headblock, ioblkp, ioset(), iosetc(), IOSSTATUS, IOSUNIT, ISINT, putiocall(), TYINT, TYIOINT, V, Headblock::vtype, XCLSTATUS, and XUNIT. Referenced by endioctl().
01221 { 01222 register expptr p; 01223 01224 if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) ) 01225 { 01226 ioset(TYIOINT, XUNIT, cpexpr(p) ); 01227 iosetc(XCLSTATUS, V(IOSSTATUS)); 01228 putiocall( call1(TYINT, "f_clos", cpexpr((expptr)ioblkp)) ); 01229 } 01230 else 01231 err("bad unit in close statement"); 01232 } |
|
|
Definition at line 1273 of file f2cdir/io.c. References call1(), cpexpr(), err, Expression::headblock, ioblkp, ioset(), IOSUNIT, ISINT, putiocall(), TYINT, TYIOINT, V, Headblock::vtype, and XUNIT. Referenced by endioctl().
|
|
|
Definition at line 649 of file f2cdir/io.c. References call0(), doiolist(), err, ioformatted, ioroutine, jumplab, NAMEDIRECTED, putiocall(), and TYINT. Referenced by yyparse().
00651 { 00652 if(ioformatted == NAMEDIRECTED) 00653 { 00654 if(list) 00655 err("no I/O list allowed in NAMELIST read/write"); 00656 } 00657 else 00658 { 00659 doiolist(list); 00660 ioroutine[0] = 'e'; 00661 if (skiplab) 00662 jumplab = 0; 00663 putiocall( call0(TYINT, ioroutine) ); 00664 } 00665 } |
|
Definition at line 676 of file f2cdir/io.c. References Expression::addrblock, Primblock::argsp, charptr, Expression::constblock, cpexpr(), Impldoblock::datalist, Chain::datap, enddo(), err, exdo(), fixtype(), frchain(), free, frexpr(), Expression::headblock, ICON, Impldoblock::impdospec, Expression::impldoblock, IOWRITE, ISCHAR, ISCOMPLEX, ISCONST, lencat(), memversion(), mkscalar(), mktmp(), Primblock::namep, Dimblock::nelt, newlabel(), Chain::nextp, ohalign, Expression::primblock, putconst(), puteq(), putio(), q, TADDR, Expression::tag, TCONST, TIMPLDO, TPRIM, TYERROR, UNAM_CONST, Addrblock::uname_tag, vardcl(), Nameblock::vdim, Nameblock::vlastdim, Headblock::vleng, Headblock::vtype, and Constblock::vtype. Referenced by doio().
00678 { 00679 chainp p; 00680 register tagptr q; 00681 register expptr qe; 00682 register Namep qn; 00683 Addrp tp; 00684 int range; 00685 extern char *ohalign; 00686 00687 for (p = p0 ; p ; p = p->nextp) 00688 { 00689 q = (tagptr)p->datap; 00690 if(q->tag == TIMPLDO) 00691 { 00692 exdo(range = (int)newlabel(), (Namep)0, 00693 q->impldoblock.impdospec); 00694 doiolist(q->impldoblock.datalist); 00695 enddo(range); 00696 free( (charptr) q); 00697 } 00698 else { 00699 if(q->tag==TPRIM && q->primblock.argsp==NULL 00700 && q->primblock.namep->vdim!=NULL) 00701 { 00702 vardcl(qn = q->primblock.namep); 00703 if(qn->vdim->nelt) { 00704 putio( fixtype(cpexpr(qn->vdim->nelt)), 00705 (expptr)mkscalar(qn) ); 00706 qn->vlastdim = 0; 00707 } 00708 else 00709 err("attempt to i/o array of unknown size"); 00710 } 00711 else if(q->tag==TPRIM && q->primblock.argsp==NULL && 00712 (qe = (expptr) memversion(q->primblock.namep)) ) 00713 putio(ICON(1),qe); 00714 else if (ISCONST(q) && q->constblock.vtype == TYCHAR) { 00715 halign = 0; 00716 putio(ICON(1), qe = fixtype(cpexpr(q))); 00717 halign = ohalign; 00718 } 00719 else if(((qe = fixtype(cpexpr(q)))->tag==TADDR && 00720 (qe->addrblock.uname_tag != UNAM_CONST || 00721 !ISCOMPLEX(qe -> addrblock.vtype))) || 00722 (qe -> tag == TCONST && !ISCOMPLEX(qe -> 00723 headblock.vtype))) { 00724 if (qe -> tag == TCONST) 00725 qe = (expptr) putconst((Constp)qe); 00726 putio(ICON(1), qe); 00727 } 00728 else if(qe->headblock.vtype != TYERROR) 00729 { 00730 if(iostmt == IOWRITE) 00731 { 00732 expptr qvl; 00733 qvl = NULL; 00734 if( ISCHAR(qe) ) 00735 { 00736 qvl = (expptr) 00737 cpexpr(qe->headblock.vleng); 00738 tp = mktmp(qe->headblock.vtype, 00739 ICON(lencat(qe))); 00740 } 00741 else 00742 tp = mktmp(qe->headblock.vtype, 00743 qe->headblock.vleng); 00744 puteq( cpexpr((expptr)tp), qe); 00745 if(qvl) /* put right length on block */ 00746 { 00747 frexpr(tp->vleng); 00748 tp->vleng = qvl; 00749 } 00750 putio(ICON(1), (expptr)tp); 00751 } 00752 else 00753 err("non-left side in READ list"); 00754 } 00755 frexpr(q); 00756 } 00757 } 00758 frchain( &p0 ); 00759 } |
|
Definition at line 831 of file f2cdir/io.c. References cpexpr(), execlab(), exendif(), exgoto(), exif(), frexpr(), ICON, ioendlab, ioerrlab, ioformatted, IOREAD, IOSTP, IOWRITE, mkexpr(), NAMEDIRECTED, OPGT, OPLT, OPNE, and p1_label(). Referenced by yyparse().
00832 { 00833 if(skiplab) 00834 { 00835 if (ioformatted != NAMEDIRECTED) 00836 p1_label((long)(skiplabel - labeltab)); 00837 if(ioendlab) { 00838 exif( mkexpr(OPLT, cpexpr(IOSTP), ICON(0))); 00839 exgoto(execlab(ioendlab)); 00840 exendif(); 00841 } 00842 if(ioerrlab) { 00843 exif( mkexpr(iostmt==IOREAD||iostmt==IOWRITE 00844 ? OPGT : OPNE, 00845 cpexpr(IOSTP), ICON(0))); 00846 exgoto(execlab(ioerrlab)); 00847 exendif(); 00848 } 00849 } 00850 00851 if(IOSTP) 00852 frexpr(IOSTP); 00853 } |
|
Definition at line 424 of file f2cdir/io.c. References autovar(), Constant::ci, Constblock::Const, Expression::constblock, dofclose(), dofinquire(), dofmove(), dofopen(), endbit, ENULL, err, errbit, execlab(), fatali(), io_setup::fields, frexpr(), i, ICON, io_fields, io_stuff, IOBACKSPACE, ioblkp, IOCLOSE, IOENDFILE, ioendlab, ioerrlab, IOINQUIRE, IOOPEN, IOREAD, IOREWIND, IOSEND, IOSERR, ioset(), IOSIOSTAT, IOSTP, IOWRITE, ISICON, ISINT, jumplab, mktmp(), newiolabel(), NIOS, NO, p, skiplab, startrw(), TADDR, TYINT, TYIOINT, io_setup::type, V, and XERR. Referenced by yyparse().
00425 { 00426 int i; 00427 expptr p; 00428 struct io_setup *ios; 00429 00430 inioctl = NO; 00431 00432 /* set up for error recovery */ 00433 00434 ioerrlab = ioendlab = skiplab = jumplab = 0; 00435 00436 if(p = V(IOSEND)) 00437 if(ISICON(p)) 00438 execlab(ioendlab = p->constblock.Const.ci); 00439 else 00440 err("bad end= clause"); 00441 00442 if(p = V(IOSERR)) 00443 if(ISICON(p)) 00444 execlab(ioerrlab = p->constblock.Const.ci); 00445 else 00446 err("bad err= clause"); 00447 00448 if(IOSTP) 00449 if(IOSTP->tag!=TADDR || ! ISINT(IOSTP->addrblock.vtype) ) 00450 { 00451 err("iostat must be an integer variable"); 00452 frexpr(IOSTP); 00453 IOSTP = NULL; 00454 } 00455 00456 if(iostmt == IOREAD) 00457 { 00458 if(IOSTP) 00459 { 00460 if(ioerrlab && ioendlab && ioerrlab==ioendlab) 00461 jumplab = ioerrlab; 00462 else 00463 skiplab = jumplab = newiolabel(); 00464 } 00465 else { 00466 if(ioerrlab && ioendlab && ioerrlab!=ioendlab) 00467 { 00468 IOSTP = (expptr) mktmp(TYINT, ENULL); 00469 skiplab = jumplab = newiolabel(); 00470 } 00471 else 00472 jumplab = (ioerrlab ? ioerrlab : ioendlab); 00473 } 00474 } 00475 else if(iostmt == IOWRITE) 00476 { 00477 if(IOSTP && !ioerrlab) 00478 skiplab = jumplab = newiolabel(); 00479 else 00480 jumplab = ioerrlab; 00481 } 00482 else 00483 jumplab = ioerrlab; 00484 00485 endbit = IOSTP!=NULL || ioendlab!=0; /* for use in startrw() */ 00486 errbit = IOSTP!=NULL || ioerrlab!=0; 00487 if (jumplab && !IOSTP) 00488 IOSTP = (expptr) mktmp(TYINT, ENULL); 00489 00490 if(iostmt!=IOREAD && iostmt!=IOWRITE) 00491 { 00492 ios = io_stuff + iostmt; 00493 io_fields = ios->fields; 00494 ioblkp = io_structs[iostmt]; 00495 if(ioblkp == NULL) 00496 io_structs[iostmt] = ioblkp = 00497 autovar(1, ios->type, ENULL, ""); 00498 ioset(TYIOINT, XERR, ICON(errbit)); 00499 } 00500 00501 switch(iostmt) 00502 { 00503 case IOOPEN: 00504 dofopen(); 00505 break; 00506 00507 case IOCLOSE: 00508 dofclose(); 00509 break; 00510 00511 case IOINQUIRE: 00512 dofinquire(); 00513 break; 00514 00515 case IOBACKSPACE: 00516 dofmove("f_back"); 00517 break; 00518 00519 case IOREWIND: 00520 dofmove("f_rew"); 00521 break; 00522 00523 case IOENDFILE: 00524 dofmove("f_end"); 00525 break; 00526 00527 case IOREAD: 00528 case IOWRITE: 00529 startrw(); 00530 break; 00531 00532 default: 00533 fatali("impossible iostmt %d", iostmt); 00534 } 00535 for(i = 1 ; i<=NIOS ; ++i) 00536 if(i!=IOSIOSTAT && V(i)!=NULL) 00537 frexpr(V(i)); 00538 } |
|
Definition at line 890 of file f2cdir/io.c. References IDENT_LEN, mem(), mkchain(), UNAM_CHARP, UNAM_IDENT, Addrblock::uname_tag, and Addrblock::user. Referenced by asg_addr(), and exassign().
00892 { 00893 register int k; 00894 register char *s, *t; 00895 extern chainp assigned_fmts; 00896 00897 if (!np->vfmt_asg) { 00898 np->vfmt_asg = 1; 00899 assigned_fmts = mkchain((char *)np, assigned_fmts); 00900 } 00901 k = strlen(s = np->fvarname); 00902 if (k < IDENT_LEN - 4) { 00903 q->uname_tag = UNAM_IDENT; 00904 t = q->user.ident; 00905 } 00906 else { 00907 q->uname_tag = UNAM_CHARP; 00908 q->user.Charp = t = mem(k + 5,0); 00909 } 00910 sprintf(t, "%s_fmt", s); 00911 } |
|
Definition at line 294 of file f2cdir/io.c. References CNULL, execerr(), Labelblock::labelno, LABFORMAT, Labelblock::labtype, LABUNKNOWN, and newlabel(). 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 } |
|
Definition at line 577 of file f2cdir/io.c. References CLUNKNOWN, err, errstr(), fixtype(), FORMATTED, Expression::headblock, ioc, Ioclist::iocname, Ioclist::iocval, ioformatted, IOOPEN, IOREAD, IOSBAD, IOSFILE, IOSFMT, IOSNML, IOSPOSITIONAL, IOSTDIN, IOSTDOUT, IOSUNIT, LISTDIRECTED, Primblock::namep, NOEXT, Expression::primblock, Expression::tag, TPRIM, vardcl(), Nameblock::vclass, Nameblock::vtype, Primblock::vtype, and Headblock::vtype. Referenced by yyparse().
00579 { 00580 struct Ioclist *iocp; 00581 00582 ++nioctl; 00583 if(n == IOSBAD) 00584 return; 00585 if(n == IOSPOSITIONAL) 00586 { 00587 n = nioctl; 00588 if (n == IOSFMT) { 00589 if (iostmt == IOOPEN) { 00590 n = IOSFILE; 00591 NOEXT("file= specifier omitted from open"); 00592 } 00593 else if (iostmt < IOREAD) 00594 goto illegal; 00595 } 00596 else if(n > IOSFMT) 00597 { 00598 illegal: 00599 err("illegal positional iocontrol"); 00600 return; 00601 } 00602 } 00603 else if (n == IOSNML) 00604 n = IOSFMT; 00605 00606 if(p == NULL) 00607 { 00608 if(n == IOSUNIT) 00609 p = (expptr) (iostmt==IOREAD ? IOSTDIN : IOSTDOUT); 00610 else if(n != IOSFMT) 00611 { 00612 err("illegal * iocontrol"); 00613 return; 00614 } 00615 } 00616 if(n == IOSFMT) 00617 ioformatted = (p==NULL ? LISTDIRECTED : FORMATTED); 00618 00619 iocp = & ioc[n]; 00620 if(iocp->iocval == NULL) 00621 { 00622 if(n!=IOSFMT && ( n!=IOSUNIT || (p && p->headblock.vtype!=TYCHAR) ) ) 00623 p = fixtype(p); 00624 else if (p && p->tag == TPRIM 00625 && p->primblock.namep->vclass == CLUNKNOWN) { 00626 /* kludge made necessary by attempt to infer types 00627 * for untyped external parameters: given an error 00628 * in calling sequences, an integer argument might 00629 * tentatively be assumed TYCHAR; this would otherwise 00630 * be corrected too late in startrw after startrw 00631 * had decided this to be an internal file. 00632 */ 00633 vardcl(p->primblock.namep); 00634 p->primblock.vtype = p->primblock.namep->vtype; 00635 } 00636 iocp->iocval = p; 00637 } 00638 else 00639 errstr("iocontrol %s repeated", iocp->iocname); 00640 } |
|
Definition at line 542 of file f2cdir/io.c. References errstr(), i, ioc, iocname(), IOOPEN, M, NIOS, and NOEXT. Referenced by iocname(), iosetip(), and yyparse().
00543 { 00544 register int i; 00545 int found, mask; 00546 00547 found = 0; 00548 mask = M(iostmt); 00549 for(i = 1 ; i <= NIOS ; ++i) 00550 if(!strcmp(ioc[i].iocname, token)) 00551 if(ioc[i].iotype & mask) 00552 return(i); 00553 else { 00554 found = i; 00555 break; 00556 } 00557 if(found) { 00558 if (iostmt == IOOPEN && !strcmp(ioc[i].iocname, "name")) { 00559 NOEXT("open with \"name=\" treated as \"file=\""); 00560 for(i = 1; strcmp(ioc[i].iocname, "file"); i++); 00561 return i; 00562 } 00563 errstr("invalid control %s for statement", ioc[found].iocname); 00564 } 00565 else 00566 errstr("unknown iocontrol %s", token); 00567 return(IOSBAD); 00568 } |
|
Definition at line 1296 of file f2cdir/io.c. References ALLOC, badtype(), Constant::ci, Constblock::Const, Expression::constblock, iob_data::fields, frexpr(), Expression::headblock, ICON, io_fields, ioblkp, ioset_assign, Addrblock::isarray, ISCONST, Addrblock::memoffset, mkexpr(), iob_data::name, Addrblock::ntempelt, offset, putexpr(), statstruct, STGAUTO, string_num(), SZLONG, TADDR, Expression::tag, Addrblock::tag, TCONST, TYIOINT, UNAM_IDENT, Addrblock::uname_tag, Addrblock::user, Addrblock::vstg, Headblock::vtype, Constblock::vtype, and Addrblock::vtype. Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioseta(), iosetc(), iosetip(), iosetlc(), and startrw().
01298 { 01299 offset /= SZLONG; 01300 if(statstruct && ISCONST(p)) { 01301 register char *s; 01302 switch(type) { 01303 case TYADDR: /* stmt label */ 01304 s = "fmt_"; 01305 break; 01306 case TYIOINT: 01307 s = ""; 01308 break; 01309 default: 01310 badtype("ioset", type); 01311 } 01312 iob_list->fields[offset] = 01313 string_num(s, p->constblock.Const.ci); 01314 frexpr(p); 01315 } 01316 else { 01317 register Addrp q; 01318 01319 q = ALLOC(Addrblock); 01320 q->tag = TADDR; 01321 q->vtype = type; 01322 q->vstg = STGAUTO; 01323 q->ntempelt = 1; 01324 q->isarray = 0; 01325 q->memoffset = ICON(0); 01326 q->uname_tag = UNAM_IDENT; 01327 sprintf(q->user.ident, "%s.%s", 01328 statstruct ? iob_list->name : ioblkp->user.ident, 01329 io_fields[offset + 1]); 01330 if (type == TYADDR && p->tag == TCONST 01331 && p->constblock.vtype == TYADDR) { 01332 /* kludge */ 01333 register Addrp p1; 01334 p1 = ALLOC(Addrblock); 01335 p1->tag = TADDR; 01336 p1->vtype = type; 01337 p1->vstg = STGAUTO; /* wrong, but who cares? */ 01338 p1->ntempelt = 1; 01339 p1->isarray = 0; 01340 p1->memoffset = ICON(0); 01341 p1->uname_tag = UNAM_IDENT; 01342 sprintf(p1->user.ident, "fmt_%ld", 01343 p->constblock.Const.ci); 01344 frexpr(p); 01345 p = (expptr)p1; 01346 } 01347 if (type == TYADDR && p->headblock.vtype == TYCHAR) 01348 q->vtype = TYCHAR; 01349 putexpr(mkexpr(ioset_assign, (expptr)q, p)); 01350 } 01351 } |
|
Definition at line 1383 of file f2cdir/io.c. References addrof(), badtag(), badthing(), Extsym::cextname, Constant::ci, Constblock::Const, Expression::constblock, cpstring(), Extsym::curno, Nameblock::cvarname, ENULL, iob_data::fields, ICON, ioset(), Addrblock::isarray, mem(), Addrblock::memoffset, mkexpr(), NOEXT, offset, OPCHARCAST, STGCOMMON, SZLONG, TADDR, Expression::tag, Addrblock::tag, TCONST, tostring(), UNAM_CONST, UNAM_NAME, Addrblock::uname_tag, usedefsforcommon, Addrblock::user, Nameblock::vardesc, Nameblock::vcommequiv, Nameblock::visused, Addrblock::vleng, Nameblock::voffset, Nameblock::vstg, and Addrblock::vtype. Referenced by startrw().
01385 { 01386 char *s, *s1; 01387 static char who[] = "ioseta"; 01388 expptr e, mo; 01389 Namep np; 01390 ftnint ci; 01391 int k; 01392 char buf[24], buf1[24]; 01393 Extsym *comm; 01394 extern int usedefsforcommon; 01395 01396 if(statstruct) 01397 { 01398 if (!p) 01399 return; 01400 if (p->tag != TADDR) 01401 badtag(who, p->tag); 01402 offset /= SZLONG; 01403 switch(p->uname_tag) { 01404 case UNAM_NAME: 01405 mo = p->memoffset; 01406 if (mo->tag != TCONST) 01407 badtag("ioseta/memoffset", mo->tag); 01408 np = p->user.name; 01409 np->visused = 1; 01410 ci = mo->constblock.Const.ci - np->voffset; 01411 if (np->vstg == STGCOMMON 01412 && !np->vcommequiv 01413 && !usedefsforcommon) { 01414 comm = &extsymtab[np->vardesc.varno]; 01415 sprintf(buf, "%d.", comm->curno); 01416 k = strlen(buf) + strlen(comm->cextname) 01417 + strlen(np->cvarname); 01418 if (ci) { 01419 sprintf(buf1, "+%ld", ci); 01420 k += strlen(buf1); 01421 } 01422 else 01423 buf1[0] = 0; 01424 s = mem(k + 1, 0); 01425 sprintf(s, "%s%s%s%s", comm->cextname, buf, 01426 np->cvarname, buf1); 01427 } 01428 else if (ci) { 01429 sprintf(buf,"%ld", ci); 01430 s1 = p->user.name->cvarname; 01431 k = strlen(buf) + strlen(s1); 01432 sprintf(s = mem(k+2,0), "%s+%s", s1, buf); 01433 } 01434 else 01435 s = cpstring(np->cvarname); 01436 break; 01437 case UNAM_CONST: 01438 s = tostring(p->user.Const.ccp1.ccp0, 01439 (int)p->vleng->constblock.Const.ci); 01440 break; 01441 default: 01442 badthing("uname_tag", who, p->uname_tag); 01443 } 01444 /* kludge for Hollerith */ 01445 if (p->vtype != TYCHAR) { 01446 s1 = mem(strlen(s)+10,0); 01447 sprintf(s1, "(char *)%s%s", p->isarray ? "" : "&", s); 01448 s = s1; 01449 } 01450 iob_list->fields[offset] = s; 01451 } 01452 else { 01453 if (!p) 01454 e = ICON(0); 01455 else if (p->vtype != TYCHAR) { 01456 NOEXT("non-character variable as format or internal unit"); 01457 e = mkexpr(OPCHARCAST, (expptr)p, ENULL); 01458 } 01459 else 01460 e = addrof((expptr)p); 01461 ioset(TYADDR, offset, e); 01462 } 01463 } |
|
Definition at line 1362 of file f2cdir/io.c. References addrof(), cpexpr(), err, fixtype(), Expression::headblock, ICON, ioset(), offset, putchop(), putx(), and Headblock::vtype. Referenced by dofclose(), dofopen(), and iosetlc().
|
|
Definition at line 1474 of file f2cdir/io.c. References Expression::addrblock, addrof(), cpexpr(), errstr(), i, ICON, inqmask, ioc, iocname(), ioset(), ioset_assign, offset, ONEOF, OPASSIGN, OPASSIGNI, TADDR, Expression::tag, V, and Addrblock::vtype. Referenced by dofinquire().
01476 { 01477 register expptr p; 01478 01479 if(p = V(i)) 01480 if(p->tag==TADDR && 01481 ONEOF(p->addrblock.vtype, inqmask) ) { 01482 ioset_assign = OPASSIGNI; 01483 ioset(TYADDR, offset, addrof(cpexpr(p)) ); 01484 ioset_assign = OPASSIGN; 01485 } 01486 else 01487 errstr("impossible inquire parameter %s", ioc[i].iocname); 01488 else 01489 ioset(TYADDR, offset, ICON(0) ); 01490 } |
|
Definition at line 1501 of file f2cdir/io.c. References cpexpr(), Expression::headblock, i, ioset(), iosetc(), TYIOINT, V, Headblock::vleng, and Headblock::vtype. Referenced by dofinquire().
|
|
Definition at line 415 of file f2cdir/io.c. References Labelblock::labdefined, and mklabel(). Referenced by endioctl().
00415 { 00416 long rv; 00417 rv = ++lastiolabno; 00418 skiplabel = mklabel(rv); 00419 skiplabel->labdefined = 1; 00420 return rv; 00421 } |
|
Definition at line 776 of file f2cdir/io.c. References ALLOC, byterev, c, call2(), call3(), call4(), Addrblock::charleng, ENULL, fixtype(), FORMATTED, Expression::headblock, ICON, iocalladdr, ioformatted, Addrblock::isarray, ISCOMPLEX, ISCONST, LISTDIRECTED, M, mc, Addrblock::memoffset, mkconv(), mkexpr(), Addrblock::ntempelt, ONEOF, OPCHARCAST, OPSTAR, putconst(), putiocall(), q, STGAUTO, TADDR, Addrblock::tag, TYINT, TYLENG, typeconv, UNAM_IDENT, Addrblock::uname_tag, Addrblock::user, Addrblock::vstg, Addrblock::vtype, and Headblock::vtype. Referenced by doiolist().
00778 { 00779 int type; 00780 register expptr q; 00781 register Addrp c = 0; 00782 00783 type = addr->headblock.vtype; 00784 if(ioformatted!=LISTDIRECTED && ISCOMPLEX(type) ) 00785 { 00786 nelt = mkexpr(OPSTAR, ICON(2), nelt); 00787 type -= (TYCOMPLEX-TYREAL); 00788 } 00789 00790 /* pass a length with every item. for noncharacter data, fake one */ 00791 if(type != TYCHAR) 00792 { 00793 00794 if( ISCONST(addr) ) 00795 addr = (expptr) putconst((Constp)addr); 00796 c = ALLOC(Addrblock); 00797 c->tag = TADDR; 00798 c->vtype = TYLENG; 00799 c->vstg = STGAUTO; 00800 c->ntempelt = 1; 00801 c->isarray = 1; 00802 c->memoffset = ICON(0); 00803 c->uname_tag = UNAM_IDENT; 00804 c->charleng = 1; 00805 sprintf(c->user.ident, "(ftnlen)sizeof(%s)", typename[type]); 00806 addr = mkexpr(OPCHARCAST, addr, ENULL); 00807 } 00808 00809 nelt = fixtype( mkconv(tyioint,nelt) ); 00810 if(ioformatted == LISTDIRECTED) { 00811 expptr mc = mkconv(tyioint, ICON(typeconv[type])); 00812 q = c ? call4(TYINT, "do_lio", mc, nelt, addr, (expptr)c) 00813 : call3(TYINT, "do_lio", mc, nelt, addr); 00814 } 00815 else { 00816 char *s = ioformatted==FORMATTED ? "do_fio" 00817 : !byterev ? "do_uio" 00818 : ONEOF(type, M(TYCHAR)|M(TYINT1)|M(TYLOGICAL1)) 00819 ? "do_ucio" : "do_unio"; 00820 q = c ? call3(TYINT, s, nelt, addr, (expptr)c) 00821 : call2(TYINT, s, nelt, addr); 00822 } 00823 iocalladdr = TYCHAR; 00824 putiocall(q); 00825 iocalladdr = TYADDR; 00826 } |
|
Definition at line 862 of file f2cdir/io.c. References cpexpr(), execlab(), exendif(), exgoto(), exif(), fixexpr(), ICON, IOSTP, jumplab, mkexpr(), OPASSIGN, OPNE, putexpr(), q, and TYINT. Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), doio(), putio(), and startrw().
00864 { 00865 int tyintsave; 00866 00867 tyintsave = tyint; 00868 tyint = tyioint; /* for -I2 and -i2 */ 00869 00870 if(IOSTP) 00871 { 00872 q->headblock.vtype = TYINT; 00873 q = fixexpr((Exprp)mkexpr(OPASSIGN, cpexpr(IOSTP), q)); 00874 } 00875 putexpr(q); 00876 if(jumplab) { 00877 exif(mkexpr(OPNE, cpexpr(IOSTP), ICON(0))); 00878 exgoto(execlab(jumplab)); 00879 exendif(); 00880 } 00881 tyint = tyintsave; 00882 } |
|
Definition at line 321 of file f2cdir/io.c. References flline(), Labelblock::fmtstring, lexline(), mem(), warn(), warn1(), and warni(). Referenced by yyparse().
00323 { 00324 int n, parity; 00325 char *s0; 00326 register char *s, *se, *t; 00327 register k; 00328 00329 s0 = s = lexline(&n); 00330 se = t = s + n; 00331 00332 /* warn of trivial errors, e.g. " 11 CONTINUE" (one too few spaces) */ 00333 /* following FORMAT... */ 00334 00335 if (n <= 0) 00336 warn("No (...) after FORMAT"); 00337 else if (*s != '(') 00338 warni("%c rather than ( after FORMAT", *s); 00339 else if (se[-1] != ')') { 00340 *se = 0; 00341 while(--t > s && *t != ')') ; 00342 if (t <= s) 00343 warn("No ) at end of FORMAT statement"); 00344 else if (se - t > 30) 00345 warn1("Extraneous text at end of FORMAT: ...%s", se-12); 00346 else 00347 warn1("Extraneous text at end of FORMAT: %s", t+1); 00348 t = se; 00349 } 00350 00351 /* fix MYQUOTES (\002's) and \\'s */ 00352 00353 parity = 1; 00354 while(s < se) 00355 switch(*s++) { 00356 case 2: 00357 if ((parity ^= 1) && *s == 2) { 00358 t -= 2; 00359 ++s; 00360 } 00361 else 00362 t += 3; 00363 break; 00364 case '"': 00365 case '\\': 00366 t++; break; 00367 } 00368 s = s0; 00369 parity = 1; 00370 if (lp) { 00371 lp->fmtstring = t = mem((int)(t - s + 1), 0); 00372 while(s < se) 00373 switch(k = *s++) { 00374 case 2: 00375 if ((parity ^= 1) && *s == 2) 00376 s++; 00377 else { 00378 t[0] = '\\'; 00379 t[1] = '0'; 00380 t[2] = '0'; 00381 t[3] = '2'; 00382 t += 4; 00383 } 00384 break; 00385 case '"': 00386 case '\\': 00387 *t++ = '\\'; 00388 /* no break */ 00389 default: 00390 *t++ = k; 00391 } 00392 *t = 0; 00393 } 00394 flline(); 00395 } |
|
Definition at line 402 of file f2cdir/io.c. References i, ioformatted, NIOS, UNFORMATTED, V, and YES. Referenced by yyparse().
00404 { 00405 register int i; 00406 00407 inioctl = YES; 00408 nioctl = 0; 00409 ioformatted = UNFORMATTED; 00410 for(i = 1 ; i<=NIOS ; ++i) 00411 V(i) = NULL; 00412 } |
|
Definition at line 937 of file f2cdir/io.c. References Expression::addrblock, ALLOC, Primblock::argsp, asg_addr(), autovar(), call1(), Constant::ci, CLNAMELIST, CLVAR, Constblock::Const, Expression::constblock, cpexpr(), endbit, ENULL, err, errbit, io_setup::fields, fixtype(), Labelblock::fmtlabused, fmtstmt(), FORMATTED, frexpr(), Expression::headblock, ICON, io_fields, io_stuff, ioblkp, ioformatted, IOREAD, ioroutine, ioset(), ioseta(), IOSFMT, IOSREC, IOSTDIN, IOSUNIT, ISCONST, ISICON, ISINT, isstatic(), jumplab, LISTDIRECTED, Addrblock::memno, Addrblock::memoffset, mkaddcon(), mklabel(), mkscalar(), MSKSTATIC, NAMEDIRECTED, Primblock::namep, Dimblock::nelt, new_iob_data(), NO, ONEOF, Expression::primblock, putiocall(), Labelblock::stateno, statstruct, STGINIT, TADDR, Addrblock::tag, Expression::tag, temp_name(), TPRIM, TYINT, TYIOINT, io_setup::type, UNAM_IDENT, UNFORMATTED, Addrblock::user, V, vardcl(), Addrblock::vclass, Nameblock::vclass, Nameblock::vdim, Nameblock::vlastdim, Addrblock::vleng, Addrblock::vstg, Nameblock::vstg, Addrblock::vtype, Nameblock::vtype, Headblock::vtype, XEND, XERR, XFMT, XIEND, XIFMT, XIRLEN, XIRNUM, XIUNIT, XREC, XUNIT, and YES. Referenced by endioctl().
00938 { 00939 register expptr p; 00940 register Namep np; 00941 register Addrp unitp, fmtp, recp; 00942 register expptr nump; 00943 int iostmt1; 00944 flag intfile, sequential, ok, varfmt; 00945 struct io_setup *ios; 00946 00947 /* First look at all the parameters and determine what is to be done */ 00948 00949 ok = YES; 00950 statstruct = YES; 00951 00952 intfile = NO; 00953 if(p = V(IOSUNIT)) 00954 { 00955 if( ISINT(p->headblock.vtype) ) { 00956 int_unit: 00957 unitp = (Addrp) cpexpr(p); 00958 } 00959 else if(p->headblock.vtype == TYCHAR) 00960 { 00961 if (nioctl == 1 && iostmt == IOREAD) { 00962 /* kludge to recognize READ(format expr) */ 00963 V(IOSFMT) = p; 00964 V(IOSUNIT) = p = (expptr) IOSTDIN; 00965 ioformatted = FORMATTED; 00966 goto int_unit; 00967 } 00968 intfile = YES; 00969 if(p->tag==TPRIM && p->primblock.argsp==NULL && 00970 (np = p->primblock.namep)->vdim!=NULL) 00971 { 00972 vardcl(np); 00973 if(nump = np->vdim->nelt) 00974 { 00975 nump = fixtype(cpexpr(nump)); 00976 if( ! ISCONST(nump) ) { 00977 statstruct = NO; 00978 np->vlastdim = 0; 00979 } 00980 } 00981 else 00982 { 00983 err("attempt to use internal unit array of unknown size"); 00984 ok = NO; 00985 nump = ICON(1); 00986 } 00987 unitp = mkscalar(np); 00988 } 00989 else { 00990 nump = ICON(1); 00991 unitp = (Addrp /*pjw */) fixtype(cpexpr(p)); 00992 } 00993 if(! isstatic((expptr)unitp) ) 00994 statstruct = NO; 00995 } 00996 else { 00997 err("unit specifier not of type integer or character"); 00998 ok = NO; 00999 } 01000 } 01001 else 01002 { 01003 err("bad unit specifier"); 01004 ok = NO; 01005 } 01006 01007 sequential = YES; 01008 if(p = V(IOSREC)) 01009 if( ISINT(p->headblock.vtype) ) 01010 { 01011 recp = (Addrp) cpexpr(p); 01012 sequential = NO; 01013 } 01014 else { 01015 err("bad REC= clause"); 01016 ok = NO; 01017 } 01018 else 01019 recp = NULL; 01020 01021 01022 varfmt = YES; 01023 fmtp = NULL; 01024 if(p = V(IOSFMT)) 01025 { 01026 if(p->tag==TPRIM && p->primblock.argsp==NULL) 01027 { 01028 np = p->primblock.namep; 01029 if(np->vclass == CLNAMELIST) 01030 { 01031 ioformatted = NAMEDIRECTED; 01032 fmtp = (Addrp) fixtype(p); 01033 V(IOSFMT) = (expptr)fmtp; 01034 if (skiplab) 01035 jumplab = 0; 01036 goto endfmt; 01037 } 01038 vardcl(np); 01039 if(np->vdim) 01040 { 01041 if( ! ONEOF(np->vstg, MSKSTATIC) ) 01042 statstruct = NO; 01043 fmtp = mkscalar(np); 01044 goto endfmt; 01045 } 01046 if( ISINT(np->vtype) ) /* ASSIGNed label */ 01047 { 01048 statstruct = NO; 01049 varfmt = YES; 01050 fmtp = asg_addr(p); 01051 goto endfmt; 01052 } 01053 } 01054 p = V(IOSFMT) = fixtype(p); 01055 if(p->headblock.vtype == TYCHAR 01056 /* Since we allow write(6,n) */ 01057 /* we may as well allow write(6,n(2)) */ 01058 || p->tag == TADDR && ISINT(p->addrblock.vtype)) 01059 { 01060 if( ! isstatic(p) ) 01061 statstruct = NO; 01062 fmtp = (Addrp) cpexpr(p); 01063 } 01064 else if( ISICON(p) ) 01065 { 01066 struct Labelblock *lp; 01067 lp = mklabel(p->constblock.Const.ci); 01068 if (fmtstmt(lp) > 0) 01069 { 01070 fmtp = (Addrp)mkaddcon(lp->stateno); 01071 /* lp->stateno for names fmt_nnn */ 01072 lp->fmtlabused = 1; 01073 varfmt = NO; 01074 } 01075 else 01076 ioformatted = UNFORMATTED; 01077 } 01078 else { 01079 err("bad format descriptor"); 01080 ioformatted = UNFORMATTED; 01081 ok = NO; 01082 } 01083 } 01084 else 01085 fmtp = NULL; 01086 01087 endfmt: 01088 if(intfile) { 01089 if (ioformatted==UNFORMATTED) { 01090 err("unformatted internal I/O not allowed"); 01091 ok = NO; 01092 } 01093 if (recp) { 01094 err("direct internal I/O not allowed"); 01095 ok = NO; 01096 } 01097 } 01098 if(!sequential && ioformatted==LISTDIRECTED) 01099 { 01100 err("direct list-directed I/O not allowed"); 01101 ok = NO; 01102 } 01103 if(!sequential && ioformatted==NAMEDIRECTED) 01104 { 01105 err("direct namelist I/O not allowed"); 01106 ok = NO; 01107 } 01108 01109 if( ! ok ) { 01110 statstruct = NO; 01111 return; 01112 } 01113 01114 /* 01115 Now put out the I/O structure, statically if all the clauses 01116 are constants, dynamically otherwise 01117 */ 01118 01119 if (intfile) { 01120 ios = io_stuff + iostmt; 01121 iostmt1 = IOREAD; 01122 } 01123 else { 01124 ios = io_stuff; 01125 iostmt1 = 0; 01126 } 01127 io_fields = ios->fields; 01128 if(statstruct) 01129 { 01130 ioblkp = ALLOC(Addrblock); 01131 ioblkp->tag = TADDR; 01132 ioblkp->vtype = ios->type; 01133 ioblkp->vclass = CLVAR; 01134 ioblkp->vstg = STGINIT; 01135 ioblkp->memno = ++lastvarno; 01136 ioblkp->memoffset = ICON(0); 01137 ioblkp -> uname_tag = UNAM_IDENT; 01138 new_iob_data(ios, 01139 temp_name("io_", lastvarno, ioblkp->user.ident)); } 01140 else if(!(ioblkp = io_structs[iostmt1])) 01141 io_structs[iostmt1] = ioblkp = 01142 autovar(1, ios->type, ENULL, ""); 01143 01144 ioset(TYIOINT, XERR, ICON(errbit)); 01145 if(iostmt == IOREAD) 01146 ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) ); 01147 01148 if(intfile) 01149 { 01150 ioset(TYIOINT, XIRNUM, nump); 01151 ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) ); 01152 ioseta(XIUNIT, unitp); 01153 } 01154 else 01155 ioset(TYIOINT, XUNIT, (expptr) unitp); 01156 01157 if(recp) 01158 ioset(TYIOINT, /* intfile ? XIREC : */ XREC, (expptr) recp); 01159 01160 if(varfmt) 01161 ioseta( intfile ? XIFMT : XFMT , fmtp); 01162 else 01163 ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp); 01164 01165 ioroutine[0] = 's'; 01166 ioroutine[1] = '_'; 01167 ioroutine[2] = iostmt==IOREAD ? 'r' : 'w'; 01168 ioroutine[3] = "ds"[sequential]; 01169 ioroutine[4] = "ufln"[ioformatted]; 01170 ioroutine[5] = "ei"[intfile]; 01171 ioroutine[6] = '\0'; 01172 01173 putiocall( call1(TYINT, ioroutine, cpexpr((expptr)ioblkp) )); 01174 01175 if(statstruct) 01176 { 01177 frexpr((expptr)ioblkp); 01178 statstruct = NO; 01179 ioblkp = 0; /* unnecessary */ 01180 } 01181 } |
Variable Documentation
|
Initial value: { "alist", "aerr", "aunit" } Definition at line 236 of file f2cdir/io.c. |
|
Definition at line 36 of file f2cdir/io.c. Referenced by putio(). |
|
Initial value: { "cilist", "cierr", "ciunit", "ciend", "cifmt", "cirec" } Definition at line 201 of file f2cdir/io.c. |
|
Initial value: { "cllist", "cerr", "cunit", "csta" } Definition at line 230 of file f2cdir/io.c. |
|
Definition at line 58 of file f2cdir/io.c. Referenced by endioctl(), and startrw(). |
|
Definition at line 59 of file f2cdir/io.c. Referenced by endioctl(), and startrw(). |
|
Initial value: { "icilist", "icierr", "iciunit", "iciend", "icifmt", "icirlen", "icirnum" } Definition at line 209 of file f2cdir/io.c. |
|
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 f2cdir/io.c. |
|
Definition at line 36 of file f2cdir/io.c. Referenced by iosetip(), and set_externs(). |
|
Definition at line 271 of file f2cdir/io.c. Referenced by endioctl(), ioset(), and startrw(). |
|
Definition at line 52 of file f2cdir/io.c. |
|
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 275 of file f2cdir/io.c. Referenced by endioctl(), and startrw(). |
|
Definition at line 51 of file f2cdir/io.c. |
|
Definition at line 65 of file f2cdir/io.c. Referenced by dofclose(), dofinquire(), dofmove(), dofopen(), endioctl(), ioset(), and startrw(). |
|
Referenced by ioclause(), iocname(), and iosetip(). |
|
Definition at line 761 of file f2cdir/io.c. Referenced by putio(), and typekludge(). |
|
Definition at line 56 of file f2cdir/io.c. Referenced by endio(), and endioctl(). |
|
Definition at line 57 of file f2cdir/io.c. Referenced by endio(), and endioctl(). |
|
Definition at line 62 of file f2cdir/io.c. Referenced by doio(), endio(), ioclause(), putio(), startioctl(), and startrw(). |
|
Definition at line 54 of file f2cdir/io.c. |
|
Definition at line 1287 of file f2cdir/io.c. |
|
Definition at line 60 of file f2cdir/io.c. Referenced by doio(), endioctl(), putiocall(), and startrw(). |
|
Initial value: { "olist", "oerr", "ounit", "ofnm", "ofnmlen", "osta", "oacc", "ofm", "orl", "oblnk" } Definition at line 218 of file f2cdir/io.c. |
|
Definition at line 61 of file f2cdir/io.c. Referenced by endioctl(). |
|
Definition at line 64 of file f2cdir/io.c. |
|
Definition at line 63 of file f2cdir/io.c. |
|
Initial value: { 0, 1, 11, 2, 3, 14, 4, 5, 6, 7, 12, 13, 8, 9, 10, 15 } Definition at line 762 of file f2cdir/io.c. Referenced by putio(). |