add CCI credit, rm unneeded wakup; how can 2 closes
[unix-history] / usr / src / sys / tahoe / vba / mp.c
index d2e337b..40b3678 100644 (file)
@@ -2,14 +2,22 @@
  * Copyright (c) 1988 Regents of the University of California.
  * All rights reserved.
  *
  * 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
  * Redistribution and use in source and binary forms are permitted
- * provided that this notice is preserved and that due credit is given
- * to the University of California at 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'' without express or implied warranty.
+ * 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.
  *
  *
- *     @(#)mp.c        7.1 (Berkeley) %G%
+ *     @(#)mp.c        7.6 (Berkeley) %G%
  */
 
 #include "mp.h"
  */
 
 #include "mp.h"
@@ -171,39 +179,32 @@ mpopen(dev, mode)
                sleep((caddr_t)&tp->t_canq, TTIPRI);
        while (tp->t_state & TS_WOPEN) 
                sleep((caddr_t)&tp->t_canq, TTIPRI);
                sleep((caddr_t)&tp->t_canq, TTIPRI);
        while (tp->t_state & TS_WOPEN) 
                sleep((caddr_t)&tp->t_canq, TTIPRI);
-       if (tp->t_state & TS_ISOPEN) {
-               splx(s);
-               return (0);
-       }
        tp->t_state |= TS_WOPEN;
        tp->t_addr = (caddr_t)ms;
        tp->t_oproc = mpstart;
        tp->t_dev = dev;
        tp->t_state |= TS_WOPEN;
        tp->t_addr = (caddr_t)ms;
        tp->t_oproc = mpstart;
        tp->t_dev = dev;
-       ttychars(tp);
-       if (tp->t_ispeed == 0) {
-               tp->t_ispeed = B9600;
-               tp->t_ospeed = B9600;
-               tp->t_flags |= ODDP|EVENP|ECHO;
-       }
-       /*
-        * Initialize port state: init MPCC interface
-        * structures for port and setup modem control.
-        */
-       mp->mp_proto = MPPROTO_ASYNC;           /* XXX */
-       error = mpportinit(ms, mp, port);
-       if (error)
-               goto bad;
-       ev = mpparam(unit);
-       if (ev == 0) {
-               error = ENOBUFS;
-               goto bad;
+       if ((tp->t_state & TS_ISOPEN) == 0) {
+               ttychars(tp);
+               if (tp->t_ispeed == 0) {
+                       tp->t_ispeed = B9600;
+                       tp->t_ospeed = B9600;
+                       tp->t_flags = ODDP|EVENP|ECHO;
+               }
+               /*
+                * Initialize port state: init MPCC interface
+                * structures for port and setup modem control.
+                */
+               mp->mp_proto = MPPROTO_ASYNC;           /* XXX */
+               error = mpportinit(ms, mp, port);
+               if (error)
+                       goto bad;
+               ev = mpparam(unit);
+               if (ev == 0) {
+                       error = ENOBUFS;
+                       goto bad;
+               }
+               mpcmd(ev, EVCMD_OPEN, 0, ms->ms_mb, port);
        }
        }
-       mpcmd(ev, EVCMD_OPEN, 0, ms->ms_mb, port);
-       while ((tp->t_state & TS_CARR_ON) == 0)
-               sleep((caddr_t)&tp->t_rawq, TTIPRI);
-       error = mpmodem(unit, MMOD_ON);
-       if (error)
-               goto bad;
        while ((tp->t_state & TS_CARR_ON) == 0)
                sleep((caddr_t)&tp->t_rawq, TTIPRI);
        error = (*linesw[tp->t_line].l_open)(dev,tp);
        while ((tp->t_state & TS_CARR_ON) == 0)
                sleep((caddr_t)&tp->t_rawq, TTIPRI);
        error = (*linesw[tp->t_line].l_open)(dev,tp);
@@ -237,7 +238,7 @@ mpclose(dev, flag)
        mb = mp_softc[MPUNIT(unit)].ms_mb;
        mp = &mb->mb_port[port];
        s = spl8();
        mb = mp_softc[MPUNIT(unit)].ms_mb;
        mp = &mb->mb_port[port];
        s = spl8();
-       if (mp->mp_flags & MP_PROGRESS) {               /* close in progress */
+       if (mp->mp_flags & MP_PROGRESS) {       /* close in progress??? */
                if (mp->mp_flags & MP_REMBSY) {
                        mp->mp_flags &= ~MP_REMBSY;
                        splx(s);
                if (mp->mp_flags & MP_REMBSY) {
                        mp->mp_flags &= ~MP_REMBSY;
                        splx(s);
@@ -249,20 +250,18 @@ mpclose(dev, flag)
        error = 0;
        mp->mp_flags |= MP_PROGRESS;
        (*linesw[tp->t_line].l_close)(tp);
        error = 0;
        mp->mp_flags |= MP_PROGRESS;
        (*linesw[tp->t_line].l_close)(tp);
-       if (tp->t_state & TS_HUPCLS || (tp->t_state & TS_ISOPEN) == 0) 
-               if (error = mpmodem(unit, MMOD_OFF)) {
-                       mp->mp_flags &= ~MP_PROGRESS;
-                       goto out;
-               }
-       while (tp->t_state & TS_FLUSH)                  /* ??? */
-               sleep((caddr_t)&tp->t_state, TTOPRI);   /* ??? */
-       ttyclose(tp);
        ev = mp_getevent(mp, unit);
        if (ev == 0) {
        ev = mp_getevent(mp, unit);
        if (ev == 0) {
-                error = ENOBUFS;
-                goto out;
+               error = ENOBUFS;
+               mp->mp_flags &= ~MP_PROGRESS;
+               goto out;
        }
        }
+       if (tp->t_state & TS_HUPCLS || (tp->t_state & TS_ISOPEN) == 0)
+               mpmodem(unit, MMOD_OFF);
+       else
+               mpmodem(unit, MMOD_ON);
        mpcmd(ev, EVCMD_CLOSE, 0, mb, port);
        mpcmd(ev, EVCMD_CLOSE, 0, mb, port);
+       ttyclose(tp);
 out:
        if (mp->mp_flags & MP_REMBSY)
                mpclean(mb, port);
 out:
        if (mp->mp_flags & MP_REMBSY)
                mpclean(mb, port);
@@ -320,7 +319,7 @@ mpioctl(dev, cmd, data, flag)
        error = ttioctl(tp, cmd, data, flag);
        if (error >= 0) {
                if (cmd == TIOCSETP || cmd == TIOCSETN || cmd == TIOCLBIS ||
        error = ttioctl(tp, cmd, data, flag);
        if (error >= 0) {
                if (cmd == TIOCSETP || cmd == TIOCSETN || cmd == TIOCLBIS ||
-                   cmd == TIOCLBIC || cmd == TIOCLSET) {
+                   cmd == TIOCLBIC || cmd == TIOCLSET || cmd == TIOCSETC) {
                        ev = mpparam(unit);
                        if (ev == 0)
                                error = ENOBUFS;
                        ev = mpparam(unit);
                        if (ev == 0)
                                error = ENOBUFS;
@@ -378,9 +377,12 @@ mpparam(unit)
        tp = &mp_tty[unit];
        /* YUCK */
        asp = &ms->ms_async[port][mp->mp_on?mp->mp_on-1:MPINSET-1];
        tp = &mp_tty[unit];
        /* YUCK */
        asp = &ms->ms_async[port][mp->mp_on?mp->mp_on-1:MPINSET-1];
-       asp->ap_xon = tp->t_startc;
-       asp->ap_xoff = tp->t_stopc;
-       asp->ap_xena = ((tp->t_flags & RAW) ? MPA_DIS : MPA_ENA);
+       asp->ap_xon = (u_char)tp->t_startc;
+       asp->ap_xoff = (u_char)tp->t_stopc;
+       if ((tp->t_flags & RAW) || (tp->t_stopc == -1) || (tp->t_startc == -1))
+               asp->ap_xena = MPA_DIS;
+       else
+               asp->ap_xena = MPA_ENA;
        asp->ap_xany = ((tp->t_flags & DECCTQ) ? MPA_DIS : MPA_ENA);
 #ifdef notnow
        if (tp->t_flags & (RAW|LITOUT|PASS8)) {
        asp->ap_xany = ((tp->t_flags & DECCTQ) ? MPA_DIS : MPA_ENA);
 #ifdef notnow
        if (tp->t_flags & (RAW|LITOUT|PASS8)) {
@@ -653,14 +655,9 @@ mpmodem(unit, flag)
        struct mpsoftc *ms = &mp_softc[MPUNIT(unit)];
        int port = MPPORT(unit);
        register struct mpport *mp;
        struct mpsoftc *ms = &mp_softc[MPUNIT(unit)];
        int port = MPPORT(unit);
        register struct mpport *mp;
-       register struct mpevent *ev;
        register struct asyncparam *asp;
 
        mp = &ms->ms_mb->mb_port[port];
        register struct asyncparam *asp;
 
        mp = &ms->ms_mb->mb_port[port];
-       ev = mp_getevent(mp, unit);
-       if (ev == 0)
-               return (ENOBUFS);
-       /* YUCK */
        asp = &ms->ms_async[port][mp->mp_on?mp->mp_on-1:MPINSET-1];
        if (flag == MMOD_ON) {
                if (ms->ms_softCAR & (1 << port))
        asp = &ms->ms_async[port][mp->mp_on?mp->mp_on-1:MPINSET-1];
        if (flag == MMOD_ON) {
                if (ms->ms_softCAR & (1 << port))
@@ -672,8 +669,6 @@ mpmodem(unit, flag)
                setm(&asp->ap_modem, 0, DROP);
                seti(&asp->ap_intena, 0);
        }
                setm(&asp->ap_modem, 0, DROP);
                seti(&asp->ap_intena, 0);
        }
-       mpcmd(ev, EVCMD_IOCTL, A_MDMCHG, ms->ms_mb, port);
-       return (0);
 }
 
 /*
 }
 
 /*
@@ -866,7 +861,7 @@ mpxintr(unit, list)
                                mp->mp_on = mp->mp_off = mp->mp_nextrcv = 0;
                                mp->mp_flags &= ~MP_PROGRESS;
                                mp->mp_proto = MPPROTO_UNUSED;
                                mp->mp_on = mp->mp_off = mp->mp_nextrcv = 0;
                                mp->mp_flags &= ~MP_PROGRESS;
                                mp->mp_proto = MPPROTO_UNUSED;
-                               wakeup((caddr_t)&tp->t_canq);   /* ??? */
+                               wakeup((caddr_t)&tp->t_canq);
                                goto done;
                        case EVCMD_IOCTL:
                                /*
                                goto done;
                        case EVCMD_IOCTL:
                                /*
@@ -879,10 +874,9 @@ mpxintr(unit, list)
                                 * state and restart output.
                                 */
                                tp->t_state &= ~TS_BUSY;
                                 * state and restart output.
                                 */
                                tp->t_state &= ~TS_BUSY;
-                               if (tp->t_state & TS_FLUSH) {
+                               if (tp->t_state & TS_FLUSH)
                                        tp->t_state &= ~TS_FLUSH;
                                        tp->t_state &= ~TS_FLUSH;
-                                       wakeup((caddr_t)&tp->t_state);
-                               } else {
+                               else {
                                        register int cc = 0, n;
                                        struct hxmtl *hxp;
 
                                        register int cc = 0, n;
                                        struct hxmtl *hxp;