xref: /csrg-svn/sys/tahoe/vba/vx.c (revision 25881)
1 /*	vx.c	1.6	86/01/13	*/
2 
3 #include "vx.h"
4 #if NVX > 0
5 /*
6  * VIOC-X driver
7  */
8 #ifdef VXPERF
9 #define	DOSCOPE
10 #endif
11 
12 #include "../tahoe/pte.h"
13 
14 #include "param.h"
15 #include "ioctl.h"
16 #include "tty.h"
17 #include "dir.h"
18 #include "user.h"
19 #include "map.h"
20 #include "buf.h"
21 #include "conf.h"
22 #include "file.h"
23 #include "uio.h"
24 #include "proc.h"
25 #include "vm.h"
26 #include "kernel.h"
27 
28 #include "../tahoevba/vbavar.h"
29 #include "../tahoevba/vxreg.h"
30 #include "../tahoevba/scope.h"
31 #include "vbsc.h"
32 #if NVBSC > 0
33 #include "../tahoebsc/bscio.h"
34 #include "../tahoebsc/bsc.h"
35 #ifdef BSC_DEBUG
36 #include "../tahoebsc/bscdebug.h"
37 #endif
38 
39 char	bscport[NVX*16];
40 #endif
41 
42 #ifdef VX_DEBUG
43 long	vxintr4 = 0;
44 #define VXERR4	1
45 #define VXNOBUF	2
46 long	vxdebug = 0;
47 #define VXVCM	1
48 #define VXVCC	2
49 #define VXVCX	4
50 #include "../tahoesna/snadebug.h"
51 #endif
52 
53 /*
54  * Interrupt type bits passed to vinthandl().
55  */
56 #define CMDquals 0		/* command completed interrupt */
57 #define RSPquals 1		/* command response interrupt */
58 #define UNSquals 2		/* unsolicited interrupt */
59 
60 struct	tty vx_tty[NVX*16];
61 int	vxstart(), ttrstrt();
62 struct	vxcmd *vobtain(), *nextcmd();
63 
64 /*
65  * Driver information for auto-configuration stuff.
66  */
67 int	vxprobe(), vxattach(), vxrint();
68 struct	vba_device *vxinfo[NVX];
69 long	vxstd[] = { 0 };
70 struct	vba_driver vxdriver =
71     { vxprobe, 0, vxattach, 0, vxstd, "vx", vxinfo };
72 
73 struct	vx_softc {
74 	u_char	vs_type;	/* 0: viox-x/vioc-b, 1: vioc-bop */
75 	u_char	vs_bop;		/* bop board # for vioc-bop's */
76 	u_char	vs_loport;	/* low port nbr */
77 	u_char	vs_hiport;	/* high port nbr */
78 	u_short	vs_nbr;		/* viocx number */
79 	u_short	vs_maxcmd;	/* max number of concurrent cmds */
80 	u_short	vs_silosiz;	/* silo size */
81 	short	vs_vers;	/* vioc/pvioc version */
82 #define	VXV_OLD	0		/* PVIOCX | VIOCX */
83 #define	VXV_NEW	1		/* NPVIOCX | NVIOCX */
84 	short	vs_xmtcnt;	/* xmit commands pending */
85 	short	vs_brkreq;	/* send break requests pending */
86 	short	vs_active;	/* active port bit array or flag */
87 	short 	vs_state;	/* controller state */
88 #define	VXS_READY	0	/* ready for commands */
89 #define VXS_RESET	1	/* in process of reseting */
90 	caddr_t vs_mricmd;	/* most recent issued cmd */
91 	u_int	vs_ivec;	/* interrupt vector base */
92 	struct	vxcmd *vs_avail;/* next available command buffer */
93 	struct	vxcmd *vs_build;
94 	struct	vxcmd vs_lst[NVCXBUFS];
95 	struct	vcmds vs_cmds;
96 } vx_softc[NVX];
97 
98 vxprobe(reg, vi)
99 	caddr_t reg;
100 	struct vba_device *vi;
101 {
102 	register int br, cvec;			/* must be r12, r11 */
103 	register struct vxdevice *vp = (struct vxdevice *)reg;
104 	register struct vx_softc *vs;
105 
106 #ifdef lint
107 	br = 0; cvec = br; br = cvec;
108 	vackint(0); vunsol(0); vcmdrsp(0); vxfreset(0);
109 #endif
110 	if (badaddr((caddr_t)vp, 1))
111 		return (0);
112 	vp->v_fault = 0;
113 	vp->v_vioc = V_BSY;
114 	vp->v_hdwre = V_RESET;		/* reset interrupt */
115 	DELAY(4000000);
116 	if (vp->v_fault != VXF_READY)
117 		return (0);
118 	vs = &vx_softc[vi->ui_unit];
119 #ifdef notdef
120 	/*
121 	 * Align vioc interrupt vector base to 4 vector
122 	 * boundary and fitting in 8 bits (is this necessary,
123 	 * wish we had documentation).
124 	 */
125 	if ((vi->ui_hd->vh_lastiv -= 3) > 0xff)
126 		vi->ui_hd->vh_lastiv = 0xff;
127 	vs->vs_ivec = vi->ui_hd->vh_lastiv = vi->ui_hd->vh_lastiv &~ 0x3;
128 #else
129 	vs->vs_ivec = 0x40+vi->ui_unit*4;
130 #endif
131 	br = 0x18, cvec = vs->vs_ivec;	/* XXX */
132 	return (sizeof (struct vxdevice));
133 }
134 
135 vxattach(vi)
136 	register struct vba_device *vi;
137 {
138 
139 	vxinit(vi->ui_unit, (long)1);
140 }
141 
142 /*
143  * Open a VX line.
144  */
145 /*ARGSUSED*/
146 vxopen(dev, flag)
147 	dev_t dev;
148 	int flag;
149 {
150 	register struct tty *tp;	/* pointer to tty struct for port */
151 	register struct vx_softc *vs;
152 	register struct vba_device *vi;
153 	int unit, vx, s, error;
154 
155 	unit = minor(dev);
156 	vx = unit >> 4;
157 	if (unit >= NVX*16 || (vi = vxinfo[vx])== 0 || vi->ui_alive == 0)
158 		return (ENXIO);
159 	tp = &vx_tty[unit];
160 	if (tp->t_state&TS_XCLUDE && u.u_uid != 0)
161 		return (EBUSY);
162 	vs = &vx_softc[vx];
163 #ifdef notdef
164 	if (unit < vs->vs_loport || vs->vs_hiport < unit)	/* ??? */
165 		return (ENXIO);
166 #endif
167 	tp->t_addr = (caddr_t)vs;
168 	tp->t_oproc = vxstart;
169 	tp->t_dev = dev;
170 	s = spl8();
171 	tp->t_state |= TS_WOPEN;
172 	if ((tp->t_state&TS_ISOPEN) == 0) {
173 		ttychars(tp);
174 		if (tp->t_ispeed == 0) {
175 			tp->t_ispeed = SSPEED;
176 			tp->t_ospeed = SSPEED;
177 			tp->t_flags |= ODDP|EVENP|ECHO;
178 		}
179 		vxparam(dev);
180 	}
181 	if (!vcmodem(dev, VMOD_ON))
182 		while ((tp->t_state&TS_CARR_ON) == 0)
183 			sleep((caddr_t)&tp->t_canq, TTIPRI);
184 	error = (*linesw[tp->t_line].l_open)(dev,tp);
185 	splx(s);
186 	return (error);
187 }
188 
189 /*
190  * Close a VX line.
191  */
192 /*ARGSUSED*/
193 vxclose(dev, flag)
194 	dev_t dev;
195 	int flag;
196 {
197 	register struct tty *tp;
198 	int unit, s;
199 
200 	unit = minor(dev);
201 	tp = &vx_tty[unit];
202 	s = spl8();
203 	(*linesw[tp->t_line].l_close)(tp);
204 	if ((tp->t_state & (TS_ISOPEN|TS_HUPCLS)) == (TS_ISOPEN|TS_HUPCLS))
205 		if (!vcmodem(dev, VMOD_OFF))
206 			tp->t_state &= ~TS_CARR_ON;
207 	/* wait for the last response */
208 	while (tp->t_state&TS_FLUSH)
209 		sleep((caddr_t)&tp->t_state, TTOPRI);
210 	ttyclose(tp);
211 	splx(s);
212 }
213 
214 /*
215  * Read from a VX line.
216  */
217 vxread(dev, uio)
218 	dev_t dev;
219 	struct uio *uio;
220 {
221 	struct tty *tp = &vx_tty[minor(dev)];
222 
223 	return ((*linesw[tp->t_line].l_read)(tp, uio));
224 }
225 
226 /*
227  * write on a VX line
228  */
229 vxwrite(dev, uio)
230 	dev_t dev;
231 	struct uio *uio;
232 {
233 	register struct tty *tp = &vx_tty[minor(dev)];
234 
235 	return ((*linesw[tp->t_line].l_write)(tp, uio));
236 }
237 
238 /*
239  * VIOCX unsolicited interrupt.
240  */
241 vxrint(vx)
242 	register vx;
243 {
244 	register struct tty *tp, *tp0;
245 	register struct vxdevice *addr;
246 	register struct vx_softc *vs;
247 	struct vba_device *vi;
248 	register int nc, c;
249 	register struct silo {
250 		char	data, port;
251 	} *sp;
252 	short *osp;
253 	int overrun = 0;
254 
255 	vi = vxinfo[vx];
256 	if (vi == 0 || vi->ui_alive == 0)
257 		return;
258 	addr = (struct vxdevice *)vi->ui_addr;
259 	switch (addr->v_uqual&037) {
260 	case 0:
261 		break;
262 	case 2:
263 		printf("vx%d: vc proc err, ustat %x\n", addr->v_ustat);
264 		vxstreset(vx);
265 		return (0);
266 	case 3:
267 		vcmintr(vx);
268 		return (1);
269 	case 4:
270 		return (1);
271 	default:
272 		printf("vx%d: vc uqual err, uqual %x\n", addr->v_uqual);
273 		vxstreset(vx);
274 		return (0);
275 	}
276 	vs = &vx_softc[vx];
277 	if (vs->vs_vers == VXV_NEW)
278 		sp = (struct silo *)((caddr_t)addr + *(short *)addr->v_usdata);
279 	else
280 		sp = (struct silo *)((caddr_t)addr+VX_SILO+(addr->v_usdata[0]<<6));
281 	nc = *(osp = (short *)sp);
282 	if (nc == 0)
283 		return (1);
284 	if (vs->vs_vers == VXV_NEW && nc > vs->vs_silosiz) {
285 		printf("vx%d: %d exceeds silo size\n", nc);
286 		nc = vs->vs_silosiz;
287 	}
288 	tp0 = &vx_tty[vx*16];
289 	sp = (struct silo *)(((short *)sp)+1);
290 	for (; nc > 0; nc--, sp = (struct silo *)(((short *)sp)+1)) {
291 		c = sp->port & 017;
292 		if (vs->vs_loport > c || c > vs->vs_hiport)
293 			continue;
294 		tp = tp0 + c;
295 		if( (tp->t_state&TS_ISOPEN) == 0) {
296 			wakeup((caddr_t)&tp->t_rawq);
297 			continue;
298 		}
299 		c = sp->data;
300 		if ((sp->port&VX_RO) == VX_RO && !overrun) {
301 			printf("vx%d: receiver overrun\n", vi->ui_unit);
302 			overrun = 1;
303 			continue;
304 		}
305 		if (sp->port&VX_PE)
306 			if ((tp->t_flags&(EVENP|ODDP)) == EVENP ||
307 			    (tp->t_flags&(EVENP|ODDP)) == ODDP)
308 				continue;
309 		if (sp->port&VX_FE) {
310 			/*
311 			 * At framing error (break) generate
312 			 * a null (in raw mode, for getty), or a
313 			 * interrupt (in cooked/cbreak mode).
314 			 */
315 			if (tp->t_flags&RAW)
316 				c = 0;
317 			else
318 				c = tp->t_intrc;
319 		}
320 		(*linesw[tp->t_line].l_rint)(c, tp);
321 	}
322 	*osp = 0;
323 	return (1);
324 }
325 
326 /*
327  * Ioctl for VX.
328  */
329 vxioctl(dev, cmd, data, flag)
330 	dev_t dev;
331 	caddr_t	data;
332 {
333 	register struct tty *tp;
334 	int error;
335 
336 	tp = &vx_tty[minor(dev)];
337 	error = (*linesw[tp->t_line].l_ioctl)(tp, cmd, data, flag);
338 	if (error == 0)
339 		return (error);
340 	error = ttioctl(tp, cmd, data, flag);
341 	if (error >= 0) {
342 		if (cmd == TIOCSETP || cmd == TIOCSETN)
343 			vxparam(dev);
344 		return (error);
345 	}
346 	return (ENOTTY);
347 }
348 
349 vxparam(dev)
350 	dev_t dev;
351 {
352 
353 	vxcparam(dev, 1);
354 }
355 
356 /*
357  * Set parameters from open or stty into the VX hardware
358  * registers.
359  */
360 vxcparam(dev, wait)
361 	dev_t dev;
362 	int wait;
363 {
364 	register struct tty *tp;
365 	register struct vx_softc *vs;
366 	register struct vxcmd *cp;
367 	int s;
368 
369 	tp = &vx_tty[minor(dev)];
370 	vs = (struct vx_softc *)tp->t_addr;
371 	cp = vobtain(vs);
372 	s = spl8();
373 	cp->cmd = VXC_LPARAX;		/* set command to "load parameters" */
374 	cp->par[1] = minor(dev)&017;	/* port number */
375 	cp->par[2] = (tp->t_flags&RAW) ? 0 : tp->t_startc;	/* XON char */
376 	cp->par[3] = (tp->t_flags&RAW) ? 0 : tp->t_stopc;	/* XOFF char */
377 	if (tp->t_flags&(RAW|LITOUT) ||
378 	    (tp->t_flags&(EVENP|ODDP)) == (EVENP|ODDP)) {
379 		cp->par[4] = 0xc0;	/* 8 bits of data */
380 		cp->par[7] = 0;		/* no parity */
381 	} else {
382 		cp->par[4] = 0x40;	/* 7 bits of data */
383 		if ((tp->t_flags&(EVENP|ODDP)) == ODDP)
384 			cp->par[7] = 1;		/* odd parity */
385 		else if((tp->t_flags&(EVENP|ODDP)) == EVENP)
386 			cp->par[7] = 3;		/* even parity */
387 		else
388 			cp->par[7] = 0;		/* no parity */
389 	}
390 	cp->par[5] = 0x4;			/* 1 stop bit */
391 	cp->par[6] = tp->t_ospeed;
392 	if (vcmd(vs->vs_nbr, (caddr_t)&cp->cmd) && wait)
393 		sleep((caddr_t)cp,TTIPRI);
394 	splx(s);
395 }
396 
397 /*
398  * VIOCX command response interrupt.
399  * For transmission, restart output to any active port.
400  * For all other commands, just clean up.
401  */
402 vxxint(vx, cp)
403 	register int vx;
404 	register struct vxcmd *cp;
405 {
406 	register struct	vxmit *vp, *pvp;
407 	register struct	tty *tp, *tp0;
408 	register struct	vx_softc *vs;
409 	register struct tty *hp;
410 
411 	vs = &vx_softc[vx];
412 	cp = (struct vxcmd *)((long *)cp-1);
413 #if NVBSC > 0
414 	if (cp->cmd == VXC_MDMCTL1 || cp->cmd == VXC_HUNTMD1 ||
415 	    cp->cmd == VXC_LPARAX1) {
416 		vrelease(vs, cp);
417 		wakeup((caddr_t)cp);
418 		return;
419 	}
420 #endif
421 	switch (cp->cmd&0xff00) {
422 
423 	case VXC_LIDENT:	/* initialization complete */
424 		if (vs->vs_state == VXS_RESET) {
425 			vxfnreset(vx, cp);
426 			vinthandl(vx, ((V_BSY|RSPquals) << 8)|V_INTR);
427 		}
428 		cp->cmd++;
429 		return;
430 
431 	case VXC_XMITDTA:
432 	case VXC_XMITIMM:
433 		break;
434 
435 	case VXC_LPARAX:
436 		wakeup((caddr_t)cp);
437 		/* fall thru... */
438 	default:	/* VXC_MDMCTL or VXC_FDTATOX */
439 		vrelease(vs, cp);
440 		if (vs->vs_state == VXS_RESET)
441 			vinthandl(vx, ((V_BSY|RSPquals) << 8)|V_INTR);
442 		return;
443 	}
444 	tp0 = &vx_tty[vx*16];
445 	vp = (struct vxmit *)(cp->par + (cp->cmd & 07)*sizeof (struct vxmit));
446 	for (; vp >= (struct vxmit *)cp->par; vp--) {
447 		tp = tp0 + (vp->line & 017);
448 #if NVBSC > 0
449 		if (tp->t_line == LDISP) {
450 			vrelease(xp, cp);
451 			bsctxd(vp->line & 017);
452 			return;
453 		}
454 #endif
455 		pvp = vp;
456 		tp->t_state &= ~TS_BUSY;
457 		if (tp->t_state & TS_FLUSH) {
458 			tp->t_state &= ~TS_FLUSH;
459 			wakeup((caddr_t)&tp->t_state);
460 		} else
461 		 	ndflush(&tp->t_outq, vp->bcount+1);
462 	}
463 	vs->vs_xmtcnt--;
464 	vrelease(vs, cp);
465 	if (vs->vs_vers == VXV_NEW) {
466 		vp = pvp;
467 		vs->vs_active |= 1 << ((vp->line & 017) - vs->vs_loport);
468 		if (vxstart(tp) && (cp = nextcmd(vs)) != NULL) {
469 			vs->vs_xmtcnt++;
470 			vcmd(vx, (caddr_t)&cp->cmd);
471 			return;
472 		}
473 		vs->vs_active &= ~(1 << ((vp->line & 017) - vs->vs_loport));
474 	} else {
475 		vs->vs_active = 1;
476 		tp0 = &vx_tty[vx*16 + vs->vs_hiport];
477 		for(tp = &vx_tty[vx*16 + vs->vs_loport]; tp <= tp0; tp++)
478 			if (vxstart(tp) && (cp = nextcmd(vs)) != NULL) {
479 				vs->vs_xmtcnt++;
480 				vcmd(vx, (caddr_t)&cp->cmd);
481 			}
482 		if ((cp = nextcmd(vs)) != NULL) {	/* command to send? */
483 			vs->vs_xmtcnt++;
484 			vcmd(vx, (caddr_t)&cp->cmd);
485 		}
486 		vs->vs_active = 0;
487 	}
488 }
489 
490 /*
491  * Force out partial XMIT command after timeout
492  */
493 vxforce(vs)
494 	register struct vx_softc *vs;
495 {
496 	register struct vxcmd *cp;
497 	int s;
498 
499 	s = spl8();
500 	if ((cp = nextcmd(vs)) != NULL) {
501 		vs->vs_xmtcnt++;
502 		vcmd(vs->vs_nbr, (caddr_t)&cp->cmd);
503 	}
504 	splx(s);
505 }
506 
507 /*
508  * Start (restart) transmission on the given VX line.
509  */
510 vxstart(tp)
511 	register struct tty *tp;
512 {
513 	register short n;
514 	register struct	vx_softc *vs;
515 	register char *outb;
516 	register full = 0;
517 	int k, s, port;
518 
519 	s = spl8();
520 	port = minor(tp->t_dev) & 017;
521 	vs = (struct vx_softc *)tp->t_addr;
522 	if ((tp->t_state&(TS_TIMEOUT|TS_BUSY|TS_TTSTOP)) == 0) {
523 		if (tp->t_outq.c_cc <= TTLOWAT(tp)) {
524 			if (tp->t_state&TS_ASLEEP) {
525 				tp->t_state &= ~TS_ASLEEP;
526 				wakeup((caddr_t)&tp->t_outq);
527 			}
528 			if (tp->t_wsel) {
529 				selwakeup(tp->t_wsel, tp->t_state & TS_WCOLL);
530 				tp->t_wsel = 0;
531 				tp->t_state &= ~TS_WCOLL;
532 			}
533 		}
534 		if (tp->t_outq.c_cc == 0) {
535 			splx(s);
536 			return (0);
537 		}
538 		scope_out(3);
539 		if ((tp->t_flags&(RAW|LITOUT)) == 0)
540 			full = 0200;
541 		if ((n = ndqb(&tp->t_outq, full)) == 0) {
542 			if (full) {
543 				n = getc(&tp->t_outq);
544 				timeout(ttrstrt, (caddr_t)tp, (n&0177)+6);
545 				tp->t_state |= TS_TIMEOUT;
546 				full = 0;
547 			}
548 		} else {
549 			outb = (char *)tp->t_outq.c_cf;
550 			tp->t_state |= TS_BUSY;
551 			if (vs->vs_vers == VXV_NEW)
552 				k = vs->vs_active & (1 << (port-vs->vs_loport));
553 			else
554 				k = vs->vs_active;
555 			full = vsetq(vs, port, outb, n);
556 			if ((k&1) == 0) {	/* not called from vxxint */
557 				if (full || vs->vs_xmtcnt == 0) {
558 					outb = (char *)(&nextcmd(vs)->cmd);
559 					vs->vs_xmtcnt++;
560 					vcmd(vs->vs_nbr, outb);
561 				} else
562 					timeout(vxforce, (caddr_t)vs, 3);
563 			}
564 		}
565 	}
566 	splx(s);
567 	return (full);	/* indicate if max commands or not */
568 }
569 
570 /*
571  * Stop output on a line.
572  */
573 vxstop(tp)
574 	register struct tty *tp;
575 {
576 	int s;
577 
578 	s = spl8();
579 	if (tp->t_state&TS_BUSY)
580 		if ((tp->t_state&TS_TTSTOP) == 0)
581 			tp->t_state |= TS_FLUSH;
582 	splx(s);
583 }
584 
585 static	int vxbbno = -1;
586 /*
587  * VIOCX Initialization.  Makes free lists of command buffers.
588  * Resets all viocx's.  Issues a LIDENT command to each
589  * viocx which establishes interrupt vectors and logical
590  * port numbers
591  */
592 vxinit(vx, wait)
593 	register int vx;
594 	int wait;
595 {
596 	register struct	vx_softc *vs;
597 	register struct	vxdevice *addr;
598 	register struct	vxcmd *cp;
599 	register char *resp;
600 	register int j;
601 	char type;
602 
603 	vs = &vx_softc[vx];
604 	vs->vs_type = 0;		/* viox-x by default */
605 	addr = (struct vxdevice *)(((struct vba_device *)vxinfo[vx])->ui_addr);
606 	type = addr->v_ident;
607 	vs->vs_vers = (type&VXT_NEW) ? VXV_NEW : VXV_OLD;
608 	if (vs->vs_vers == VXV_NEW)
609 		vs->vs_silosiz = addr->v_maxsilo;
610 	switch (type) {
611 
612 	case VXT_VIOCX:
613 	case VXT_VIOCX|VXT_NEW:
614 		/* set dcd for printer ports */
615 		for (j = 0;j < 16;j++)
616 			if (addr->v_portyp[j] == 4)
617 				addr->v_dcd |= 1 << j;
618 		break;
619 
620 	case VXT_PVIOCX:
621 	case VXT_PVIOCX|VXT_NEW:
622 		break;
623 #if NVBSC > 0
624 	case VX_VIOCB:			/* old f/w bisync */
625 	case VX_VIOCB|VXT_NEW: {	/* new f/w bisync */
626 		register struct	bsc *bp;
627 		extern struct bsc bsc[];
628 
629 		printf("%X: %x%x %s VIOC-B, ", (long)addr, (int)addr->v_ident,
630 		    (int)addr->v_fault, vs->vs_vers == VXV_OLD ? "old" : "16k");
631 		for (bp = &bsc[0]; bp <= &bsc[NBSC]; bp++)
632 			bp->b_devregs = (caddr_t)vs;
633 		printf("%d BSC Ports initialized.\n", NBSC);
634 		break;
635 		if (vs->vs_vers == VXV_NEW && CBSIZE > addr->v_maxxmt)
636 			printf("vxinit: Warning CBSIZE > maxxmt\n");
637 		break;
638 #endif
639 	case VXT_VIOCBOP:		/* VIOC-BOP */
640 		vs->vs_type = 1;
641 		vs->vs_bop = ++vxbbno;
642 		printf("VIOC-BOP no. %d at %x\n", vs->vs_bop, addr);
643 
644 	default:		/* unknown viocx type */
645 		printf("vx%d: unknown type %x\n", vx, type);
646 		return;
647 	}
648 	vs->vs_nbr = -1;
649 	vs->vs_maxcmd = vs->vs_vers == VXV_NEW ? 24 : 4;
650 	/* init all cmd buffers */
651 	for (j = 0; j < NVCXBUFS; j++) {
652 		cp = &vs->vs_lst[j];	/* index a buffer */
653 		cp->c_fwd = &vs->vs_lst[j+1];	/* point to next buf */
654 	}
655 	vs->vs_avail = &vs->vs_lst[0];	/* set idx to 1st free buf */
656 	cp->c_fwd = (struct vxcmd *)0;	/* mark last buf in free list */
657 
658 	cp = vobtain(vs);		/* grab the control block */
659 	cp->cmd = VXC_LIDENT;		/* set command type */
660 	cp->par[0] = vs->vs_ivec; 	/* ack vector */
661 	cp->par[1] = cp->par[0]+1;	/* cmd resp vector */
662 	cp->par[3] = cp->par[0]+2;	/* unsol intr vector */
663 	cp->par[4] = 15;		/* max ports, no longer used */
664 	cp->par[5] = 0;			/* set 1st port number */
665 	vcmd(vx, (caddr_t)&cp->cmd);	/* initialize the VIOC-X */
666 	if (!wait)
667 		return;
668 	for (j = 0; cp->cmd == VXC_LIDENT && j < 4000000; j++)
669 		;
670 	if (j >= 4000000)
671 		printf("vx%d: didn't respond to LIDENT\n", vx);
672 
673  	/* calculate address of response buffer */
674  	resp = (char *)addr + (addr->v_rspoff&0x3fff);
675 	if (resp[0] != 0 && (resp[0]&0177) != 3) {	/* did init work? */
676 		vrelease(vs, cp);
677 		return;
678 	}
679 	vs->vs_loport = cp->par[5];
680 	vs->vs_hiport = cp->par[7];
681 	vrelease(vs, cp);
682 	vs->vs_nbr = vx;		/* assign VIOC-X board number */
683 }
684 
685 /*
686  * Obtain a command buffer
687  */
688 struct vxcmd *
689 vobtain(vs)
690 	register struct	vx_softc *vs;
691 {
692 	register struct	vxcmd *p;
693 	int s;
694 
695 	s = spl8();
696 	p = vs->vs_avail;
697 	if (p == (struct vxcmd *)0) {
698 #ifdef VX_DEBUG
699 		if (vxintr4&VXNOBUF)
700 			vxintr4 &= ~VXNOBUF;
701 #endif
702 		printf("vx%d: no buffers\n", vs - vx_softc);
703 		vxstreset(vs - vx_softc);
704 		splx(s);
705 		return (vobtain(vs));
706 	}
707 	vs->vs_avail = vs->vs_avail->c_fwd;
708 	splx(s);
709 	return ((struct vxcmd *)p);
710 }
711 
712 /*
713  * Release a command buffer
714  */
715 vrelease(vs, cp)
716 	register struct	vx_softc *vs;
717 	register struct	vxcmd *cp;
718 {
719 	int s;
720 
721 #ifdef VX_DEBUG
722 	if (vxintr4&VXNOBUF)
723 		return;
724 #endif
725 	s = spl8();
726 	cp->c_fwd = vs->vs_avail;
727 	vs->vs_avail = cp;
728 	splx(s);
729 }
730 
731 /*
732  * vxcmd -
733  *
734  */
735 struct vxcmd *
736 nextcmd(vs)
737 	register struct	vx_softc *vs;
738 {
739 	register struct	vxcmd *cp;
740 	int s;
741 
742 	s = spl8();
743 	cp = vs->vs_build;
744 	vs->vs_build = (struct vxcmd *)0;
745 	splx(s);
746 	return (cp);
747 }
748 
749 /*
750  * assemble transmits into a multiple command.
751  * up to 8 transmits to 8 lines can be assembled together
752  */
753 vsetq(vs ,d ,addr, n)
754 	register struct	vx_softc *vs;
755 	caddr_t	addr;
756 {
757 	register struct	vxcmd *cp;
758 	register struct	vxmit *mp;
759 	register char *p;
760 	register i;
761 
762 	cp = vs->vs_build;
763 	if (cp == (struct vxcmd *)0) {
764 		cp = vobtain(vs);
765 		vs->vs_build = cp;
766 		cp->cmd = VXC_XMITDTA;
767 	} else {
768 		if ((cp->cmd & 07) == 07) {
769 			printf("vx%d: setq overflow\n", vs-vx_softc);
770 			vxstreset(vs->vs_nbr);
771 			return (0);
772 		}
773 		cp->cmd++;
774 	}
775 	mp = (struct vxmit *)(cp->par + (cp->cmd & 07)*sizeof (struct vxmit));
776 	mp->bcount = n-1;
777 	mp->line = d;
778 	if (vs->vs_vers == VXV_NEW && n <= 6) {
779 		cp->cmd = VXC_XMITIMM;
780 		p = addr;
781 		/* bcopy(addr, &(char *)mp->ostream, n) ; */
782 	} else {
783 		addr = (caddr_t)vtoph((struct proc *)0, (unsigned)addr);
784 				/* should be a sys address */
785 		p = (char *)&addr;
786 		n = sizeof addr;
787 		/* mp->ostream = addr ; */
788 	}
789 	for (i = 0; i < n; i++)
790 		mp->ostream[i] = *p++;
791 	if (vs->vs_vers == VXV_NEW)
792 	return (vs->vs_vers == VXV_NEW ? 1 : (cp->cmd&07) == 7);
793 }
794 
795 /*
796  * Write a command out to the VIOC
797  */
798 vcmd(vx, cmdad)
799 	register int vx;
800 	register caddr_t cmdad;
801 {
802 	register struct	vcmds *cp;
803 	register struct vx_softc *vs;
804 	int s;
805 
806 	s = spl8();
807 	vs = &vx_softc[vx];
808 	if (vs->vs_state == VXS_RESET && cmdad != NULL) {
809 		/*
810 		 * When the vioc is resetting, don't process
811 		 * anything other than LIDENT commands.
812 		 */
813 		register struct vxcmd *cmdp = (struct vxcmd *)
814 			((char *)cmdad - sizeof (cmdp->c_fwd));
815 
816 		if (cmdp->cmd != VXC_LIDENT) {
817 			vrelease(vs, cmdp);
818 			return (0);
819 		}
820 	}
821 	cp = &vs->vs_cmds;
822 	if (cmdad != (caddr_t)0) {
823 		cp->cmdbuf[cp->v_fill] = cmdad;
824 		if (++cp->v_fill >= VC_CMDBUFL)
825 			cp->v_fill = 0;
826 		if (cp->v_fill == cp->v_empty) {
827 			printf("vx%d: cmd q overflow\n", vx);
828 			vxstreset(vx);
829 			splx(s);
830 			return (0);
831 		}
832 		cp->v_cmdsem++;
833 	}
834 	if (cp->v_cmdsem && cp->v_curcnt < vs->vs_maxcmd) {
835 		cp->v_cmdsem--;
836 		cp->v_curcnt++;
837 		vinthandl(vx, ((V_BSY|CMDquals) << 8)|V_INTR);
838 	}
839 	splx(s);
840 	return (1);
841 }
842 
843 /*
844  * VIOC acknowledge interrupt.  The VIOC has received the new
845  * command.  If no errors, the new command becomes one of 16 (max)
846  * current commands being executed.
847  */
848 vackint(vx)
849 	register vx;
850 {
851 	register struct	vxdevice *vp;
852 	register struct	vcmds *cp;
853 	struct vx_softc *vs;
854 	int s;
855 
856 	scope_out(5);
857 	vs = &vx_softc[vx];
858 	if (vs->vs_type) {	/* Its a BOP */
859 #ifdef SNA_DEBUG
860 		extern vbrall();
861 
862 		if (snadebug & SVIOC)
863 			printf("vx%d: vack interrupt from BOP\n", vx);
864 		vbrall(vx); 	/* Int. from BOP, port 0 */
865 #endif
866 		return;
867 	}
868 	s = spl8();
869 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
870 	cp = &vs->vs_cmds;
871 	if (vp->v_vcid & V_ERR) {
872 		register char *resp;
873 		register i;
874 		printf("vx%d INTR ERR type %x v_dcd %x\n", vx,
875 		    vp->v_vcid & 07, vp->v_dcd & 0xff);
876 		/* resp = (char *)vp + (vp->v_rspoff & 0x7FFF); */
877 		resp = (char *)vs->vs_mricmd;
878 		for (i = 0; i < 16; i++)
879 			printf("%x ", resp[i]&0xff);
880 		printf("\n");
881 		splx(s);
882 		vxstreset(vx);
883 		return;
884 	}
885 	if ((vp->v_hdwre&017) == CMDquals) {
886 #ifdef VX_DEBUG
887 		if (vxintr4 & VXERR4) {	/* causes VIOC INTR ERR 4 */
888 			register struct vxcmd *cp1;
889 			register struct vxcmd *cp0 = (struct vxcmd *)
890 				((long)cp->cmdbuf[cp->v_empty] - 4);
891 
892 			if (cp0->cmd == VXC_XMITDTA || cp0->cmd == VXC_XMITIMM) {
893 				cp1 = vobtain(vs);
894 				*cp1 = *cp0;
895 				vxintr4 &= ~VXERR4;
896 				(void) vcmd(vx, &cp1->cmd);
897 			}
898 		}
899 #endif
900 		cp->v_curcmd[vp->v_vcid & VCMDLEN-1] = cp->cmdbuf[cp->v_empty];
901 		if (++cp->v_empty >= VC_CMDBUFL)
902 			cp->v_empty = 0;
903 	}
904 	if (++cp->v_itrempt >= VC_IQLEN)
905 		cp->v_itrempt = 0;
906 	vintempt(vx);
907 	splx(s);
908 	(void) vcmd(vx, (caddr_t)0);	/* queue next cmd, if any */
909 }
910 
911 /*
912  * Command Response interrupt.  The Vioc has completed
913  * a command.  The command may now be returned to
914  * the appropriate device driver.
915  */
916 vcmdrsp(vx)
917 	register vx;
918 {
919 	register struct	vxdevice *vp;
920 	register struct	vcmds *cp;
921 	register caddr_t cmd;
922 	register struct vx_softc *vs;
923 	register char *resp;
924 	register k;
925 	register int s;
926 
927 	scope_out(6);
928 	vs = &vx_softc[vx];
929 	if (vs->vs_type) {	/* Its a BOP */
930 		printf("vx%d: vcmdrsp interrupt\n", vx);
931 		return;
932 	}
933 	s = spl8();
934 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
935 	cp = &vs->vs_cmds;
936 	resp = (char *)vp + (vp->v_rspoff&0x7fff);
937 	if (((k = resp[1])&V_UNBSY) == 0) {
938 		printf("vx%d: cmdresp debug\n", vx);
939 		splx(s);
940 		vxstreset(vx);
941 		return;
942 	}
943 	k &= VCMDLEN-1;
944 	cmd = cp->v_curcmd[k];
945 	cp->v_curcmd[k] = (caddr_t)0;
946 	cp->v_curcnt--;
947 	k = *((short *)&resp[4]);	/* cmd operation code */
948 	if ((k&0xff00) == VXC_LIDENT)	/* want hiport number */
949 		for (k = 0; k < VRESPLEN; k++)
950 			cmd[k] = resp[k+4];
951 	resp[1] = 0;
952 	vxxint(vx, (struct vxcmd *)cmd);
953 	if (vs->vs_state == VXS_READY)
954 		vinthandl(vx, ((V_BSY|RSPquals) << 8)|V_INTR);
955 	splx(s);
956 }
957 
958 /*
959  * Unsolicited interrupt.
960  */
961 vunsol(vx)
962 	register vx;
963 {
964 	register struct	vxdevice *vp;
965 	struct vx_softc *vs;
966 	int s;
967 
968 	scope_out(1);
969 	vs = &vx_softc[vx];
970 	if (vs->vs_type) {	/* Its a BOP */
971 		printf("vx%d: vunsol from BOP\n", vx);
972 		return;
973 	}
974 	s = spl8();
975 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
976 	if (vp->v_uqual&V_UNBSY) {
977 		vxrint(vx);
978 		vinthandl(vx, ((V_BSY|UNSquals) << 8)|V_INTR);
979 #ifdef notdef
980 	} else {
981 		printf("vx%d: unsolicited interrupt error\n", vx);
982 		splx(s);
983 		vxstreset(vx);
984 #endif
985 	}
986 	splx(s);
987 }
988 
989 /*
990  * Enqueue an interrupt
991  */
992 vinthandl(vx, item)
993 	register int vx;
994 	register item;
995 {
996 	register struct vcmds *cp;
997 	int empty;
998 
999 	cp = &vx_softc[vx].vs_cmds;
1000 	empty = cp->v_itrfill == cp->v_itrempt;
1001 	cp->v_itrqueu[cp->v_itrfill] = item;
1002 	if (++cp->v_itrfill >= VC_IQLEN)
1003 		cp->v_itrfill = 0;
1004 	if (cp->v_itrfill == cp->v_itrempt) {
1005 		printf("vx%d: interrupt q overflow\n", vx);
1006 		vxstreset(vx);
1007 	} else if (empty)
1008 		vintempt(vx);
1009 }
1010 
1011 vintempt(vx)
1012 	register int vx;
1013 {
1014 	register struct vcmds *cp;
1015 	register struct vxdevice *vp;
1016 	register short item;
1017 	register short *intr;
1018 
1019 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
1020 	if (vp->v_vioc&V_BSY)
1021 		return;
1022 	cp = &vx_softc[vx].vs_cmds;
1023 	if (cp->v_itrempt == cp->v_itrfill)
1024 		return;
1025 	item = cp->v_itrqueu[cp->v_itrempt];
1026 	intr = (short *)&vp->v_vioc;
1027 	switch ((item >> 8)&03) {
1028 
1029 	case CMDquals: {		/* command */
1030 		int phys;
1031 
1032 		if (cp->v_empty == cp->v_fill || vp->v_vcbsy&V_BSY)
1033 			break;
1034 		vx_softc[vx].vs_mricmd = (caddr_t)cp->cmdbuf[cp->v_empty];
1035 		phys = vtoph((struct proc *)0,
1036 		    (unsigned)cp->cmdbuf[cp->v_empty]);
1037 		vp->v_vcp[0] = ((short *)&phys)[0];
1038 		vp->v_vcp[1] = ((short *)&phys)[1];
1039 		vp->v_vcbsy = V_BSY;
1040 		*intr = item;
1041 		scope_out(4);
1042 		break;
1043 	}
1044 
1045 	case RSPquals:		/* command response */
1046 		*intr = item;
1047 		scope_out(7);
1048 		break;
1049 
1050 	case UNSquals:		/* unsolicited interrupt */
1051 		vp->v_uqual = 0;
1052 		*intr = item;
1053 		scope_out(2);
1054 		break;
1055 	}
1056 }
1057 
1058 /*
1059  * Start a reset on a vioc after error (hopefully)
1060  */
1061 vxstreset(vx)
1062 	register vx;
1063 {
1064 	register struct vx_softc *vs;
1065 	register struct	vxdevice *vp;
1066 	register struct vxcmd *cp;
1067 	register int j;
1068 	extern int vxinreset();
1069 	int s;
1070 
1071 	s = spl8() ;
1072 	vs = &vx_softc[vx];
1073 	if (vs->vs_state == VXS_RESET) {	/* avoid recursion */
1074 		splx(s);
1075 		return;
1076 	}
1077 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
1078 	/*
1079 	 * Zero out the vioc structures, mark the vioc as being
1080 	 * reset, reinitialize the free command list, reset the vioc
1081 	 * and start a timer to check on the progress of the reset.
1082 	 */
1083 	bzero((caddr_t)vs, (unsigned)sizeof (*vs));
1084 
1085 	/*
1086 	 * Setting VXS_RESET prevents others from issuing
1087 	 * commands while allowing currently queued commands to
1088 	 * be passed to the VIOC.
1089 	 */
1090 	vs->vs_state = VXS_RESET;
1091 	/* init all cmd buffers */
1092 	for (j = 0; j < NVCXBUFS; j++) {
1093 		cp = &vs->vs_lst[j];	/* index a buffer */
1094 		cp->c_fwd = &vs->vs_lst[j+1];	/* point to next buf */
1095 	}
1096 	vs->vs_avail = &vs->vs_lst[0];	/* set idx to 1st free buf */
1097 	cp->c_fwd = (struct vxcmd *)0;	/* mark last buf in free list */
1098 	printf("vx%d: reset...", vx);
1099 	vp->v_fault = 0;
1100 	vp->v_vioc = V_BSY;
1101 	vp->v_hdwre = V_RESET;		/* reset interrupt */
1102 	timeout(vxinreset, (caddr_t)vx, hz*5);
1103 	splx(s);
1104 }
1105 
1106 /* continue processing a reset on a vioc after an error (hopefully) */
1107 vxinreset(vx)
1108 	int vx;
1109 {
1110 	register struct	vxdevice *vp;
1111 	int s = spl8();
1112 
1113 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
1114 	/*
1115 	 * See if the vioc has reset.
1116 	 */
1117 	if (vp->v_fault != VXF_READY) {
1118 		printf("failed\n");
1119 		splx(s);
1120 		return;
1121 	}
1122 	/*
1123 	 * Send a LIDENT to the vioc and mess with carrier flags
1124 	 * on parallel printer ports.
1125 	 */
1126 	vxinit(vx, (long)0);
1127 	splx(s);
1128 }
1129 
1130 /*
1131  * Restore modem control, parameters and restart output.
1132  * Since the vioc can handle no more then 24 commands at a time
1133  * and we could generate as many as 48 commands, we must do this in
1134  * phases, issuing no more then 16 commands at a time.
1135  */
1136 /* finish the reset on the vioc after an error (hopefully) */
1137 vxfnreset(vx, cp)
1138 	register int vx;
1139 	register struct vxcmd *cp;
1140 {
1141 	register struct vx_softc *vs;
1142 	register struct	vxdevice *vp ;
1143 	register struct tty *tp, *tp0;
1144 	register int i;
1145 #ifdef notdef
1146 	register int on;
1147 #endif
1148 	extern int vxrestart();
1149 	int s = spl8();
1150 
1151 	vs = &vx_softc[vx];
1152 	vs->vs_loport = cp->par[5];
1153 	vs->vs_hiport = cp->par[7];
1154 	vrelease(vs, cp);
1155 	vs->vs_nbr = vx;			/* assign VIOC-X board number */
1156 	vs->vs_state = VXS_READY;
1157 
1158 	vp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
1159 	vp->v_vcid = 0;
1160 
1161 	/*
1162 	 * Restore modem information and control.
1163 	 */
1164 	tp0 = &vx_tty[vx*16];
1165 	for (i = vs->vs_loport; i <= vs->vs_hiport; i++) {
1166 		tp = tp0 + i;
1167 		if (tp->t_state&(TS_ISOPEN|TS_WOPEN)) {
1168 			tp->t_state &= ~TS_CARR_ON;
1169 			vcmodem(tp->t_dev, VMOD_ON);
1170 			if (tp->t_state&TS_CARR_ON)
1171 				wakeup((caddr_t)&tp->t_canq);
1172 			else if (tp->t_state & TS_ISOPEN) {
1173 				ttyflush(tp, FREAD|FWRITE);
1174 				if (tp->t_state&TS_FLUSH)
1175 					wakeup((caddr_t)&tp->t_state);
1176 				if ((tp->t_flags&NOHANG) == 0) {
1177 					gsignal(tp->t_pgrp, SIGHUP);
1178 					gsignal(tp->t_pgrp, SIGCONT);
1179 				}
1180 			}
1181 		}
1182 		/*
1183 		 * If carrier has changed while we were resetting,
1184 		 * take appropriate action.
1185 		 */
1186 #ifdef notdef
1187 		on = vp->v_dcd & 1<<i;
1188 		if (on && (tp->t_state&TS_CARR_ON) == 0) {
1189 			tp->t_state |= TS_CARR_ON;
1190 			wakeup((caddr_t)&tp->t_canq);
1191 		} else if (!on && tp->t_state&TS_CARR_ON) {
1192 			tp->t_state &= ~TS_CARR_ON;
1193 			if (tp->t_state & TS_ISOPEN) {
1194 				ttyflush(tp, FREAD|FWRITE);
1195 				if (tp->t_state&TS_FLUSH)
1196 					wakeup((caddr_t)&tp->t_state);
1197 				if ((tp->t_flags&NOHANG) == 0) {
1198 					gsignal(tp->t_pgrp, SIGHUP);
1199 					gsignal(tp->t_pgrp, SIGCONT);
1200 				}
1201 			}
1202 		}
1203 #endif
1204 	}
1205 	vs->vs_state = VXS_RESET;
1206 	timeout(vxrestart, (caddr_t)vx, hz);
1207 	splx(s);
1208 }
1209 
1210 /*
1211  * Restore a particular aspect of the VIOC.
1212  */
1213 vxrestart(vx)
1214 	int vx;
1215 {
1216 	register struct tty *tp, *tp0;
1217 	register struct vx_softc *vs;
1218 	register int i, cnt;
1219 	int s = spl8();
1220 
1221 	cnt = vx >> 8;
1222 	vx &= 0xff;
1223 	vs = &vx_softc[vx];
1224 	vs->vs_state = VXS_READY;
1225 	tp0 = &vx_tty[vx*16];
1226 	for (i = vs->vs_loport; i <= vs->vs_hiport; i++) {
1227 		tp = tp0 + i;
1228 		if (cnt != 0) {
1229 			tp->t_state &= ~(TS_BUSY|TS_TIMEOUT);
1230 			if (tp->t_state&(TS_ISOPEN|TS_WOPEN))
1231 				vxstart(tp);	/* restart pending output */
1232 		} else {
1233 			if (tp->t_state&(TS_WOPEN|TS_ISOPEN))
1234 				vxcparam(tp->t_dev, 0);
1235 		}
1236 	}
1237 	if (cnt == 0) {
1238 		vs->vs_state = VXS_RESET;
1239 		timeout(vxrestart, (caddr_t)(vx + 1*256), hz);
1240 	} else
1241 		printf("done\n");
1242 	splx(s);
1243 }
1244 
1245 vxreset(dev)
1246 	dev_t dev;
1247 {
1248 
1249 	vxstreset(minor(dev) >> 4);	/* completes asynchronously */
1250 }
1251 
1252 vxfreset(vx)
1253 	register int vx;
1254 {
1255 	struct vba_device *vi;
1256 
1257 	if ((unsigned)vx > NVX || (vi = vxinfo[vx]) == 0 || vi->ui_addr == 0)
1258 		return (ENODEV);
1259 	vx_softc[vx].vs_state = VXS_READY;
1260 	vxstreset(vx);
1261 	return (0);		/* completes asynchronously */
1262 }
1263 
1264 vcmodem(dev, flag)
1265 	dev_t dev;
1266 {
1267 	struct tty *tp;
1268 	register struct vxcmd *cp;
1269 	register struct vx_softc *vs;
1270 	register struct vxdevice *kp;
1271 	register port;
1272 	int unit;
1273 
1274 	unit = minor(dev);
1275 	tp = &vx_tty[unit];
1276 	vs = (struct vx_softc *)tp->t_addr;
1277 	cp = vobtain(vs);
1278 	kp = (struct vxdevice *)((struct vba_device *)vxinfo[vs->vs_nbr])->ui_addr;
1279 
1280 	port = unit & 017;
1281 	/*
1282 	 * Issue MODEM command
1283 	 */
1284 	cp->cmd = VXC_MDMCTL;
1285 	cp->par[0] = (flag == VMOD_ON) ? V_ENAB : V_DISAB;
1286 	cp->par[1] = port;
1287 	vcmd(vs->vs_nbr, (caddr_t)&cp->cmd);
1288 	port -= vs->vs_loport;
1289 	if ((kp->v_dcd >> port) & 1) {
1290 		if (flag == VMOD_ON)
1291 			tp->t_state |= TS_CARR_ON;
1292 		return (1);
1293 	}
1294 	return (0);
1295 }
1296 
1297 /*
1298  * VCMINTR called when an unsolicited interrup occurs signaling
1299  * some change of modem control state.
1300  */
1301 vcmintr(vx)
1302 	register vx;
1303 {
1304 	register struct vxdevice *kp;
1305 	register struct tty *tp;
1306 	register port;
1307 
1308 	kp = (struct vxdevice *)((struct vba_device *)vxinfo[vx])->ui_addr;
1309 	port = kp->v_usdata[0] & 017;
1310 	tp = &vx_tty[vx*16+port];
1311 #if NVBSC > 0
1312 	/*
1313 	 * Check for change in DSR for BISYNC port.
1314 	 */
1315 	if (bscport[vx*16+port]&BISYNC) {
1316 		if (kp->v_ustat&DSR_CHG) {
1317 			register struct	vx_softc *xp;
1318 			register struct bsc *bp;
1319 			extern struct bsc bsc[];
1320 
1321 			vs = (struct vx_softc *)tp->t_addr;
1322 			bp = &bsc[minor(tp->t_dev)] ;
1323 			bp->b_hlflgs &= ~BSC_DSR ;
1324 			if (kp->v_ustat & DSR_ON)
1325 				bp->b_hlflgs |= BSC_DSR ;
1326 			printf("BSC DSR Chg: %x\n", kp->v_ustat&DSR_CHG);/*XXX*/
1327 		}
1328 		return;
1329 	}
1330 #endif
1331 	if ((kp->v_ustat&DCD_ON) && ((tp->t_state&TS_CARR_ON) == 0)) {
1332 		tp->t_state |= TS_CARR_ON;
1333 		wakeup((caddr_t)&tp->t_canq);
1334 		return;
1335 	}
1336 	if ((kp->v_ustat&DCD_OFF) && (tp->t_state&TS_CARR_ON)) {
1337 		tp->t_state &= ~TS_CARR_ON;
1338 		if (tp->t_state&TS_ISOPEN) {
1339 			register struct vx_softc *vs;
1340 			register struct vcmds *cp;
1341 			register struct vxcmd *cmdp;
1342 
1343 			ttyflush(tp, FREAD|FWRITE);
1344 			/* clear all pending trnansmits */
1345 			vs = &vx_softc[vx];
1346 			if (tp->t_state&(TS_BUSY|TS_FLUSH) &&
1347 			    vs->vs_vers == VXV_NEW) {
1348 				int i, cmdfound = 0;
1349 
1350 				cp = &vs->vs_cmds;
1351 				for (i = cp->v_empty; i != cp->v_fill; ) {
1352 					cmdp = (struct vxcmd *)((long *)cp->cmdbuf[i]-1);
1353 					if ((cmdp->cmd == VXC_XMITDTA ||
1354 					    cmdp->cmd == VXC_XMITIMM) &&
1355 					    ((struct vxmit *)cmdp->par)->line == port) {
1356 						cmdfound++;
1357 						cmdp->cmd = VXC_FDTATOX;
1358 						cmdp->par[1] = port;
1359 					}
1360 					if (++i >= VC_CMDBUFL)
1361 						i = 0;
1362 				}
1363 				if (cmdfound)
1364 					tp->t_state &= ~(TS_BUSY|TS_FLUSH);
1365 				/* cmd is already in vioc, have to flush it */
1366 				else {
1367 					cmdp = vobtain(vs);
1368 					cmdp->cmd = VXC_FDTATOX;
1369 					cmdp->par[1] = port;
1370 					vcmd(vx, (caddr_t)&cmdp->cmd);
1371 				}
1372 			}
1373 			if ((tp->t_flags&NOHANG) == 0) {
1374 				gsignal(tp->t_pgrp, SIGHUP);
1375 				gsignal(tp->t_pgrp, SIGCONT);
1376 			}
1377 		}
1378 		return;
1379 	}
1380 	if ((kp->v_ustat&BRK_CHR) && (tp->t_state&TS_ISOPEN)) {
1381 		(*linesw[tp->t_line].l_rint)(tp->t_intrc & 0377, tp);
1382 		return;
1383 	}
1384 }
1385 #endif
1386