X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/682cef570a809d3a0cd221b1b8f7cb559bfef499..ad7871609881e73855d0b04da49b486cd93efca7:/usr/src/sys/tahoe/vba/mp.c diff --git a/usr/src/sys/tahoe/vba/mp.c b/usr/src/sys/tahoe/vba/mp.c index bdaadc325f..250f4c91fa 100644 --- a/usr/src/sys/tahoe/vba/mp.c +++ b/usr/src/sys/tahoe/vba/mp.c @@ -1,4 +1,40 @@ -/* mp.c 1.2 87/11/24 */ +/* + * 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, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + * + * @(#)mp.c 7.17 (Berkeley) 5/16/91 + */ #include "mp.h" #if NMP > 0 @@ -6,27 +42,25 @@ * Multi Protocol Communications Controller (MPCC). * Asynchronous Terminal Protocol Support. */ -#include "../machine/pte.h" -#include "../machine/mtpr.h" - -#include "param.h" -#include "ioctl.h" -#include "tty.h" -#include "dir.h" -#include "user.h" -#include "map.h" -#include "buf.h" -#include "conf.h" -#include "file.h" -#include "uio.h" -#include "errno.h" -#include "syslog.h" -#include "vmmac.h" -#include "kernel.h" -#include "clist.h" - -#include "../tahoevba/vbavar.h" -#include "../tahoevba/mpreg.h" +#include "sys/param.h" +#include "sys/ioctl.h" +#include "sys/tty.h" +#include "sys/user.h" +#include "sys/map.h" +#include "sys/buf.h" +#include "sys/conf.h" +#include "sys/file.h" +#include "sys/errno.h" +#include "sys/syslog.h" +#include "sys/vmmac.h" +#include "sys/kernel.h" +#include "sys/clist.h" + +#include "../include/pte.h" +#include "../include/mtpr.h" + +#include "../vba/vbavar.h" +#include "../vba/mpreg.h" #define MPCHUNK 16 #define MPPORT(n) ((n) & 0xf) @@ -42,7 +76,8 @@ struct vba_driver mpdriver = { mpprobe, 0, mpattach, 0, mpstd, "mp", mpinfo }; int mpstart(); -struct mpevent *mpparam(); +int mpparam(); +struct mpevent *mpparam2(); struct mpevent *mp_getevent(); /* @@ -75,6 +110,38 @@ struct mpsoftc { char ms_cbuf[MPMAXPORT][MPOUTSET][CBSIZE];/* input character buffers */ } mp_softc[NMP]; +struct speedtab +mpspeedtab[] = { + 9600, M9600, /* baud rate = 9600 */ + 4800, M4800, /* baud rate = 4800 */ + 2400, M2400, /* baud rate = 2400 */ + 1800, M1800, /* baud rate = 1800 */ + 1200, M1200, /* baud rate = 1200 */ + 600, M600, /* baud rate = 600 */ + 300, M300, /* baud rate = 300 */ + 200, M200, /* baud rate = 200 */ + 150, M150, /* baud rate = 150 */ + 134, M134_5, /* baud rate = 134.5 */ + 110, M110, /* baud rate = 110 */ + 75, M75, /* baud rate = 75 */ + 50, M50, /* baud rate = 50 */ + 0, M0, /* baud rate = 0 */ + 2000, M2000, /* baud rate = 2000 */ + 3600, M3600, /* baud rate = 3600 */ + 7200, M7200, /* baud rate = 7200 */ + 19200, M19200, /* baud rate = 19,200 */ + 24000, M24000, /* baud rate = 24,000 */ + 28400, M28400, /* baud rate = 28,400 */ + 37800, M37800, /* baud rate = 37,800 */ + 40300, M40300, /* baud rate = 40,300 */ + 48000, M48000, /* baud rate = 48,000 */ + 52000, M52000, /* baud rate = 52,000 */ + 56800, M56800, /* baud rate = 56,800 */ + EXTA, MEXTA, /* baud rate = Ext A */ + EXTB, MEXTB, /* baud rate = Ext B */ + -1, -1, +}; + struct tty mp_tty[NMP*MPCHUNK]; #ifndef lint int nmp = NMP*MPCHUNK; @@ -92,6 +159,7 @@ mpprobe(reg, vi) #ifdef lint br = 0; cvec = br; br = cvec; mpintr(0); + mpdlintr(0); #endif if (badaddr(reg, 2)) return (0); @@ -107,7 +175,7 @@ mpprobe(reg, vi) ms->ms_mb = (struct mblok *)ms->ms_buf.vb_rawbuf; ms->ms_ivec = MPINTRBASE + 2*vi->ui_unit; /* XXX */ br = 0x14, cvec = ms->ms_ivec; /* XXX */ - return (sizeof (struct mblok)); + return (sizeof (*reg)); } mpattach(vi) @@ -129,6 +197,7 @@ mpattach(vi) /* * Open an mpcc port. */ +/* ARGSUSED */ mpopen(dev, mode) dev_t dev; { @@ -153,51 +222,75 @@ mpopen(dev, mode) return (ENXIO); mp = &ms->ms_mb->mb_port[port]; /* host mpcc struct */ s = spl8(); - while (mp->mp_flags & MP_PROGRESS) - 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); - } + /* + * serialize open and close events + */ + while ((mp->mp_flags & MP_PROGRESS) || ((tp->t_state & TS_WOPEN) && + !(mode&O_NONBLOCK) && !(tp->t_cflag&CLOCAL))) + if (error = tsleep((caddr_t)&tp->t_canq, TTIPRI | PCATCH, + ttopen, 0)) { + splx(s); + return (error); + } +restart: tp->t_state |= TS_WOPEN; tp->t_addr = (caddr_t)ms; tp->t_oproc = mpstart; + tp->t_param = mpparam; 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; + if ((tp->t_state & TS_ISOPEN) == 0) { + ttychars(tp); + if (tp->t_ispeed == 0) { + tp->t_ispeed = TTYDEF_SPEED; + tp->t_ospeed = TTYDEF_SPEED; + tp->t_iflag = TTYDEF_IFLAG; + tp->t_oflag = TTYDEF_OFLAG; + tp->t_lflag = TTYDEF_LFLAG; + tp->t_cflag = TTYDEF_CFLAG; + } + /* + * Initialize port state: init MPCC interface + * structures for port and setup modem control. + */ + error = mpportinit(ms, mp, port); + if (error) + goto bad; + ev = mpparam2(tp, &tp->t_termios); + if (ev == 0) { + error = ENOBUFS; + goto bad; + } + mp->mp_flags |= MP_PROGRESS; + mpcmd(ev, EVCMD_OPEN, 0, ms->ms_mb, port); + /* + * wait for port to start + */ + while (mp->mp_proto != MPPROTO_ASYNC) + if (error = tsleep((caddr_t)&tp->t_canq, + TTIPRI | PCATCH, ttopen, 0)) + goto bad; + ttsetwater(tp); + mp->mp_flags &= ~MP_PROGRESS; } - /* - * 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; + while ((mode&O_NONBLOCK) == 0 && (tp->t_cflag&CLOCAL) == 0 && + (tp->t_state & TS_CARR_ON) == 0) { + if (error = ttysleep(tp, (caddr_t)&tp->t_rawq, TTIPRI | PCATCH, + ttopen, 0)) + goto bad; + /* + * a mpclose() might have disabled port. if so restart + */ + if (mp->mp_proto != MPPROTO_ASYNC) + goto restart; + tp->t_state |= TS_WOPEN; } - 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); done: splx(s); - /* wakeup anyone waiting for open to complete */ + /* + * wakeup those processes waiting for the open to complete + */ wakeup((caddr_t)&tp->t_canq); - return (error); bad: tp->t_state &= ~TS_WOPEN; @@ -207,13 +300,14 @@ bad: /* * Close an mpcc port. */ -mpclose(dev) +/* ARGSUSED */ +mpclose(dev, flag) dev_t dev; { register struct tty *tp; register struct mpport *mp; register struct mpevent *ev; - int s, port, unit, error; + int s, port, unit, error = 0; struct mblok *mb; unit = minor(dev); @@ -222,35 +316,40 @@ mpclose(dev) 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) { if (mp->mp_flags & MP_REMBSY) { mp->mp_flags &= ~MP_REMBSY; splx(s); return (0); } while (mp->mp_flags & MP_PROGRESS) - sleep((caddr_t)&tp->t_canq,TTIPRI); + if (error = tsleep((caddr_t)&tp->t_canq, + TTIPRI | PCATCH, ttclos, 0)) { + splx(s); + return (error); + } } - 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); + (*linesw[tp->t_line].l_close)(tp, flag); + ev = mp_getevent(mp, unit, 1); 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); + error = ttyclose(tp); out: if (mp->mp_flags & MP_REMBSY) mpclean(mb, port); + else + while (mp->mp_flags & MP_PROGRESS && error == 0) + error = tsleep((caddr_t)&tp->t_canq, TTIPRI | PCATCH, + ttclos, 0); splx(s); return (error); } @@ -258,27 +357,27 @@ out: /* * Read from an mpcc port. */ -mpread(dev, uio) +mpread(dev, uio, flag) dev_t dev; struct uio *uio; { struct tty *tp; tp = &mp_tty[minor(dev)]; - return ((*linesw[tp->t_line].l_read)(tp, uio)); + return ((*linesw[tp->t_line].l_read)(tp, uio, flag)); } /* * Write to an mpcc port. */ -mpwrite(dev, uio) +mpwrite(dev, uio, flag) dev_t dev; struct uio *uio; { struct tty *tp; tp = &mp_tty[minor(dev)]; - return ((*linesw[tp->t_line].l_write)(tp, uio)); + return ((*linesw[tp->t_line].l_write)(tp, uio, flag)); } /* @@ -290,8 +389,8 @@ mpioctl(dev, cmd, data, flag) { register struct tty *tp; register struct mpsoftc *ms; - register struct mpevent *ev; register struct mpport *mp; + register struct mpevent *ev; int s, port, error, unit; struct mblok *mb; @@ -299,34 +398,37 @@ mpioctl(dev, cmd, data, flag) tp = &mp_tty[unit]; ms = &mp_softc[MPUNIT(unit)]; mb = ms->ms_mb; + port = MPPORT(unit); + mp = &mb->mb_port[port]; + if (mp->mp_proto != MPPROTO_ASYNC) + return(ENXIO); error = (*linesw[tp->t_line].l_ioctl)(tp, cmd, data, flag); if (error >= 0) return (error); error = ttioctl(tp, cmd, data, flag); - if (error >= 0) { - if (cmd == TIOCSETP || cmd == TIOCSETN || cmd == TIOCLBIS || - cmd == TIOCLBIC || cmd == TIOCLSET) { - ev = mpparam(unit); - if (ev == 0) - error = ENOBUFS; - else - mpcmd(ev, EVCMD_IOCTL, A_CHGALL, mb, - MPPORT(unit)); - } + if (error >= 0) return (error); - } switch (cmd) { case TIOCSBRK: /* send break */ case TIOCCBRK: /* clear break */ - port = MPPORT(unit); - mp = &mb->mb_port[port]; s = spl8(); - ev = mp_getevent(mp, unit); - if (ev) + while (mp->mp_flags & MP_IOCTL) { + if (error = tsleep((caddr_t)&tp->t_canq, + TTIPRI | PCATCH, ttyout, 0)) { + splx(s); + return (error); + } + if (mp->mp_proto != MPPROTO_ASYNC) { + splx(s); + return (ENXIO); + } + } + ev = mp_getevent(mp, unit, 0); + if (ev) { + mp->mp_flags |= MP_IOCTL; mpcmd(ev, EVCMD_IOCTL, - (cmd == TIOCSBRK ? A_BRKON : A_BRKOFF), - mb, port); - else + (cmd == TIOCSBRK ? A_BRKON : A_BRKOFF), mb, port); + } else error = ENOBUFS; splx(s); break; @@ -341,63 +443,92 @@ mpioctl(dev, cmd, data, flag) return (error); } +mpparam(tp, t) + struct tty *tp; + struct termios *t; +{ + register struct mpevent *ev; + int unit = minor(tp->t_dev); + struct mpsoftc *ms = &mp_softc[MPUNIT(unit)]; + struct mblok *mb = ms->ms_mb; + + ev = mpparam2(tp, t); + if (ev == 0) + return (ENOBUFS); + mpcmd(ev, EVCMD_IOCTL, A_CHGALL, mb, MPPORT(unit)); + return (0); +} + struct mpevent * -mpparam(unit) - int unit; +mpparam2(tp, t) + register struct tty *tp; + struct termios *t; { register struct mpevent *ev; register struct mpport *mp; - register struct tty *tp; + int unit = minor(tp->t_dev); struct mblok *mb; struct mpsoftc *ms; register struct asyncparam *asp; - int port; + int port, speedcode; ms = &mp_softc[MPUNIT(unit)]; mb = ms->ms_mb; port = MPPORT(unit); mp = &mb->mb_port[port]; - ev = mp_getevent(mp, unit); /* XXX */ - if (ev == 0) - return (ev); - tp = &mp_tty[unit]; + ev = mp_getevent(mp, unit, 0); /* XXX */ + speedcode = ttspeedtab(t->c_ospeed, mpspeedtab); + if (ev == 0 || speedcode < 0) { +printf("mp mpunit %d port %d param2 failed ev: %x speed %d, wanted %d\n", + MPUNIT(unit), port, ev, speedcode, t->c_ospeed); + return (0); /* XXX */ + } /* 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|TANDEM)) == TANDEM ? MPA_ENA : MPA_DIS; - asp->ap_xany = (tp->t_flags & DECCTQ ? MPA_DIS : MPA_ENA); + asp->ap_xon = t->c_cc[VSTART]; + asp->ap_xoff = t->c_cc[VSTOP]; + if (!(t->c_iflag&IXON) || (asp->ap_xon == _POSIX_VDISABLE) || + (asp->ap_xoff == _POSIX_VDISABLE)) + asp->ap_xena = MPA_DIS; + else + asp->ap_xena = MPA_ENA; + asp->ap_xany = ((t->c_iflag & IXANY) ? MPA_ENA : MPA_DIS); #ifdef notnow - if (tp->t_flags & (RAW|LITOUT|PASS8)) { + if (t->t_cflag&CSIZE) == CS8) { #endif asp->ap_data = MPCHAR_8; asp->ap_parity = MPPAR_NONE; #ifdef notnow } else { asp->ap_data = MPCHAR_7; - if ((tp->t_flags & (EVENP|ODDP)) == ODDP) + if ((t->c_flags & (EVENP|ODDP)) == ODDP) /* XXX */ asp->ap_parity = MPPAR_ODD; else asp->ap_parity = MPPAR_EVEN; } #endif - if (tp->t_ospeed == B110) + asp->ap_loop = MPA_DIS; /* disable loopback */ + asp->ap_rtimer = A_RCVTIM; /* default receive timer */ + if (t->c_ospeed == B110) asp->ap_stop = MPSTOP_2; else asp->ap_stop = MPSTOP_1; - if (tp->t_ospeed == EXTA || tp->t_ospeed == EXTB) + if (t->c_ospeed == 0) { + tp->t_state |= TS_HUPCLS; + setm(&asp->ap_modem, 0, DROP); + seti(&asp->ap_intena, A_DCD); + return (ev); + } + if (t->c_ospeed == EXTA || t->c_ospeed == EXTB) asp->ap_baud = M19200; else - asp->ap_baud = tp->t_ospeed; - asp->ap_loop = MPA_DIS; /* disable loopback */ - asp->ap_rtimer = A_RCVTIM; /* default receive timer */ - if (ms->ms_softCAR & (1<ap_baud = speedcode; + if (1 || ms->ms_softCAR & (1<ap_modem, A_DTR, ASSERT); else setm(&asp->ap_modem, A_DTR, AUTO); seti(&asp->ap_intena, A_DCD); - return (ev); + return(ev); } mpstart(tp) @@ -423,7 +554,7 @@ mpstart(tp) for (i = 0; i < MPXMIT; i++) { if (tp->t_state & (TS_TIMEOUT|TS_BUSY|TS_TTSTOP)) break; - if (outq.c_cc <= TTLOWAT(tp)) { + if (outq.c_cc <= tp->t_lowat) { if (tp->t_state & TS_ASLEEP) { tp->t_state &= ~TS_ASLEEP; wakeup((caddr_t)&tp->t_outq); @@ -441,18 +572,20 @@ mpstart(tp) * and there is data to be output, set up * port transmit structure to send to mpcc. */ - if (tp->t_flags & (RAW|LITOUT)) + if (1) /* || tp->t_flags & (RAW|LITOUT)) XXX FIX */ n = ndqb(&outq, 0); else { n = ndqb(&outq, 0200); if (n == 0) { + if (xcnt > 0) + break; n = getc(&outq); timeout(ttrstrt, (caddr_t)tp, (n&0177)+6); tp->t_state |= TS_TIMEOUT; break; } } - hxp->dblock[i] = (caddr_t)vtoph(0, (int)outq.c_cf); + hxp->dblock[i] = (caddr_t)kvtophys(outq.c_cf); hxp->size[i] = n; xcnt++; /* count of xmts to send */ ndadvance(&outq, n); @@ -461,7 +594,7 @@ mpstart(tp) * If data to send, poke mpcc. */ if (xcnt) { - ev = mp_getevent(mp, unit); + ev = mp_getevent(mp, unit, 0); if (ev == 0) { tp->t_state &= ~(TS_BUSY|TS_TIMEOUT); } else { @@ -516,19 +649,32 @@ out: /* * Stop output on a line, e.g. for ^S/^Q or output flush. */ +/* ARGSUSED */ mpstop(tp, rw) register struct tty *tp; int rw; { - int s, port; - struct mpevent *ev; + register struct mpport *mp; + register struct mpevent *ev; + int unit = minor(tp->t_dev); + int port; struct mblok *mb; + int s; s = spl8(); - /* XXX: DISABLE TRANSMITTER */ if (tp->t_state & TS_BUSY) { - if ((tp->t_state & TS_TTSTOP) == 0) + if ((tp->t_state & TS_TTSTOP) == 0) { tp->t_state |= TS_FLUSH; + port = MPPORT(unit); + mb = mp_softc[MPUNIT(unit)].ms_mb; + mp = &mb->mb_port[port]; + ev = mp_getevent(mp, unit, 0); + if (ev == 0) { + splx(s); + return; + } + mpcmd(ev, EVCMD_WRITE, A_FLUSH, mb, port); + } } splx(s); } @@ -556,8 +702,8 @@ mpportinit(ms, mp, port) ev->ev_error = 0; ev->ev_flags = 0; ev->ev_count = 0; - ev->ev_un.hxl = (struct hxmtl *) vtoph(0, &ms->ms_hxl[port]); - ev->ev_params = (caddr_t) vtoph(0, &ms->ms_async[port][i]); + ev->ev_un.hxl = (struct hxmtl *) kvtophys(&ms->ms_hxl[port]); + ev->ev_params = (caddr_t) kvtophys(&ms->ms_async[port][i]); } ev = &mp->mp_sendq[0]; for (i = 0; ev < &mp->mp_sendq[MPOUTSET]; ev++, i++) { @@ -565,12 +711,13 @@ mpportinit(ms, mp, port) /* to host until open has completed */ ev->ev_status = EVSTATUS_FREE; ev->ev_cmd = 0; + ev->ev_opts = 0; ev->ev_error = 0; ev->ev_flags = 0; ev->ev_count = 0; ptr = (caddr_t) &ms->ms_cbuf[port][i][0]; - ev->ev_un.rcvblk = (u_char *)vtoph(0, ptr); - ev->ev_params = (caddr_t) vtoph(0, ptr); + ev->ev_un.rcvblk = (u_char *)kvtophys(ptr); + ev->ev_params = (caddr_t) kvtophys(ptr); } return (0); } @@ -598,9 +745,10 @@ mpcmd(ev, cmd, flags, mb, port) * Return the next available event entry for the indicated port. */ struct mpevent * -mp_getevent(mp, unit) +mp_getevent(mp, unit, cls_req) register struct mpport *mp; int unit; + int cls_req; { register struct mpevent *ev; int i, s; @@ -613,13 +761,15 @@ mp_getevent(mp, unit) * If not a close request, verify one extra * event is available for closing the port. */ - if ((mp->mp_flags && MP_PROGRESS) == 0) { + if (!cls_req) { if ((i = mp->mp_on + 1) >= MPINSET) i = 0; if (mp->mp_recvq[i].ev_status != EVSTATUS_FREE) goto bad; } /* init inbound fields marking this entry as busy */ + ev->ev_cmd = 0; + ev->ev_opts = 0; ev->ev_error = 0; ev->ev_flags = 0; ev->ev_count = 0; @@ -630,7 +780,8 @@ mp_getevent(mp, unit) return (ev); bad: splx(s); - log(LOG_ERR, "mp%d: port%d, out of events", MPUNIT(unit), MPPORT(unit)); + log(LOG_ERR, "mp%d: port%d, out of events\n", + MPUNIT(unit), MPPORT(unit)); return ((struct mpevent *)0); } @@ -640,17 +791,12 @@ mpmodem(unit, flag) 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]; - 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)) + if (1 || ms->ms_softCAR & (1 << port))/* XXX HARDWIRE FOR NOW */ setm(&asp->ap_modem, A_DTR, ASSERT); else setm(&asp->ap_modem, A_DTR, AUTO); @@ -659,8 +805,6 @@ mpmodem(unit, flag) setm(&asp->ap_modem, 0, DROP); seti(&asp->ap_intena, 0); } - mpcmd(ev, EVCMD_IOCTL, A_MDMCHG, ms->ms_mb, port); - return (0); } /* @@ -719,13 +863,10 @@ mpcleanport(mb, port) mp = &mb->mb_port[port]; if (mp->mp_proto == MPPROTO_ASYNC) { mp->mp_flags = MP_REMBSY; - /* flush I/O queues and send hangup signals */ + /* signal loss of carrier and close */ tp = &mp_tty[mb->mb_unit*MPCHUNK+port]; - tp->t_state &= ~TS_CARR_ON; ttyflush(tp, FREAD|FWRITE); - gsignal(tp->t_pgrp, SIGHUP); - gsignal(tp->t_pgrp, SIGKILL); - mpclose(tp->t_dev, 0); + (void) (*linesw[tp->t_line].l_modem)(tp, 0); } } @@ -736,7 +877,7 @@ mpclean(mb, port) register struct mpport *mp; register struct mpevent *ev; register int i; - char list[2], *cp; + u_char list[2]; int unit; mp = &mb->mb_port[port]; @@ -780,7 +921,6 @@ mpintr(mpcc) { register struct mblok *mb; register struct his *his; - register int i; mb = mp_softc[mpcc].ms_mb; if (mb == 0) { @@ -805,7 +945,7 @@ mpintr(mpcc) * Handler for processing completion of transmitted events. */ mpxintr(unit, list) - register char *list; + register u_char *list; { register struct mpport *mp; register struct mpevent *ev; @@ -814,6 +954,7 @@ mpxintr(unit, list) register struct asyncparam *ap; struct mpsoftc *ms; int port, i, j; +# define nextevent(mp) &mp->mp_recvq[mp->mp_off] ms = &mp_softc[unit]; mb = mp_softc[unit].ms_mb; @@ -823,12 +964,11 @@ mpxintr(unit, list) */ mp = &mb->mb_port[port]; tp = &mp_tty[unit*MPCHUNK + port]; -#define nextevent(mp) &mp->mp_recvq[mp->mp_off] ev = nextevent(mp); - for(; ev->ev_status & EVSTATUS_DONE; ev = nextevent(mp)) { + for (; ev->ev_status & EVSTATUS_DONE; ev = nextevent(mp)) { /* YUCK */ ap = &ms->ms_async[port][mp->mp_off]; - mppurge(ap, sizeof (*ap)); + mppurge((caddr_t)ap, (int)sizeof (*ap)); switch (ev->ev_cmd) { case EVCMD_OPEN: /* @@ -839,6 +979,10 @@ mpxintr(unit, list) mp->mp_sendq[i].ev_status = EVSTATUS_GO; (*linesw[tp->t_line].l_modem) (tp, ap->ap_modem.mc_dcd == ASSERT); + mp_freein(ev); + adjptr(mp->mp_off, MPINSET); + mp->mp_proto = MPPROTO_ASYNC; /* XXX */ + wakeup((caddr_t)&tp->t_canq); break; case EVCMD_CLOSE: /* @@ -852,34 +996,38 @@ mpxintr(unit, list) mp->mp_sendq[i].ev_un.rcvblk = 0; mp->mp_sendq[i].ev_params = 0; } - tp->t_state &= ~TS_CARR_ON; + mp_freein(ev); + adjptr(mp->mp_off, MPINSET); + tp->t_state &= ~(TS_CARR_ON|TS_BUSY|TS_FLUSH); 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); /* ??? */ - goto done; + wakeup((caddr_t)&tp->t_canq); + break; case EVCMD_IOCTL: - /* - * Nothing to do, just pitch. - */ + mp_freein(ev); + adjptr(mp->mp_off, MPINSET); + mp->mp_flags &= ~MP_IOCTL; + wakeup((caddr_t)&tp->t_canq); break; case EVCMD_WRITE: /* * Transmission completed, update tty * state and restart output. */ - tp->t_state &= ~TS_BUSY; - if (tp->t_state & TS_FLUSH) { - tp->t_state &= ~TS_FLUSH; - wakeup((caddr_t)&tp->t_state); - } else { - register int cc = 0, i; - struct hxmtl *hxp; - - hxp = &ms->ms_hxl[port]; - for(i = 0; i < ev->ev_count; i++) - cc += hxp->size[i]; - ndflush(&tp->t_outq, cc); + if (ev->ev_opts != A_FLUSH) { + tp->t_state &= ~TS_BUSY; + if (tp->t_state & TS_FLUSH) + tp->t_state &= ~TS_FLUSH; + else { + register int cc = 0, n; + struct hxmtl *hxp; + + hxp = &ms->ms_hxl[port]; + for (n=0;n < ev->ev_count; n++) + cc += hxp->size[n]; + ndflush(&tp->t_outq, cc); + } } switch (ev->ev_error) { case A_SIZERR: /*# error in xmt data size */ @@ -889,33 +1037,39 @@ mpxintr(unit, list) mplog(unit, port, A_NOXBUF, 0); break; } + mp_freein(ev); + adjptr(mp->mp_off, MPINSET); mpstart(tp); break; default: - mplog(unit, port, A_INVCMD, ev->ev_cmd); + mplog(unit, port, A_INVCMD, (int)ev->ev_cmd); + mp_freein(ev); + adjptr(mp->mp_off, MPINSET); break; } - /* re-init all values in this entry */ - ev->ev_cmd = 0; - ev->ev_opts = 0; - ev->ev_error = 0; - ev->ev_flags = 0; - ev->ev_count = 0; - /* show this entry is available for use */ - ev->ev_status = EVSTATUS_FREE; - adjptr(mp->mp_off, MPINSET); -#undef nextevent } -done: - ; } +#undef nextevent +} + +mp_freein(ev) + register struct mpevent *ev; +{ + /* re-init all values in this entry */ + ev->ev_cmd = 0; + ev->ev_opts = 0; + ev->ev_error = 0; + ev->ev_flags = 0; + ev->ev_count = 0; + /* show this entry is available for use */ + ev->ev_status = EVSTATUS_FREE; } /* * Handler for processing received events. */ mprintr(unit, list) - char *list; + u_char *list; { register struct tty *tp; register struct mpport *mp; @@ -935,81 +1089,105 @@ mprintr(unit, list) mp = &mb->mb_port[port]; ev = &mp->mp_sendq[mp->mp_nextrcv]; while (ev->ev_status & EVSTATUS_DONE) { - if (ev->ev_cmd != EVCMD_READ && - ev->ev_cmd != EVCMD_STATUS) { - mplog(unit, port, "unexpected command", - ev->ev_cmd); - goto next; - } - if (ev->ev_cmd == EVCMD_STATUS) { + switch(ev->ev_cmd) { + case EVCMD_STATUS: /* * Status change, look for carrier changes. */ - if (ev->ev_opts == DCDASRT || - ev->ev_opts == DCDDROP) - (*linesw[tp->t_line].l_modem) - (tp, ev->ev_opts == DCDASRT); - else + switch(ev->ev_opts) { + case DCDASRT: + (*linesw[tp->t_line].l_modem)(tp, 1); + wakeup((caddr_t)&tp->t_canq); + break; + case DCDDROP: + (*linesw[tp->t_line].l_modem)(tp, 0); + wakeup((caddr_t)&tp->t_canq); + break; + case NORBUF: + case NOEBUF: + mplog(unit, port, + "out of receive events", 0); + break; + default: mplog(unit, port, "unexpect status command", - ev->ev_opts); - goto next; - } - /* - * Process received data. - */ - if ((tp->t_state & (TS_ISOPEN|TS_WOPEN)) == 0) - goto next; - cc = ev->ev_count; - if (cc == 0) - goto next; - /* YUCK */ - cp = ms->ms_cbuf[port][mp->mp_nextrcv]; - mppurge(cp, CBSIZE); - while (cc-- > 0) { - /* - * A null character is inserted, potentially - * when a break or framing error occurs. If - * we're not in raw mode, substitute the - * interrupt character. - */ - if (*cp == 0 && - (ev->ev_error == BRKASRT || - ev->ev_error == FRAMERR)) - if ((tp->t_flags&RAW) == 0) - *cp = tp->t_intrc; - (*linesw[tp->t_line].l_rint)(*cp++, tp); - } - /* setup for next read */ - ptr = (caddr_t)&mp_softc[unit].ms_cbuf[port][mp->mp_nextrcv][0]; - ev->ev_un.rcvblk = (u_char *)vtoph(0, ptr); - ev->ev_params = (caddr_t) vtoph(0, ptr); - switch(ev->ev_error) { - case RCVDTA: /* Normal (good) rcv data */ - rcverr = (char *)0; - break; - case PARERR: /* parity error */ - rcverr = "parity error"; - break; - case FRAMERR: /* frame error */ - rcverr = "frame error"; - break; - case OVRNERR: /* Overrun error */ - rcverr = "overrun error"; + (int)ev->ev_opts); + break; + } break; - case OVFERR: /* Overflow error */ - rcverr = "overflow error"; + case EVCMD_READ: + /* + * Process received data. + */ + if ((tp->t_state & TS_ISOPEN) == 0) { + wakeup((caddr_t)&tp->t_rawq); + break; + } + if ((cc = ev->ev_count) == 0) + break; + cp = ms->ms_cbuf[port][mp->mp_nextrcv]; + mppurge(cp, CBSIZE); + while (cc-- > 0) { + /* + * A null character is inserted, + * potentially when a break or framing + * error occurs. If we're not in raw + * mode, substitute the interrupt + * character. + */ + /*** XXX - FIXUP ***/ + if (*cp == 0 && + (ev->ev_error == BRKASRT || + ev->ev_error == FRAMERR)) + if ((tp->t_flags&RAW) == 0) + ; + /* XXX was break */ + (*linesw[tp->t_line].l_rint)(*cp++, tp); + } + /* setup for next read */ + ptr = (caddr_t)&mp_softc[unit].ms_cbuf[port][mp->mp_nextrcv][0]; + ev->ev_un.rcvblk = (u_char *)kvtophys(ptr); + ev->ev_params = (caddr_t) kvtophys(ptr); + switch(ev->ev_error) { + case RCVDTA: + /* Normal (good) rcv data do not + * report the following they are + * "normal" errors + */ + case FRAMERR: + /* frame error */ + case BRKASRT: + /* Break condition */ + case PARERR: + /* parity error */ + rcverr = (char *)0; + break; + case OVRNERR: + /* Overrun error */ + rcverr = "overrun error"; + break; + case OVFERR: + /* Overflow error */ + rcverr = "overflow error"; + break; + default: + rcverr = "undefined rcv error"; + break; + } + if (rcverr != (char *)0) + mplog(unit, port, rcverr, + (int)ev->ev_error); break; default: - rcverr = "undefined rcv error"; + mplog(unit, port, "unexpected command", + (int)ev->ev_cmd); + break; } - if (rcverr != (char *)0) - mplog(unit, port, rcverr, ev->ev_error); - next: ev->ev_cmd = 0; ev->ev_opts = 0; ev->ev_error = 0; ev->ev_flags = 0; + ev->ev_count = 0; ev->ev_status = EVSTATUS_GO; /* start next read */ adjptr(mp->mp_nextrcv, MPOUTSET); ev = &mp->mp_sendq[mp->mp_nextrcv]; @@ -1047,7 +1225,6 @@ mptimeint(mb) */ mpintmpcc(mb, port) register struct mblok *mb; - u_short port; { mb->mb_intr[port] |= MPSEMA_WORK; @@ -1055,12 +1232,12 @@ mpintmpcc(mb, port) mb->mb_mpintcnt = 0; *(u_short *)mpinfo[mb->mb_unit]->ui_addr = 2; if (mb->mb_mpintclk) { - untimeout(mptimeint, mb); + untimeout(mptimeint, (caddr_t)mb); mb->mb_mpintclk = 0; } } else { if (mb->mb_mpintclk == 0) { - timeout(mptimeint, mb, 4); + timeout(mptimeint, (caddr_t)mb, 4); mb->mb_mpintclk = (caddr_t)1; } } @@ -1162,8 +1339,8 @@ mpdlwrite(dev, uio) return (EFAULT); dl = &ms->ms_mb->mb_dl; dl->mpdl_count = uio->uio_iov->iov_len; - dl->mpdl_data = (caddr_t) vtoph((struct proc *)0, mpdlbuf); - if (error = uiomove(mpdlbuf, dl->mpdl_count, UIO_WRITE, uio)) + dl->mpdl_data = (caddr_t) kvtophys(mpdlbuf); + if (error = uiomove(mpdlbuf, (int)dl->mpdl_count, uio)) return (error); uio->uio_resid -= dl->mpdl_count; /* set up return from write */ dl->mpdl_cmd = MPDLCMD_NORMAL; @@ -1175,7 +1352,6 @@ mpdlclose(dev) dev_t dev; { register struct mblok *mb = mp_softc[MPUNIT(minor(dev))].ms_mb; - int ret = 0; if (mb == 0 || mb->mb_status != MP_DLDONE) { mpbogus.status = 0; @@ -1190,25 +1366,18 @@ mpdlclose(dev) return (0); } -mpreset(dev) - dev_t dev; -{ - /* XXX */ -} - -int mpdltimeout(); - +/* ARGSUSED */ mpdlioctl(dev, cmd, data, flag) dev_t dev; caddr_t data; { register struct mblok *mb; register struct mpdl *dl; - int unit, error, s, i, j; + int unit, error = 0, s, i; mb = mp_softc[unit=MPUNIT(minor(dev))].ms_mb; if (mb == 0) - return (EEXIST); + return (EEXIST); dl = &mb->mb_dl; error = 0; switch (cmd) { @@ -1235,14 +1404,20 @@ mpdlioctl(dev, cmd, data, flag) break; case MPIOASYNCNF: bcopy(data, mpdlbuf, sizeof (struct abdcf)); - dl->mpdl_data = (caddr_t) vtoph((struct proc *)0, mpdlbuf); + dl->mpdl_data = (caddr_t) kvtophys(mpdlbuf); dl->mpdl_count = sizeof (struct abdcf); dl->mpdl_cmd = MPIOASYNCNF&IOCPARM_MASK; error = mpdlwait(dl); break; case MPIOSTARTDL: + s = spl8(); while (mpdlbusy) - sleep((caddr_t)&mpdlbusy, PZERO+1); + if (error = tsleep((caddr_t)&mpdlbusy, + (PZERO+1) | PCATCH, devioc, 0)) + break; + splx(s); + if (error) + break; mpdlbusy++; /* initialize the downloading interface */ mpbogus.magic = MPMAGIC; @@ -1260,21 +1435,14 @@ mpdlioctl(dev, cmd, data, flag) mb->mb_diagswitch[1] = 'P'; s = spl8(); *(u_short *)mpinfo[unit]->ui_addr = 2; - timeout(mpdltimeout, mb, 30*hz); /* approx 15 seconds */ - sleep((caddr_t)&mb->mb_status, PZERO+1); + error = tsleep((caddr_t)&mb->mb_status, (PZERO+1) | PCATCH, + devio, 30*hz); splx(s); - if (mb->mb_status == MP_DLOPEN) { - untimeout(mpdltimeout, mb); - } else if (mb->mb_status == MP_DLTIME) { - mpbogus.status = 0; + if (error == EWOULDBLOCK) error = ETIMEDOUT; - } else { + if (error) mpbogus.status = 0; - error = ENXIO; - log(LOG_ERR, "mp%d: start download: unknown status %x", - unit, mb->mb_status); - } - bzero(mb->mb_port, sizeof (mb->mb_port)); + bzero((caddr_t)mb->mb_port, sizeof (mb->mb_port)); break; case MPIORESETBOARD: s = spl8(); @@ -1345,7 +1513,7 @@ mpdlintr(mpcc) return; case MP_DLPEND: mb->mb_status = MP_DLOPEN; - wakeup(&mb->mb_status); + wakeup((caddr_t)&mb->mb_status); /* fall thru... */ case MP_DLTIME: return; @@ -1363,14 +1531,6 @@ mpdlintr(mpcc) } } -mpdltimeout(mp) - struct mblok *mp; -{ - - mp->mb_status = MP_DLTIME; - wakeup((caddr_t)&mp->mb_status); -} - /* * Wait for a transfer to complete or a timeout to occur. */ @@ -1382,9 +1542,12 @@ mpdlwait(dl) s = spl8(); dl->mpdl_status = EVSTATUS_GO; while (dl->mpdl_status != EVSTATUS_FREE) { - sleep((caddr_t)&dl->mpdl_status, PZERO+1); + error = tsleep((caddr_t)&dl->mpdl_status, (PZERO+1) | PCATCH, + devout, 0); if (mpdlerr == MP_DLERROR) error = EIO; + if (error) + break; } splx(s); return (error);