io.c

来自「<B>Digital的Unix操作系统VAX 4.2源码</B>」· C语言 代码 · 共 1,235 行 · 第 1/2 页

		putif (mkexpr(OPEQ,q,ICON(0)),jumplab);
else
	if (optimflag)
		optbuff (SKEQ, q, 0, 0);
	else
		putexpr(q);
}

startrw()
{
register expptr p;
register Namep np;
register Addrp unitp, fmtp, recp, tioblkp;
register expptr nump;
register ioblock *t;
Addrp mkscalar();
expptr mkaddcon();
int k;
flag intfile, sequential, ok, varfmt;

/* First look at all the parameters and determine what is to be done */

ok = YES;
statstruct = YES;

intfile = NO;
if(p = V(IOSUNIT))
	{
	if( ISINT(p->headblock.vtype) )
		unitp = (Addrp) cpexpr(p);
	else if(p->headblock.vtype == TYCHAR)
		{
		intfile = YES;
		if(p->tag==TPRIM && p->primblock.argsp==NULL &&
		    (np = p->primblock.namep)->vdim!=NULL)
			{
			vardcl(np);
			if(np->vdim->nelt)
				{
				nump = (expptr) cpexpr(np->vdim->nelt);
				if( ! ISCONST(nump) )
					statstruct = NO;
				}
			else
				{
				err("attempt to use internal unit array of unknown size");
				ok = NO;
				nump = ICON(1);
				}
			unitp = mkscalar(np);
			}
		else	{
			nump = ICON(1);
			unitp = (Addrp) fixtype(cpexpr(p));
			}
		if(! isstatic(unitp) )
			statstruct = NO;
		}
	else
		{
		err("bad unit specifier type");
		ok = NO;
		}
	}
else
	{
	err("bad unit specifier");
	ok = NO;
	}

sequential = YES;
if(p = V(IOSREC))
	if( ISINT(p->headblock.vtype) )
		{
		recp = (Addrp) cpexpr(p);
		sequential = NO;
		}
	else	{
		err("bad REC= clause");
		ok = NO;
		}
else
	recp = NULL;


varfmt = YES;
fmtp = NULL;
if(p = V(IOSFMT))
	{
	if(p->tag==TPRIM && p->primblock.argsp==NULL)
		{
		np = p->primblock.namep;
		if(np->vclass == CLNAMELIST)
			{
			ioformatted = NAMEDIRECTED;
			fmtp = (Addrp) fixtype(cpexpr(p));
			goto endfmt;
			}
		vardcl(np);
		if(np->vdim)
			{
			if( ! ONEOF(np->vstg, MSKSTATIC) )
				statstruct = NO;
			fmtp = mkscalar(np);
			goto endfmt;
			}
		if( ISINT(np->vtype) )	/* ASSIGNed label */
			{
			statstruct = NO;
			varfmt = NO;
			fmtp = (Addrp) fixtype(cpexpr(p));
			goto endfmt;
			}
		}
	p = V(IOSFMT) = fixtype(p);
	if(p->headblock.vtype == TYCHAR)
		{
		if (p->tag == TCONST) p = (expptr) putconst(p);
		if( ! isstatic(p) )
			statstruct = NO;
		fmtp = (Addrp) cpexpr(p);
		}
	else if( ISICON(p) )
		{
		if( (k = fmtstmt( mklabel(p->constblock.const.ci) )) > 0 )
			{
			fmtp = (Addrp) mkaddcon(k);
			varfmt = NO;
			}
		else
			ioformatted = UNFORMATTED;
		}
	else	{
		err("bad format descriptor");
		ioformatted = UNFORMATTED;
		ok = NO;
		}
	}
else
	fmtp = NULL;

endfmt:
	if(intfile && ioformatted==UNFORMATTED)
		{
		err("unformatted internal I/O not allowed");
		ok = NO;
		}
	if(!sequential && ioformatted==LISTDIRECTED)
		{
		err("direct list-directed I/O not allowed");
		ok = NO;
		}
	if(!sequential && ioformatted==NAMEDIRECTED)
		{
		err("direct namelist I/O not allowed");
		ok = NO;
		}

if( ! ok )
	return;

if (optimflag && ISCONST (fmtp))
	fmtp = putconst ( (expptr) fmtp);

/*
   Now put out the I/O structure, statically if all the clauses
   are constants, dynamically otherwise
*/

if(statstruct)
	{
	tioblkp = ioblkp;
	ioblkp = ALLOC(Addrblock);
	ioblkp->tag = TADDR;
	ioblkp->vtype = TYIOINT;
	ioblkp->vclass = CLVAR;
	ioblkp->vstg = STGINIT;
	ioblkp->memno = ++lastvarno;
	ioblkp->memoffset = ICON(0);
	blklen = (intfile ? XIREC+SZIOINT :
			(sequential ? XFMT+SZADDR : XRNUM+SZIOINT) );
	t = ALLOC(IoBlock);
	t->blkno = ioblkp->memno;
	t->len = blklen;
	t->next = iodata;
	iodata = t;
	}
else if(ioblkp == NULL)
	ioblkp = autovar( (MAXIO+SZIOINT-1)/SZIOINT , TYIOINT, PNULL);

ioset(TYIOINT, XERR, ICON(errbit));
if(iostmt == IOREAD)
	ioset(TYIOINT, (intfile ? XIEND : XEND), ICON(endbit) );

if(intfile)
	{
	ioset(TYIOINT, XIRNUM, nump);
	ioset(TYIOINT, XIRLEN, cpexpr(unitp->vleng) );
	ioseta(XIUNIT, unitp);
	}
else
	ioset(TYIOINT, XUNIT, (expptr) unitp);

if(recp)
	ioset(TYIOINT, (intfile ? XIREC : XREC) , (expptr) recp);

if(varfmt)
	ioseta( intfile ? XIFMT : XFMT , fmtp);
else
	ioset(TYADDR, intfile ? XIFMT : XFMT, (expptr) fmtp);

ioroutine[0] = 's';
ioroutine[1] = '_';
ioroutine[2] = (iostmt==IOREAD ? 'r' : 'w');
ioroutine[3] = (sequential ? 's' : 'd');
ioroutine[4] = "ufln" [ioformatted];
ioroutine[5] = (intfile ? 'i' : 'e');
ioroutine[6] = '\0';

putiocall( call1(TYINT, ioroutine, cpexpr(ioblkp) ));

if(statstruct)
	{
	frexpr(ioblkp);
	ioblkp = tioblkp;
	statstruct = NO;
	}
}



LOCAL dofopen()
{
register expptr p;

if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
	ioset(TYIOINT, XUNIT, cpexpr(p) );
else
	err("bad unit in open");
if( (p = V(IOSFILE)) )
	if(p->headblock.vtype == TYCHAR)
		ioset(TYIOINT, XFNAMELEN, cpexpr(p->headblock.vleng) );
	else
		err("bad file in open");

iosetc(XFNAME, p);

if(p = V(IOSRECL))
	if( ISINT(p->headblock.vtype) )
		ioset(TYIOINT, XRECLEN, cpexpr(p) );
	else
		err("bad recl");
else
	ioset(TYIOINT, XRECLEN, ICON(0) );

iosetc(XSTATUS, V(IOSSTATUS));
iosetc(XACCESS, V(IOSACCESS));
iosetc(XFORMATTED, V(IOSFORM));
iosetc(XBLANK, V(IOSBLANK));

putiocall( call1(TYINT, "f_open", cpexpr(ioblkp) ));
}


LOCAL dofclose()
{
register expptr p;

if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
	{
	ioset(TYIOINT, XUNIT, cpexpr(p) );
	iosetc(XCLSTATUS, V(IOSSTATUS));
	putiocall( call1(TYINT, "f_clos", cpexpr(ioblkp)) );
	}
else
	err("bad unit in close statement");
}


LOCAL dofinquire()
{
register expptr p;
if(p = V(IOSUNIT))
	{
	if( V(IOSFILE) )
		err("inquire by unit or by file, not both");
	ioset(TYIOINT, XUNIT, cpexpr(p) );
	}
else if( ! V(IOSFILE) )
	err("must inquire by unit or by file");
iosetlc(IOSFILE, XFILE, XFILELEN);
iosetip(IOSEXISTS, XEXISTS);
iosetip(IOSOPENED, XOPEN);
iosetip(IOSNUMBER, XNUMBER);
iosetip(IOSNAMED, XNAMED);
iosetlc(IOSNAME, XNAME, XNAMELEN);
iosetlc(IOSACCESS, XQACCESS, XQACCLEN);
iosetlc(IOSSEQUENTIAL, XSEQ, XSEQLEN);
iosetlc(IOSDIRECT, XDIRECT, XDIRLEN);
iosetlc(IOSFORM, XFORM, XFORMLEN);
iosetlc(IOSFORMATTED, XFMTED, XFMTEDLEN);
iosetlc(IOSUNFORMATTED, XUNFMT, XUNFMTLEN);
iosetip(IOSRECL, XQRECL);
iosetip(IOSNEXTREC, XNEXTREC);
iosetlc(IOSBLANK, XQBLANK, XQBLANKLEN);

putiocall( call1(TYINT,  "f_inqu", cpexpr(ioblkp) ));
}



LOCAL dofmove(subname)
char *subname;
{
register expptr p;

if( (p = V(IOSUNIT)) && ISINT(p->headblock.vtype) )
	{
	ioset(TYIOINT, XUNIT, cpexpr(p) );
	putiocall( call1(TYINT, subname, cpexpr(ioblkp) ));
	}
else
	err("bad unit in I/O motion statement");
}



LOCAL
ioset(type, offset, p)
int type;
int offset;
register expptr p;
{
  static char *badoffset = "badoffset in ioset";

  register Addrp q;
  register offsetlist *op;

  q = (Addrp) cpexpr(ioblkp);
  q->vtype = type;
  q->memoffset = fixtype( mkexpr(OPPLUS, q->memoffset, ICON(offset)) );

  if (statstruct && ISCONST(p))
    {
      if (!ISICON(q->memoffset))
	fatal(badoffset);

      op = mkiodata(q->memno, q->memoffset->constblock.const.ci, blklen);
      if (op->tag != 0)
	fatal(badoffset);

      if (type == TYADDR)
	{
	  op->tag = NDLABEL;
	  op->val.label = p->constblock.const.ci;
	}
      else
	{
	  op->tag = NDDATA;
	  op->val.cp = (Constp) convconst(type, 0, p);
	}

      frexpr((tagptr) p);
      frexpr((tagptr) q);
    }
  else
    if (optimflag)
      optbuff (SKEQ, mkexpr(OPASSIGN,q,p), 0,0);
    else
      puteq (q,p);

  return;
}




LOCAL iosetc(offset, p)
int offset;
register expptr p;
{
if(p == NULL)
	ioset(TYADDR, offset, ICON(0) );
else if(p->headblock.vtype == TYCHAR)
	ioset(TYADDR, offset, addrof(cpexpr(p) ));
else
	err("non-character control clause");
}



LOCAL ioseta(offset, p)
int offset;
register Addrp p;
{
  static char *badoffset = "bad offset in ioseta";

  int blkno;
  register offsetlist *op;

  if(statstruct)
    {
      blkno = ioblkp->memno;
      op = mkiodata(blkno, offset, blklen);
      if (op->tag != 0)
	fatal(badoffset);

      if (p == NULL)
	op->tag = NDNULL;
      else if (p->tag == TADDR)
	{
	  op->tag = NDADDR;
	  op->val.addr.stg = p->vstg;
	  op->val.addr.memno = p->memno;
	  op->val.addr.offset = p->memoffset->constblock.const.ci;
	}
      else
	badtag("ioseta", p->tag);
    }
  else
    ioset(TYADDR, offset, p ? addrof(p) : ICON(0) );

  return;
}




LOCAL iosetip(i, offset)
int i, offset;
{
register expptr p;

if(p = V(i))
	if(p->tag==TADDR &&
	    ONEOF(p->addrblock.vtype, M(TYLONG)|M(TYLOGICAL)) )
		ioset(TYADDR, offset, addrof(cpexpr(p)) );
	else
		errstr("impossible inquire parameter %s", ioc[i].iocname);
else
	ioset(TYADDR, offset, ICON(0) );
}



LOCAL iosetlc(i, offp, offl)
int i, offp, offl;
{
register expptr p;
if( (p = V(i)) && p->headblock.vtype==TYCHAR)
	ioset(TYIOINT, offl, cpexpr(p->headblock.vleng) );
iosetc(offp, p);
}


LOCAL offsetlist *
mkiodata(blkno, offset, len)
int blkno;
ftnint offset;
ftnint len;
{
  register offsetlist *p, *q;
  register ioblock *t;
  register int found;

  found = NO;
  t = iodata;

  while (found == NO && t != NULL)
    {
      if (t->blkno == blkno)
	found = YES;
      else
	t = t->next;
    }

  if (found == NO)
    {
      t = ALLOC(IoBlock);
      t->blkno = blkno;
      t->next = iodata;
      iodata = t;
    }

  if (len > t->len)
    t->len = len;

  p = t->olist;

  if (p == NULL)
    {
      p = ALLOC(OffsetList);
      p->next = NULL;
      p->offset = offset;
      t->olist = p;
      return (p);
    }

  for (;;)
    {
      if (p->offset == offset)
	return (p);
      else if (p->next != NULL &&
	       p->next->offset <= offset)
	p = p->next;
      else
	{
	  q = ALLOC(OffsetList);
	  q->next = p->next;
	  p->next = q;
	  q->offset = offset;
	  return (q);
	}
    }
}


outiodata()
{
  static char *varfmt = "v.%d:\n";

  register ioblock *p;
  register ioblock *t;

  if (iodata == NULL) return;

  p = iodata;

  while (p != NULL)
    {
      pralign(ALIDOUBLE);
      fprintf(initfile, varfmt, p->blkno);
      outolist(p->olist, p->len);

      t = p;
      p = t->next;
      free((char *) t);
    }

  iodata = NULL;
  return;
}



LOCAL
outolist(op, len)
register offsetlist *op;
register int len;
{
  static char *overlap = "overlapping i/o fields in outolist";
  static char *toolong = "offset too large in outolist";

  register offsetlist *t;
  register ftnint clen;
  register Constp cp;
  register int type;

  clen = 0;

  while (op != NULL)
    {
      if (clen > op->offset)
	fatal(overlap);

      if (clen < op->offset)
	{
	  prspace(op->offset - clen);
	  clen = op->offset;
	}

      switch (op->tag)
	{
	default:
	  badtag("outolist", op->tag);

	case NDDATA:
	  cp = op->val.cp;
	  type = cp->vtype;
	  if (type != TYIOINT)
	    badtype("outolist", type);
	  prconi(initfile, type, cp->const.ci);
	  clen += typesize[type];
	  frexpr((tagptr) cp);
	  break;

	case NDLABEL:
	  prcona(initfile, op->val.label);
	  clen += typesize[TYADDR];
	  break;

	case NDADDR:
	  praddr(initfile, op->val.addr.stg, op->val.addr.memno,
		 op->val.addr.offset);
	  clen += typesize[TYADDR];
	  break;

	case NDNULL:
	  praddr(initfile, STGNULL, 0, (ftnint) 0);
	  clen += typesize[TYADDR];
	  break;
	}

      t = op;
      op = t->next;
      free((char *) t);
    }

  if (clen > len)
    fatal(toolong);

  if (clen < len)
    prspace(len - clen);

  return;
}