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