xref: /csrg-svn/sys/tahoe/vba/vx.c (revision 25857)
1 /*	vx.c	1.3	86/01/12	*/
2 
3 #include "vx.h"
4 #if NVX > 0
5 /*
6  * VIOC-X driver
7  */
8 #include "../tahoe/pte.h"
9 
10 #include "../h/param.h"
11 #include "../h/ioctl.h"
12 #include "../h/tty.h"
13 #include "../h/dir.h"
14 #include "../h/user.h"
15 #include "../h/map.h"
16 #include "../h/buf.h"
17 #include "../h/conf.h"
18 #include "../h/file.h"
19 #include "../h/uio.h"
20 #include "../h/proc.h"
21 #include "../h/vm.h"
22 
23 #include "../tahoevba/vbavar.h"
24 #include "../tahoevba/vioc.h"
25 #ifdef VXPERF
26 #include "../tahoevba/scope.h"
27 #endif VXPERF
28 #include "vbsc.h"
29 #if NVBSC > 0
30 #include "../bsc/bscio.h"
31 #include "../bsc/bsc.h"
32 char bscport[NVXPORTS];
33 #endif
34 
35 #ifdef BSC_DEBUG
36 #include "../bsc/bscdebug.h"
37 #endif
38 
39 #ifdef	VX_DEBUG
40 long vxintr4 = 0;
41 long vxdebug = 0;
42 #include "../vba/vxdebug.h"
43 #endif
44 
45 #define RSPquals	1
46 
47 struct	vcx vcx[NVIOCX] ;
48 struct	tty vx_tty[NVXPORTS];
49 extern	struct vcmds v_cmds[];
50 extern	long reinit;
51 
52 int	vxstart() ;
53 int	ttrstrt() ;
54 struct	vxcmd *vobtain() ;
55 struct	vxcmd *nextcmd() ;
56 
57 /*
58  * Driver information for auto-configuration stuff.
59  * (not tested and probably should be changed)
60  */
61 int	vxprobe(), vxattach(), vxrint();
62 struct	vba_device *vxinfo[NVIOCX];
63 long	vxstd[] = { 0 };
64 struct	vba_driver vxdriver =
65     { vxprobe, 0, vxattach, 0, vxstd, "vx", vxinfo };
66 
67 char	vxtype[NVIOCX];	/* 0: viox-x/vioc-b; 1: vioc-bop */
68 char	vxbbno = -1;
69 char	vxbopno[NVIOCX];	/* BOP board no. if indicated by vxtype[] */
70 int	vxivec[NVIOCX];		/* interrupt vector base */
71 extern	vbrall();
72 
73 vxprobe(reg, vi)
74 	caddr_t reg;
75 	struct vba_device *vi;
76 {
77 	register int br, cvec;			/* must be r12, r11 */
78 	register struct vblok *vp = (struct vblok *)reg;
79 
80 #ifdef lint
81 	br = 0; cvec = br; br = cvec;
82 	vackint(0); vunsol(0); vcmdrsp(0); vxfreset(0);
83 #endif
84 	if (badaddr((caddr_t)vp, 1))
85 		return (0);
86 	vp->v_fault = 0;
87 	vp->v_vioc = V_BSY;
88 	vp->v_hdwre = V_RESET;		/* reset interrupt */
89 	DELAY(4000000);
90 	if (vp->v_fault != VREADY)
91 		return (0);
92 #ifdef notdef
93 	/*
94 	 * Align vioc interrupt vector base to 4 vector
95 	 * boundary and fitting in 8 bits (is this necessary,
96 	 * wish we had documentation).
97 	 */
98 	if ((vi->ui_hd->vh_lastiv -= 3) > 0xff)
99 		vi->ui_hd->vh_lastiv = 0xff;
100 	vxivec[vi->ui_unit] = vi->ui_hd->vh_lastiv =
101 	    vi->ui_hd->vh_lastiv &~ 0x3;
102 #else
103 	vxivec[vi->ui_unit] = 0x40+vi->ui_unit*4;
104 #endif
105 	br = 0x18, cvec = vxivec[vi->ui_unit];	/* XXX */
106 	return (sizeof (*vp));
107 }
108 
109 vxattach(vi)
110 	register struct vba_device *vi;
111 {
112 
113 	VIOCBAS[vi->ui_unit] = vi->ui_addr;
114 	vxinit(vi->ui_unit, (long)1);
115 }
116 
117 /*
118  * Open a VX line.
119  */
120 /*ARGSUSED*/
121 vxopen(dev, flag)
122 {
123 	register struct tty *tp;	/* pointer to tty struct for port */
124 	register struct vcx *xp;	/* pointer to VIOC-X info/cmd buffer */
125 	register d;			/* minor device number */
126 	register long jj;
127 
128 
129 	d = minor(dev);			/* get minor device number */
130 	if (d >= NVXPORTS)		/* validate minor device number */
131 		return ENXIO;		/* set errno to indicate bad port # */
132 	tp = &vx_tty[d];		/* index the tty structure for port */
133 
134 	xp = &vcx[d>>4];			/* index VIOC-X info/cmd area */
135 	d &= 017;
136 
137 	/* If we did not find a board with the correct port number on
138 	   it, or the entry for the VIOC-X had no ports on it, inform the
139 	   caller that the port does not exist. */
140 	if(!( xp->v_loport <= d && d <= xp->v_hiport )	/* home? */
141 	 || (xp->v_hiport - xp->v_loport)==0)
142 		return ENXIO;	/* bad minor device number */
143 	tp->t_addr = (caddr_t)xp;	/* store address of VIOC-X info */
144 	tp->t_oproc = vxstart;		/* store address of startup routine */
145 	tp->t_dev = dev;		/* store major/minor device numbers */
146 	d = spl8();
147 	tp->t_state |= TS_WOPEN;	/* mark device as waiting for open */
148 	if ((tp->t_state&TS_ISOPEN) == 0)	/* is device already open? */
149 	{				/*  no, open it */
150 		ttychars(tp);		/* set default control chars */
151 		if (tp->t_ispeed == 0)	/* if no default speeds set them */
152 		{
153 			tp->t_ispeed = SSPEED;	/* default input baud */
154 			tp->t_ospeed = SSPEED;	/* default output baud */
155 			tp->t_flags |= (ODDP|EVENP|ECHO); /* default modes */
156 		}
157 		vxparam(dev);		/* set parameters for this port */
158 	}
159 	splx(d);
160 	/* ? if already open for exclusive use open fails unless caller is
161 	     root. */
162 	if (tp->t_state&TS_XCLUDE && u.u_uid!=0)
163 		return EBUSY;	/* device is busy, sorry */
164 
165 	/* wait for data carrier detect to go high */
166 	d = spl8();
167 	if( !vcmodem(dev,VMOD_ON) )
168 		while( (tp->t_state&TS_CARR_ON) == 0 )
169 			sleep((caddr_t)&tp->t_canq,TTIPRI);
170 	jj= (*linesw[tp->t_line].l_open)(dev,tp); /*let tty.c finish the open */
171 	splx(d);	/* 1/2/85 : assures open complete */
172 	return (jj);
173 }
174 
175 /*
176  * Close a VX line.
177  */
178 /*ARGSUSED*/
179 vxclose(dev, flag)
180 dev_t dev;
181 int  flag;
182 {
183 	register struct tty *tp;
184 	register d;
185 
186 	d = minor(dev) & 0377;
187 	tp = &vx_tty[d];
188 	d = spl8();
189 	(*linesw[tp->t_line].l_close)(tp);
190 	if ((tp->t_state&TS_ISOPEN) && (tp->t_state&TS_HUPCLS))
191 		if( !vcmodem(dev,VMOD_OFF) )
192 			tp->t_state &= ~TS_CARR_ON;
193 	/* wait for the last response */
194 	while(tp->t_state & TS_FLUSH)
195 		sleep( (caddr_t)&tp->t_state, TTOPRI ) ;
196 	ttyclose(tp);	/* let tty.c finish the close */
197 	splx(d);
198 }
199 
200 /*
201  * Read from a VX line.
202  */
203 vxread(dev, uio)
204 	dev_t dev;
205 	struct uio *uio;
206 {
207 	register struct tty *tp = &vx_tty[minor(dev) & 0377];
208 	return (*linesw[tp->t_line].l_read)(tp, uio);
209 }
210 
211 /*
212  * write on a VX line
213  */
214 vxwrite(dev, uio)
215 	dev_t dev;
216 	struct uio *uio;
217 {
218 	register struct tty *tp = &vx_tty[minor(dev) & 0377];
219 	return (*linesw[tp->t_line].l_write)(tp, uio);
220 }
221 
222 /*
223  * VIOCX unsolicited interrupt.
224  */
225 vxrint(n)
226 register n;				/* mux number */
227 {
228 	register struct tty *tp;
229 	register struct vcx *xp;
230 	register short *sp;
231 	register struct vblok *kp;
232 	register int i, c;
233 	short *savsilo;
234 	struct silo {
235 		char	data;
236 		char	port;
237 	};
238 
239 	kp = VBAS(n);
240 	xp = &vcx[n];
241 	switch(kp->v_uqual&037) {
242 	case 0:
243 		break;
244 	case 2:
245 		printf(" ERR NBR %x\n",kp->v_ustat);
246 		vpanic("vc: VC PROC ERR");
247 		vxstreset(n);
248 		return(0);
249 	case 3:
250 		vcmintr(n);
251 		return(1);
252 	case 4:
253 		return(1);
254 	default:
255 		printf(" ERR NBR %x\n",kp->v_uqual);
256 		vpanic("vc: VC UQUAL ERR");
257 		vxstreset(n);
258 		return(0);
259 	}
260 	if(xp->v_vers == V_NEW) {
261 		register short *aa ;
262 		aa = (short *)kp->v_usdata;
263 		sp = (short *)(*aa  + (char *)kp) ;
264 	} else {
265 		c = kp->v_usdata[0] << 6;
266 		sp = (short *)((char *)kp + SILOBAS + c);
267 	}
268 	i = *(savsilo = sp);
269 	if (i == 0) return(1);
270 	if(xp->v_vers == V_NEW)
271 		if( i > xp->v_silosiz ) {
272 			printf("vx: %d exceeds silo size\n",i) ;
273 			i = xp->v_silosiz;
274 		}
275 	for(sp++;i > 0;i--,sp++) {
276 		c = ((struct silo *)sp)->port & 017;
277 		tp = &vx_tty[c+n*16];
278 		if(xp->v_loport > c || c > xp->v_hiport)
279 			continue;	/* port out of bounds */
280 		if( (tp->t_state & TS_ISOPEN) == 0) {
281 			wakeup((caddr_t)&tp->t_rawq);
282 			continue;
283 		}
284 		c = ((struct silo *)sp)->data;
285 		switch(((struct silo *)sp)->port&(PERROR|FERROR)) {
286 		case PERROR:
287 		case PERROR|FERROR:
288 			if( (tp->t_flags&(EVENP|ODDP)) == EVENP
289 			|| (tp->t_flags & (EVENP|ODDP)) == ODDP )
290 				continue;
291 			if(!(((struct silo *)sp)->port&FERROR))
292 				break;
293 		case FERROR:
294 			if(tp->t_flags & RAW) c = 0;
295 			else c = tp->t_intrc;
296 		}
297 		(*linesw[tp->t_line].l_rint)(c, tp);
298 	}
299 	*savsilo = 0;
300 	return(1);
301 }
302 
303 /*
304  * stty/gtty for VX
305  */
306 vxioctl(dev, cmd, data, flag)
307 int	dev;			/* major, minor device numbers */
308 int	cmd;			/* command */
309 caddr_t	data;
310 int	flag;
311 {
312 	register struct tty	*tp;
313 	register error;
314 
315 	tp = &vx_tty[minor(dev) & 0377];
316 	error = (*linesw[tp->t_line].l_ioctl)(tp, cmd, data, flag);
317 	if (error == 0)
318 		return error;
319 	if((error = ttioctl(tp, cmd, data, flag)) >= 0)
320 	{
321 		if (cmd==TIOCSETP||cmd==TIOCSETN)
322 			vxparam(dev);
323 		return error;
324 	} else
325 		return ENOTTY;
326 }
327 
328 
329 vxparam(dev)
330 dev_t	dev;
331 {
332 	vxcparam(dev, 1);
333 }
334 
335 /*
336  * Set parameters from open or stty into the VX hardware
337  * registers.
338  */
339 vxcparam(dev, wait)
340 dev_t	dev;			/* major, minor device numbers */
341 int wait;			/* nonzero if we should wait for finish */
342 {
343 	register struct tty	*tp;
344 	register struct vcx	*xp;
345 	register struct vxcmd	*cp;
346 	register s;
347 
348 	tp = &vx_tty[minor(dev)];	/* pointer to tty structure for port */
349 	xp = (struct vcx *)tp->t_addr;	/* pointer to VIOCX info/cmd buffer */
350 	cp = vobtain(xp);
351 	s = spl8();
352 	cp->cmd = LPARAX;		/* set command to "load parameters" */
353 	cp->par[1] = minor(dev)&017;	/* port number */
354 
355 	cp->par[2] = (tp->t_flags&RAW)? 0 : tp->t_startc;	/* XON char */
356 	cp->par[3] = (tp->t_flags&RAW)? 0 : tp->t_stopc;	/* XOFF char */
357 
358 	if(tp->t_flags&(RAW|LITOUT) ||
359 	  (tp->t_flags&(EVENP|ODDP)) == (EVENP|ODDP)) {
360 		cp->par[4] = 0xc0;	/* 8 bits of data */
361 		cp->par[7] = 0;		/* no parity */
362 	} else {
363 		cp->par[4] = 0x40;	/* 7 bits of data */
364 		if((tp->t_flags&(EVENP|ODDP)) == ODDP)
365 			cp->par[7] = 1;		/* odd parity */
366 		else if((tp->t_flags&(EVENP|ODDP)) == EVENP)
367 			cp->par[7] = 3;		/* even parity */
368 		else
369 			cp->par[7] = 0;		/* no parity */
370 	}
371 	cp->par[5] = 0x4;			/* 1 stop bit */
372 	cp->par[6] = tp->t_ospeed;
373 
374 	if (vcmd(xp->v_nbr, (caddr_t)&cp->cmd) && wait)
375 		sleep((caddr_t)cp,TTIPRI);
376 	splx(s);
377 }
378 
379 /*
380  * VIOCX command response interrupt.
381  * For transmission, restart output to any active port.
382  * For all other commands, just clean up.
383  */
384 vxxint(n,cp)
385 register int n;			/* VIOC number */
386 register struct vxcmd	*cp;	/* command structure */
387 {
388 	register struct	vxmit	*vp, *pvp;
389 	register struct	tty	*tp;
390 	register struct	vcx	*xp;
391 	register struct tty	*hp;
392 
393 	xp = &vcx[n];
394 	cp = (struct vxcmd *)( (long *)cp - 1);
395 #if NVBSC > 0
396 	switch(cp->cmd) {
397 	case MDMCTL1: case HUNTMD1: case LPARAX1:
398 		vrelease(xp, cp);
399 		wakeup(cp);
400 		return;
401 	}
402 #endif
403 	switch(cp->cmd&0xff00) {
404 	case LIDENT:	/* initialization complete */
405 		if (xp->v_state & V_RESETTING) {
406 			vxfnreset(n,cp);
407 			vinthandl(n,((V_BSY | RSPquals) << 8) | V_INTR);
408 		}
409 		cp->cmd++;
410 		return;
411 	case XMITDTA: case XMITIMM:
412 		break;
413 	case LPARAX:
414 		wakeup((caddr_t)cp);
415 	default:	/* MDMCTL or FDTATOX */
416 		vrelease(xp, cp);
417 		if (xp->v_state & V_RESETTING) {
418 			vinthandl(n,((V_BSY | RSPquals) << 8) | V_INTR);
419 		}
420 		return;
421 	}
422 	for(vp = (struct vxmit *)(cp->par + (cp->cmd & 07)*sizvxmit);
423 	    vp >= (struct vxmit *)cp->par;
424 	    vp = (struct vxmit *) ((char *)vp - sizvxmit) )
425 	{
426 		tp = &vx_tty[(vp->line & 017)+n*16];
427 /* cjk buffer bug */
428 #if NVBSC > 0
429 					/* bsc change */
430 		if (tp->t_line == LDISP) {
431 			vrelease(xp, cp);
432 			bsctxd((vp->line & 017));
433 			return ;
434 		}
435 					/* End of bsc change */
436 #endif
437 /* cjk */
438 		pvp = vp;
439 		tp->t_state &= ~TS_BUSY;
440 		if(tp->t_state & TS_FLUSH) {
441 			tp->t_state &= ~TS_FLUSH;
442 			wakeup( (caddr_t)&tp->t_state ) ;
443 		}
444 		else
445 		 	ndflush(&tp->t_outq, vp->bcount+1);
446 	}
447 	xp->v_xmtcnt--;
448 	vrelease(xp,cp);
449 	if(xp->v_vers == V_NEW) {
450 		vp = pvp;
451 		xp->v_actport[(vp->line & 017) - xp->v_loport] |= 1 ;
452 		if(vxstart(tp) && (cp = nextcmd(xp)) != NULL)
453 		{
454 			xp->v_xmtcnt++;
455 			vcmd(n, (caddr_t)&cp->cmd);
456 			return ;
457 		}
458 		xp->v_actport[(vp->line & 017) - xp->v_loport] = 0 ;
459 		return ;
460 	}
461 	xp->v_actflg = 1;
462 	hp = &vx_tty[xp->v_hiport+n*16];
463 	for(tp = &vx_tty[xp->v_loport+n*16];tp <= hp;tp++)
464 		if(vxstart(tp) && (cp = nextcmd(xp)) != NULL)
465 		{
466 			xp->v_xmtcnt++;
467 			vcmd(n, (caddr_t)&cp->cmd);
468 		}
469 	if( (cp = nextcmd(xp)) != NULL )		/* command to send ? */
470 	{
471 		xp->v_xmtcnt++;
472 		vcmd(n, (caddr_t)&cp->cmd);
473 	}
474 	xp->v_actflg = 0;
475 }
476 
477 /*
478  * Force out partial XMIT command after timeout
479  */
480 vxforce(xp)
481 register struct vcx	*xp;
482 {
483 	register struct vxcmd	*cp;
484 	register int s;
485 
486 	s = spl8();
487 	if((cp = nextcmd(xp)) != NULL) {
488 		xp->v_xmtcnt++;
489 		vcmd(xp->v_nbr, (caddr_t)&cp->cmd);
490 	}
491 	splx(s);
492 }
493 
494 /*
495  * Start (restart) transmission on the given VX line.
496  */
497 vxstart(tp)
498 register struct tty *tp;
499 {
500 	register short n;
501 	register struct	vcx	*xp;
502 	register char *outb;
503 	register full = 0;
504 	int k, s, port;
505 
506 	s = spl8();
507 	port = minor(tp->t_dev) & 017;
508 	xp = (struct vcx *)tp->t_addr;
509 	if (!(tp->t_state&(TS_TIMEOUT|TS_BUSY|TS_TTSTOP))) {
510 		if (tp->t_outq.c_cc<=TTLOWAT(tp)) {
511 			if (tp->t_state&TS_ASLEEP) {
512 				tp->t_state &= ~TS_ASLEEP;
513 				wakeup((caddr_t)&tp->t_outq);
514 			}
515 			if (tp->t_wsel) {
516 				selwakeup(tp->t_wsel, tp->t_state & TS_WCOLL);
517 				tp->t_wsel = 0;
518 				tp->t_state &= ~TS_WCOLL;
519 			}
520 		}
521 		if(tp->t_outq.c_cc == 0) {
522 			splx(s);
523 			return(0);
524 		}
525 #ifdef VXPERF
526 	scope_out(3);
527 #endif VXPERF
528 		if(!(tp->t_flags&(RAW|LITOUT)))
529 			full = 0200;
530 		if((n = ndqb(&tp->t_outq, full)) == 0)   {
531 			if(full) {
532 				n = getc(&tp->t_outq);
533 				timeout(ttrstrt, (caddr_t)tp, (n&0177) +6);
534 				tp->t_state |= TS_TIMEOUT;
535 				full = 0;
536 			}
537 		} else {
538 			outb = (char *)tp->t_outq.c_cf;
539 			tp->t_state |= TS_BUSY;
540 			if(xp->v_vers == V_NEW)
541 				k = xp->v_actport[port - xp->v_loport] ;
542 			else
543 				k = xp->v_actflg ;
544 
545 			full = vsetq(xp, port, outb, n);
546 
547 			if( (k&1) == 0 ) {	/* not called from vxxint */
548 				if(full || xp->v_xmtcnt == 0) {
549 					outb = (char *)(&nextcmd(xp)->cmd);
550 					xp->v_xmtcnt++;
551 					vcmd(xp->v_nbr, outb );
552 				} else
553 					timeout(vxforce,(caddr_t)xp,3);
554 			}
555 		}
556 	}
557 	splx(s);
558 	return(full);	/* indicate if max commands or not */
559 }
560 
561 /*
562  * Stop output on a line.
563  */
564 vxstop(tp)
565 register struct tty *tp;
566 {
567 	register  s;
568 
569 	s = spl8();
570 	if (tp->t_state & TS_BUSY) {
571 		if ((tp->t_state&TS_TTSTOP)==0) {
572 			tp->t_state |= TS_FLUSH;
573 		}
574 	}
575 	splx(s);
576 }
577 
578 /*
579  * VIOCX Initialization.  Makes free lists of command buffers.
580  * Resets all viocx's.  Issues a LIDENT command to each
581  * viocx which establishes interrupt vectors and logical
582  * port numbers
583  */
584 vxinit(i,wait)
585 register int	i;
586 long wait;
587 {
588 	register struct	vcx	*xp;	/* ptr to VIOC-X info/cmd buffer */
589 	register struct	vblok	*kp;	/* pointer to VIOC-X control block */
590 	register struct	vxcmd	*cp;	/* pointer to a command buffer */
591 	register char	*resp;		/* pointer to response buffer */
592 	register int	j;
593 	char type;
594 #if NVBSC > 0
595 	register struct	bsc	*bp;	/* bsc change */
596 	extern	 struct	bsc	bsc[];
597 #endif
598 
599 
600 	kp = VBAS(i);		/* get base adr of cntl blok for VIOC */
601 
602 	xp = &vcx[i];		/* index info/command buffers */
603 	type = kp->v_ident;
604 	vxtype[i] =  0;		/* Type is Viox-x */
605 	switch(type) {
606 	case VIOCX:
607 		{
608 		xp->v_vers = V_OLD ;
609 		/* set DCD for printer ports */
610 		for(j = 0;j < 16;j++)
611 			if (kp->v_portyp[j] == 4 )
612 				kp->v_dcd |= 1 << j ;
613 		}
614 		break ;
615 	case NWVIOCX:
616 		{
617 		xp->v_vers = V_NEW ;
618 		xp->v_silosiz = kp->v_maxsilo ;
619 		/* set DCD for printer ports */
620 		for(j = 0;j < 16;j++)
621 			if (kp->v_portyp[j] == 4 )
622 				kp->v_dcd |= 1 << j ;
623 		}
624 		break ;
625 	case PVIOCX:
626 		xp->v_vers = V_OLD ;
627 		break ;
628 	case NPVIOCX:
629 		xp->v_vers = V_NEW ;
630 		xp->v_silosiz = kp->v_maxsilo ;
631 		break ;
632 #if NVBSC > 0
633 	case VIOCB:	/* old f/w, Bisync board */
634 		printf("%X: %x%x OLD VIOC-B, ",
635 					(long)kp, (int)kp->v_ident,
636 					(int)kp->v_fault);
637 		xp->v_vers = V_OLD ;
638 		/* save device specific info */
639 		for(bp = &bsc[0]; bp <= &bsc[NBSC]; bp++)
640 			bp->b_devregs = (caddr_t)xp ;
641 		printf("%d BSC Ports initialized.\n",NBSC);
642 		break ;
643 
644 	case NWVIOCB:	/* new f/w, Bisync board */
645 		printf("%X: %x%x 16K VIOC-B, ",
646 					(long)kp, (int)kp->v_ident,
647 					(int)kp->v_fault);
648 		xp->v_vers = V_NEW ;
649 		xp->v_silosiz = kp->v_maxsilo ;
650 		/* save device specific info */
651 		for(bp = &bsc[0]; bp <= &bsc[NBSC]; bp++)
652 			bp->b_devregs = (caddr_t)xp ;
653 		printf("%d BSC Ports initialized.\n",NBSC);
654 		if(CBSIZE > kp->v_maxxmt)
655 			printf("vxinit: Warning CBSIZE > maxxmt\n") ;
656 		break ;
657 #endif
658 	case VBOPID:		/* VIOC-BOP */
659 		vxbbno++;
660 		vxtype[i] = 1;
661 		vxbopno[i] = vxbbno;
662 		printf("VIOC-BOP no. %d at %lx\n",vxbopno[i],VIOCBAS[i]);
663 	default:
664 		return ;	/* Not a viocx type */
665 	}
666 	xp->v_nbr = -1;		/* no number for it yet */
667 	xp->v_maxcmd = xp->v_vers == V_NEW ? 24 : 4;
668 
669 	for(j=0; j<NVCXBUFS; j++)	/* init all cmd buffers */
670 	{
671 		cp = &xp->vx_lst[j];	/* index a buffer */
672 		cp->c_fwd = &xp->vx_lst[j+1];	/* point to next buf */
673 	}
674 	xp->vx_avail = &xp->vx_lst[0];	/* set idx to 1st free buf */
675 	cp->c_fwd = (struct vxcmd *)0;	/* mark last buf in free list */
676 
677 	cp = vobtain(xp);	/* grap the control block */
678 	cp->cmd = LIDENT;	/* set command type */
679 	cp->par[0] = vxivec[i]; 	/* ack vector */
680 	cp->par[1] = cp->par[0]+1;	/* cmd resp vector */
681 	cp->par[3] = cp->par[0]+2;	/* unsol intr vector */
682 	cp->par[4] = 15;	/* max ports, no longer used */
683 	cp->par[5] = 0;		/* set 1st port number */
684 	vcmd(i, (caddr_t)&cp->cmd);	/* initialize the VIOC-X */
685 
686 	if (!wait) return;
687 	for (j = 0; cp->cmd == LIDENT && j < 4000000; j++)
688 		;
689 	if (j >= 4000000)
690 		printf("vx%d: didn't respond to LIDENT\n", i);
691 
692  	/* calculate address of response buffer */
693  	resp = (char *)kp;
694  	resp += kp->v_rspoff & 0x3FFF;
695 
696 	if(resp[0] != 0 && (resp[0]&0177) != 3)	/* did init work? */
697 	{
698 		vrelease(xp,cp);	/* init failed */
699 		return;			/* try next VIOC-X */
700 	}
701 
702 	xp->v_loport = cp->par[5];	/* save low port number */
703 	xp->v_hiport = cp->par[7];/* VIOC knows high port numbr */
704 	vrelease(xp,cp);	/* done with this control block */
705 	xp->v_nbr = i;		/* assign VIOC-X board number */
706 }
707 
708 /*
709  * Obtain a command buffer
710  */
711 struct	vxcmd *
712 vobtain(xp)
713 register struct	vcx	*xp;
714 {
715 
716 	register struct	vxcmd	*p;
717 	register s;
718 
719 	s = spl8();
720 	p = xp->vx_avail;
721 	if(p == (struct vxcmd *)0) {
722 #ifdef VX_DEBUG
723 		if (vxintr4 & VXNOBUF) vxintr4 &= ~VXNOBUF;
724 #endif
725 		vpanic("vx: no buffs");
726 		vxstreset(xp - vcx);
727 		splx(s);
728 		return(vobtain(xp));
729 	}
730 	xp->vx_avail = (xp->vx_avail)->c_fwd;
731 	splx(s);
732 	return( (struct vxcmd *)p);
733 }
734 
735 /*
736  * Release a command buffer
737  */
738 vrelease(xp,cp)
739 register struct	vcx	*xp;
740 register struct	vxcmd	*cp;
741 {
742 
743 	register s;
744 
745 #ifdef VX_DEBUG
746 	if (vxintr4 & VXNOBUF) return;
747 #endif
748 	s = spl8();
749 	cp->c_fwd = xp->vx_avail;
750 	xp->vx_avail = cp;
751 	splx(s);
752 }
753 
754 /*
755  * vxcmd -
756  *
757  */
758 struct vxcmd 	*
759 nextcmd(xp)
760 register struct	vcx	*xp;
761 {
762 	register struct	vxcmd	*cp;
763 	register int	s;
764 
765 	s = spl8();
766 	cp = xp->vx_build;
767 	xp->vx_build = (struct vxcmd *)0;
768 	splx(s);
769 	return(cp);
770 }
771 
772 /*
773  * assemble transmits into a multiple command.
774  * up to 8 transmits to 8 lines can be assembled together
775  */
776 vsetq(xp ,d ,addr, n)
777 register struct	vcx	*xp;
778 caddr_t	addr;
779 {
780 
781 	register struct	vxcmd	*cp;
782 	register struct	vxmit	*mp;
783 	register char	*p;
784 	register i;
785 
786 	cp = xp->vx_build;
787 	if(cp == (struct vxcmd *)0) {
788 		cp = vobtain(xp);
789 		xp->vx_build = cp;
790 		cp->cmd = XMITDTA;
791 	} else {
792 		if((cp->cmd & 07) == 07) {
793 			vpanic("vx: vsetq overflow");
794 			vxstreset(xp->v_nbr);
795 			return(0);
796 		}
797 		cp->cmd++;
798 	}
799 
800 	mp = (struct vxmit *)(cp->par + (cp->cmd & 07)*sizvxmit);
801 	mp->bcount = n-1;
802 
803 	mp->line = d;
804 	if((xp->v_vers == V_NEW) && (n <= 6)) {
805 		cp->cmd = XMITIMM ;
806 		p = addr;
807 		/* bcopy(addr, &(char *)mp->ostream, n) ; */
808 	} else {
809 		addr = (caddr_t)vtoph((struct proc *)0, (unsigned)addr);
810 				/* should be a sys address */
811 		p = (char *)&addr;
812 		n = sizeof addr;
813 		/* mp->ostream = addr ; */
814 	}
815 	for(i=0; i<n; i++)
816 		mp->ostream[i] = *p++;
817 	if(xp->v_vers == V_NEW)
818 		return(1) ;
819 	else
820 		return((cp->cmd&07) == 7) ;	/* Indicate if full */
821 }
822 #endif
823