changes for var. length sockaddrs; new routing; mv common ether input
[unix-history] / usr / src / sys / tahoe / vba / cy.c
index 17fff3e..5a2123d 100644 (file)
@@ -1,4 +1,24 @@
-/*     cy.c    1.13    87/04/09        */
+/*
+ * Copyright (c) 1988 Regents of the University of California.
+ * All rights reserved.
+ *
+ * This code is derived from software contributed to Berkeley by
+ * Computer Consoles Inc.
+ *
+ * Redistribution and use in source and binary forms are permitted
+ * provided that the above copyright notice and this paragraph are
+ * duplicated in all such forms and that any documentation,
+ * advertising materials, and other materials related to such
+ * distribution and use acknowledge that the software was developed
+ * by the University of California, Berkeley.  The name of the
+ * University may not be used to endorse or promote products derived
+ * from this software without specific prior written permission.
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+ * WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+ *
+ *     @(#)cy.c        7.2 (Berkeley) %G%
+ */
 
 #include "yc.h"
 #if NCY > 0
 
 #include "yc.h"
 #if NCY > 0
@@ -50,13 +70,6 @@ int  cydebug = 0;
  */
 struct buf ccybuf[NCY];
 
  */
 struct buf ccybuf[NCY];
 
-/*
- * Raw tape operations use rcybuf.  The driver notices when
- * rcybuf is being used and allows the user program to contine
- * after errors and read records not of the standard length.
- */
-struct buf rcybuf[NCY];
-
 int    cyprobe(), cyslave(), cyattach();
 struct buf ycutab[NYC];
 short  yctocy[NYC];
 int    cyprobe(), cyslave(), cyattach();
 struct buf ycutab[NYC];
 short  yctocy[NYC];
@@ -166,7 +179,10 @@ cyprobe(reg, vm)
                        return (0);
                }
                cy->cy_rbuf.vb_rawbuf = cybuf + ctlr * CYMAXIO;
                        return (0);
                }
                cy->cy_rbuf.vb_rawbuf = cybuf + ctlr * CYMAXIO;
-               vbainit(&cy->cy_rbuf, CYMAXIO, VB_20BIT);
+               if (vbainit(&cy->cy_rbuf, CYMAXIO, VB_20BIT) == 0) {
+                       printf("cy%d: vbainit failed\n", ctlr);
+                       return (0);
+               }
 
                br = 0x13, cvec = 0x80;                 /* XXX */
                return (sizeof (struct cyccb));
 
                br = 0x13, cvec = 0x80;                 /* XXX */
                return (sizeof (struct cyccb));
@@ -285,7 +301,6 @@ cyopen(dev, flag)
        register int ycunit;
        register struct vba_device *vi;
        register struct yc_softc *yc;
        register int ycunit;
        register struct vba_device *vi;
        register struct yc_softc *yc;
-       int s;
 
        ycunit = YCUNIT(dev);
        if (ycunit >= NYC || (vi = ycdinfo[ycunit]) == 0 || vi->ui_alive == 0)
 
        ycunit = YCUNIT(dev);
        if (ycunit >= NYC || (vi = ycdinfo[ycunit]) == 0 || vi->ui_alive == 0)
@@ -304,12 +319,12 @@ cyopen(dev, flag)
        }
        cycommand(dev, CY_SENSE, 1);
        if ((yc->yc_status&CYS_OL) == 0) {      /* not on-line */
        }
        cycommand(dev, CY_SENSE, 1);
        if ((yc->yc_status&CYS_OL) == 0) {      /* not on-line */
-               uprintf("yc%d: not online\n", ycunit);
+               uprintf("cy%d: not online\n", ycunit);
                yc->yc_openf = 0;
                return (EIO);
        }
        if ((flag&FWRITE) && (yc->yc_status&CYS_WP)) {
                yc->yc_openf = 0;
                return (EIO);
        }
        if ((flag&FWRITE) && (yc->yc_status&CYS_WP)) {
-               uprintf("yc%d: no write ring\n", ycunit);
+               uprintf("cy%d: no write ring\n", ycunit);
                yc->yc_openf = 0;
                return (EIO);
        }
                yc->yc_openf = 0;
                return (EIO);
        }
@@ -338,7 +353,8 @@ cyclose(dev, flag)
        struct yc_softc *yc = &yc_softc[YCUNIT(dev)];
 
        if (flag == FWRITE || (flag&FWRITE) && yc->yc_lastiow) {
        struct yc_softc *yc = &yc_softc[YCUNIT(dev)];
 
        if (flag == FWRITE || (flag&FWRITE) && yc->yc_lastiow) {
-               cycommand(dev, CY_WEOF, 2);
+               cycommand(dev, CY_WEOF, 1);     /* can't use count with WEOF */
+               cycommand(dev, CY_WEOF, 1);
                cycommand(dev, CY_SREV, 1);
        }
        if ((minor(dev)&T_NOREWIND) == 0)
                cycommand(dev, CY_SREV, 1);
        }
        if ((minor(dev)&T_NOREWIND) == 0)
@@ -417,7 +433,7 @@ cystrategy(bp)
        bp->av_forw = NULL;
        vm = ycdinfo[ycunit]->ui_mi;
        /* BEGIN GROT */
        bp->av_forw = NULL;
        vm = ycdinfo[ycunit]->ui_mi;
        /* BEGIN GROT */
-       if (bp == &rcybuf[CYUNIT(bp->b_dev)]) {
+       if (bp->b_flags & B_RAW) {
                if (bp->b_bcount >= CYMAXIO) {
                        uprintf("cy%d: i/o size too large\n", vm->um_ctlr);
                        bp->b_error = EINVAL;
                if (bp->b_bcount >= CYMAXIO) {
                        uprintf("cy%d: i/o size too large\n", vm->um_ctlr);
                        bp->b_error = EINVAL;
@@ -519,32 +535,41 @@ loop:
                goto dobpcmd;
        }
        /*
                goto dobpcmd;
        }
        /*
-        * The following checks handle boundary cases for operation
-        * on no-raw tapes.  On raw tapes the initialization of
-        * yc->yc_nxrec by cyphys causes them to be skipped normally
-        * (except in the case of retries).
+        * For raw I/O, save the current block
+        * number in case we have to retry.
         */
         */
-       if (bp->b_blkno > yc->yc_nxrec) {
-               /*
-                * Can't read past known end-of-file.
-                */
-               bp->b_flags |= B_ERROR;
-               bp->b_error = ENXIO;
-               goto next;
-       }
-       if (bp->b_blkno == yc->yc_nxrec && bp->b_flags&B_READ) {
+       if (bp->b_flags & B_RAW) {
+               if (vm->um_tab.b_errcnt == 0) {
+                       yc->yc_blkno = bp->b_blkno;
+                       yc->yc_nxrec = yc->yc_blkno + 1;
+               }
+       } else {
                /*
                /*
-                * Reading at end of file returns 0 bytes.
+                * Handle boundary cases for operation
+                * on non-raw tapes.
                 */
                 */
-               bp->b_resid = bp->b_bcount;
-               clrbuf(bp);
-               goto next;
+               if (bp->b_blkno > yc->yc_nxrec) {
+                       /*
+                        * Can't read past known end-of-file.
+                        */
+                       bp->b_flags |= B_ERROR;
+                       bp->b_error = ENXIO;
+                       goto next;
+               }
+               if (bp->b_blkno == yc->yc_nxrec && bp->b_flags&B_READ) {
+                       /*
+                        * Reading at end of file returns 0 bytes.
+                        */
+                       bp->b_resid = bp->b_bcount;
+                       clrbuf(bp);
+                       goto next;
+               }
+               if ((bp->b_flags&B_READ) == 0)
+                       /*
+                        * Writing sets EOF.
+                        */
+                       yc->yc_nxrec = bp->b_blkno + 1;
        }
        }
-       if ((bp->b_flags&B_READ) == 0)
-               /*
-                * Writing sets EOF.
-                */
-               yc->yc_nxrec = bp->b_blkno + 1;
        if ((blkno = yc->yc_blkno) == bp->b_blkno) {
                caddr_t addr;
                int cmd;
        if ((blkno = yc->yc_blkno) == bp->b_blkno) {
                caddr_t addr;
                int cmd;
@@ -593,8 +618,8 @@ loop:
                cyldmba(cy->cy_tpb.tpdata, (caddr_t)addr);
                cy->cy_tpb.tprec = 0;
                if (cmd == CY_BRCOM)
                cyldmba(cy->cy_tpb.tpdata, (caddr_t)addr);
                cy->cy_tpb.tprec = 0;
                if (cmd == CY_BRCOM)
-                       cy->cy_tpb.tpsize = htoms(min(yc->yc_blksize,
-                           bp->b_bcount));
+                       cy->cy_tpb.tpsize = htoms(imin(yc->yc_blksize,
+                           (int)bp->b_bcount));
                else
                        cy->cy_tpb.tpsize = htoms(bp->b_bcount);
                cyldmba(cy->cy_tpb.tplink, (caddr_t)0);
                else
                        cy->cy_tpb.tpsize = htoms(bp->b_bcount);
                cyldmba(cy->cy_tpb.tplink, (caddr_t)0);
@@ -623,7 +648,7 @@ loop:
                bp->b_command = CY_SREV;
                cy->cy_tpb.tprec = htoms(blkno - bp->b_blkno);
        }
                bp->b_command = CY_SREV;
                cy->cy_tpb.tprec = htoms(blkno - bp->b_blkno);
        }
-       yc->yc_timo = imin(imax(10 * htoms(cy->cy_tpb.tprec), 60), 5*60);
+       yc->yc_timo = imin(imax((int)(10 * htoms(cy->cy_tpb.tprec)), 60), 5*60);
 dobpcmd:
        /*
         * Do the command in bp.  Reverse direction commands
 dobpcmd:
        /*
         * Do the command in bp.  Reverse direction commands
@@ -751,7 +776,7 @@ cyintr(cyunit)
                 * If we were reading raw tape and the only error was that the
                 * record was too long, then we don't consider this an error.
                 */
                 * If we were reading raw tape and the only error was that the
                 * record was too long, then we don't consider this an error.
                 */
-               if (bp == &rcybuf[cyunit] && (bp->b_flags&B_READ) &&
+               if ((bp->b_flags & (B_READ|B_RAW)) == (B_READ|B_RAW) &&
                    err == CYER_STROBE) {
                        /*
                         * Retry reads with the command changed to
                    err == CYER_STROBE) {
                        /*
                         * Retry reads with the command changed to
@@ -769,7 +794,8 @@ cyintr(cyunit)
                 * If error is not hard, and this was an i/o operation
                 * retry up to 8 times.
                 */
                 * If error is not hard, and this was an i/o operation
                 * retry up to 8 times.
                 */
-               if (((1<<err)&CYER_SOFT) && state == SIO) {
+               if (state == SIO && (CYMASK(err) &
+                   ((bp->b_flags&B_READ) ? CYER_RSOFT : CYER_WSOFT))) {
                        if (++vm->um_tab.b_errcnt < 7) {
                                yc->yc_blkno++;
                                goto opcont;
                        if (++vm->um_tab.b_errcnt < 7) {
                                yc->yc_blkno++;
                                goto opcont;
@@ -779,7 +805,8 @@ cyintr(cyunit)
                         * Hard or non-i/o errors on non-raw tape
                         * cause it to close.
                         */
                         * Hard or non-i/o errors on non-raw tape
                         * cause it to close.
                         */
-                       if (yc->yc_openf > 0 && bp != &rcybuf[cyunit])
+                       if ((bp->b_flags&B_RAW) == 0 &&
+                           yc->yc_openf > 0)
                                yc->yc_openf = -1;
                /*
                 * Couldn't recover from error.
                                yc->yc_openf = -1;
                /*
                 * Couldn't recover from error.
@@ -937,53 +964,6 @@ cyseteof(bp)
        yc->yc_nxrec = bp->b_blkno;
 }
 
        yc->yc_nxrec = bp->b_blkno;
 }
 
-cyread(dev, uio)
-       dev_t dev;
-       struct uio *uio;
-{
-       int errno;
-
-       errno = cyphys(dev, uio);
-       if (errno)
-               return (errno);
-       return (physio(cystrategy, &rcybuf[CYUNIT(dev)], dev, B_READ, minphys, uio));
-}
-
-cywrite(dev, uio)
-       dev_t dev;
-       struct uio *uio;
-{
-       int errno;
-
-       errno = cyphys(dev, uio);
-       if (errno)
-               return (errno);
-       return (physio(cystrategy, &rcybuf[CYUNIT(dev)], dev, B_WRITE, minphys, uio));
-}
-
-/*
- * Check that a raw device exits.
- * If it does, set up the yc_blkno and yc_nxrec
- * so that the tape will appear positioned correctly.
- */
-cyphys(dev, uio)
-       dev_t dev;
-       struct uio *uio;
-{
-       register int ycunit = YCUNIT(dev);
-       register daddr_t a;
-       register struct yc_softc *yc;
-       register struct vba_device *vi;
-
-       if (ycunit >= NYC || (vi = ycdinfo[ycunit]) == 0 || vi->ui_alive == 0)
-               return (ENXIO);
-       yc = &yc_softc[ycunit];
-       a = uio->uio_offset >> DEV_BSHIFT;
-       yc->yc_blkno = a;
-       yc->yc_nxrec = a + 1;
-       return (0);
-}
-
 /*ARGSUSED*/
 cyioctl(dev, cmd, data, flag)
        caddr_t data;
 /*ARGSUSED*/
 cyioctl(dev, cmd, data, flag)
        caddr_t data;
@@ -1089,7 +1069,7 @@ cywait(cp)
  * Load a 20 bit pointer into a Tapemaster pointer.
  */
 cyldmba(reg, value)
  * Load a 20 bit pointer into a Tapemaster pointer.
  */
 cyldmba(reg, value)
-       register caddr_t reg;
+       register u_char *reg;
        caddr_t value;
 {
        register int v = (int)value;
        caddr_t value;
 {
        register int v = (int)value;