pci_xhci.c revision 336161
1/*-
2 * Copyright (c) 2014 Leon Dang <ldang@nahannisys.com>
3 * All rights reserved.
4 *
5 * Redistribution and use in source and binary forms, with or without
6 * modification, are permitted provided that the following conditions
7 * are met:
8 * 1. Redistributions of source code must retain the above copyright
9 *    notice, this list of conditions and the following disclaimer.
10 * 2. Redistributions in binary form must reproduce the above copyright
11 *    notice, this list of conditions and the following disclaimer in the
12 *    documentation and/or other materials provided with the distribution.
13 *
14 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
15 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
16 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
17 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
18 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
19 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
20 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
21 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
22 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
23 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
24 * SUCH DAMAGE.
25 */
26/*
27   XHCI options:
28    -s <n>,xhci,{devices}
29
30   devices:
31     tablet             USB tablet mouse
32 */
33#include <sys/cdefs.h>
34__FBSDID("$FreeBSD: stable/11/usr.sbin/bhyve/pci_xhci.c 336161 2018-07-10 04:26:32Z araujo $");
35
36#include <sys/param.h>
37#include <sys/uio.h>
38#include <sys/types.h>
39#include <sys/queue.h>
40
41#include <stdio.h>
42#include <stdlib.h>
43#include <stdint.h>
44#include <string.h>
45#include <errno.h>
46#include <pthread.h>
47#include <unistd.h>
48
49#include <dev/usb/usbdi.h>
50#include <dev/usb/usb.h>
51#include <dev/usb/usb_freebsd.h>
52#include <xhcireg.h>
53
54#include "bhyverun.h"
55#include "pci_emul.h"
56#include "pci_xhci.h"
57#include "usb_emul.h"
58
59
60static int xhci_debug = 0;
61#define	DPRINTF(params) if (xhci_debug) printf params
62#define	WPRINTF(params) printf params
63
64
65#define	XHCI_NAME		"xhci"
66#define	XHCI_MAX_DEVS		8	/* 4 USB3 + 4 USB2 devs */
67
68#define	XHCI_MAX_SLOTS		64	/* min allowed by Windows drivers */
69
70/*
71 * XHCI data structures can be up to 64k, but limit paddr_guest2host mapping
72 * to 4k to avoid going over the guest physical memory barrier.
73 */
74#define	XHCI_PADDR_SZ		4096	/* paddr_guest2host max size */
75
76#define	XHCI_ERST_MAX		0	/* max 2^entries event ring seg tbl */
77
78#define	XHCI_CAPLEN		(4*8)	/* offset of op register space */
79#define	XHCI_HCCPRAMS2		0x1C	/* offset of HCCPARAMS2 register */
80#define	XHCI_PORTREGS_START	0x400
81#define	XHCI_DOORBELL_MAX	256
82
83#define	XHCI_STREAMS_MAX	1	/* 4-15 in XHCI spec */
84
85/* caplength and hci-version registers */
86#define	XHCI_SET_CAPLEN(x)		((x) & 0xFF)
87#define	XHCI_SET_HCIVERSION(x)		(((x) & 0xFFFF) << 16)
88#define	XHCI_GET_HCIVERSION(x)		(((x) >> 16) & 0xFFFF)
89
90/* hcsparams1 register */
91#define	XHCI_SET_HCSP1_MAXSLOTS(x)	((x) & 0xFF)
92#define	XHCI_SET_HCSP1_MAXINTR(x)	(((x) & 0x7FF) << 8)
93#define	XHCI_SET_HCSP1_MAXPORTS(x)	(((x) & 0xFF) << 24)
94
95/* hcsparams2 register */
96#define	XHCI_SET_HCSP2_IST(x)		((x) & 0x0F)
97#define	XHCI_SET_HCSP2_ERSTMAX(x)	(((x) & 0x0F) << 4)
98#define	XHCI_SET_HCSP2_MAXSCRATCH_HI(x)	(((x) & 0x1F) << 21)
99#define	XHCI_SET_HCSP2_MAXSCRATCH_LO(x)	(((x) & 0x1F) << 27)
100
101/* hcsparams3 register */
102#define	XHCI_SET_HCSP3_U1EXITLATENCY(x)	((x) & 0xFF)
103#define	XHCI_SET_HCSP3_U2EXITLATENCY(x)	(((x) & 0xFFFF) << 16)
104
105/* hccparams1 register */
106#define	XHCI_SET_HCCP1_AC64(x)		((x) & 0x01)
107#define	XHCI_SET_HCCP1_BNC(x)		(((x) & 0x01) << 1)
108#define	XHCI_SET_HCCP1_CSZ(x)		(((x) & 0x01) << 2)
109#define	XHCI_SET_HCCP1_PPC(x)		(((x) & 0x01) << 3)
110#define	XHCI_SET_HCCP1_PIND(x)		(((x) & 0x01) << 4)
111#define	XHCI_SET_HCCP1_LHRC(x)		(((x) & 0x01) << 5)
112#define	XHCI_SET_HCCP1_LTC(x)		(((x) & 0x01) << 6)
113#define	XHCI_SET_HCCP1_NSS(x)		(((x) & 0x01) << 7)
114#define	XHCI_SET_HCCP1_PAE(x)		(((x) & 0x01) << 8)
115#define	XHCI_SET_HCCP1_SPC(x)		(((x) & 0x01) << 9)
116#define	XHCI_SET_HCCP1_SEC(x)		(((x) & 0x01) << 10)
117#define	XHCI_SET_HCCP1_CFC(x)		(((x) & 0x01) << 11)
118#define	XHCI_SET_HCCP1_MAXPSA(x)	(((x) & 0x0F) << 12)
119#define	XHCI_SET_HCCP1_XECP(x)		(((x) & 0xFFFF) << 16)
120
121/* hccparams2 register */
122#define	XHCI_SET_HCCP2_U3C(x)		((x) & 0x01)
123#define	XHCI_SET_HCCP2_CMC(x)		(((x) & 0x01) << 1)
124#define	XHCI_SET_HCCP2_FSC(x)		(((x) & 0x01) << 2)
125#define	XHCI_SET_HCCP2_CTC(x)		(((x) & 0x01) << 3)
126#define	XHCI_SET_HCCP2_LEC(x)		(((x) & 0x01) << 4)
127#define	XHCI_SET_HCCP2_CIC(x)		(((x) & 0x01) << 5)
128
129/* other registers */
130#define	XHCI_SET_DOORBELL(x)		((x) & ~0x03)
131#define	XHCI_SET_RTSOFFSET(x)		((x) & ~0x0F)
132
133/* register masks */
134#define	XHCI_PS_PLS_MASK		(0xF << 5)	/* port link state */
135#define	XHCI_PS_SPEED_MASK		(0xF << 10)	/* port speed */
136#define	XHCI_PS_PIC_MASK		(0x3 << 14)	/* port indicator */
137
138/* port register set */
139#define	XHCI_PORTREGS_BASE		0x400		/* base offset */
140#define	XHCI_PORTREGS_PORT0		0x3F0
141#define	XHCI_PORTREGS_SETSZ		0x10		/* size of a set */
142
143#define	MASK_64_HI(x)			((x) & ~0xFFFFFFFFULL)
144#define	MASK_64_LO(x)			((x) & 0xFFFFFFFFULL)
145
146#define	FIELD_REPLACE(a,b,m,s)		(((a) & ~((m) << (s))) | \
147					(((b) & (m)) << (s)))
148#define	FIELD_COPY(a,b,m,s)		(((a) & ~((m) << (s))) | \
149					(((b) & ((m) << (s)))))
150
151struct pci_xhci_trb_ring {
152	uint64_t ringaddr;		/* current dequeue guest address */
153	uint32_t ccs;			/* consumer cycle state */
154};
155
156/* device endpoint transfer/stream rings */
157struct pci_xhci_dev_ep {
158	union {
159		struct xhci_trb		*_epu_tr;
160		struct xhci_stream_ctx	*_epu_sctx;
161	} _ep_trbsctx;
162#define	ep_tr		_ep_trbsctx._epu_tr
163#define	ep_sctx		_ep_trbsctx._epu_sctx
164
165	union {
166		struct pci_xhci_trb_ring _epu_trb;
167		struct pci_xhci_trb_ring *_epu_sctx_trbs;
168	} _ep_trb_rings;
169#define	ep_ringaddr	_ep_trb_rings._epu_trb.ringaddr
170#define	ep_ccs		_ep_trb_rings._epu_trb.ccs
171#define	ep_sctx_trbs	_ep_trb_rings._epu_sctx_trbs
172
173	struct usb_data_xfer *ep_xfer;	/* transfer chain */
174};
175
176/* device context base address array: maps slot->device context */
177struct xhci_dcbaa {
178	uint64_t dcba[USB_MAX_DEVICES+1]; /* xhci_dev_ctx ptrs */
179};
180
181/* port status registers */
182struct pci_xhci_portregs {
183	uint32_t	portsc;		/* port status and control */
184	uint32_t	portpmsc;	/* port pwr mgmt status & control */
185	uint32_t	portli;		/* port link info */
186	uint32_t	porthlpmc;	/* port hardware LPM control */
187} __packed;
188#define	XHCI_PS_SPEED_SET(x)	(((x) & 0xF) << 10)
189
190/* xHC operational registers */
191struct pci_xhci_opregs {
192	uint32_t	usbcmd;		/* usb command */
193	uint32_t	usbsts;		/* usb status */
194	uint32_t	pgsz;		/* page size */
195	uint32_t	dnctrl;		/* device notification control */
196	uint64_t	crcr;		/* command ring control */
197	uint64_t	dcbaap;		/* device ctx base addr array ptr */
198	uint32_t	config;		/* configure */
199
200	/* guest mapped addresses: */
201	struct xhci_trb	*cr_p;		/* crcr dequeue */
202	struct xhci_dcbaa *dcbaa_p;	/* dev ctx array ptr */
203};
204
205/* xHC runtime registers */
206struct pci_xhci_rtsregs {
207	uint32_t	mfindex;	/* microframe index */
208	struct {			/* interrupter register set */
209		uint32_t	iman;	/* interrupter management */
210		uint32_t	imod;	/* interrupter moderation */
211		uint32_t	erstsz;	/* event ring segment table size */
212		uint32_t	rsvd;
213		uint64_t	erstba;	/* event ring seg-tbl base addr */
214		uint64_t	erdp;	/* event ring dequeue ptr */
215	} intrreg __packed;
216
217	/* guest mapped addresses */
218	struct xhci_event_ring_seg *erstba_p;
219	struct xhci_trb *erst_p;	/* event ring segment tbl */
220	int		er_deq_seg;	/* event ring dequeue segment */
221	int		er_enq_idx;	/* event ring enqueue index - xHCI */
222	int		er_enq_seg;	/* event ring enqueue segment */
223	uint32_t	er_events_cnt;	/* number of events in ER */
224	uint32_t	event_pcs;	/* producer cycle state flag */
225};
226
227
228struct pci_xhci_softc;
229
230
231/*
232 * USB device emulation container.
233 * This is referenced from usb_hci->hci_sc; 1 pci_xhci_dev_emu for each
234 * emulated device instance.
235 */
236struct pci_xhci_dev_emu {
237	struct pci_xhci_softc	*xsc;
238
239	/* XHCI contexts */
240	struct xhci_dev_ctx	*dev_ctx;
241	struct pci_xhci_dev_ep	eps[XHCI_MAX_ENDPOINTS];
242	int			dev_slotstate;
243
244	struct usb_devemu	*dev_ue;	/* USB emulated dev */
245	void			*dev_sc;	/* device's softc */
246
247	struct usb_hci		hci;
248};
249
250struct pci_xhci_softc {
251	struct pci_devinst *xsc_pi;
252
253	pthread_mutex_t	mtx;
254
255	uint32_t	caplength;	/* caplen & hciversion */
256	uint32_t	hcsparams1;	/* structural parameters 1 */
257	uint32_t	hcsparams2;	/* structural parameters 2 */
258	uint32_t	hcsparams3;	/* structural parameters 3 */
259	uint32_t	hccparams1;	/* capability parameters 1 */
260	uint32_t	dboff;		/* doorbell offset */
261	uint32_t	rtsoff;		/* runtime register space offset */
262	uint32_t	hccparams2;	/* capability parameters 2 */
263
264	uint32_t	regsend;	/* end of configuration registers */
265
266	struct pci_xhci_opregs  opregs;
267	struct pci_xhci_rtsregs rtsregs;
268
269	struct pci_xhci_portregs *portregs;
270	struct pci_xhci_dev_emu  **devices; /* XHCI[port] = device */
271	struct pci_xhci_dev_emu  **slots;   /* slots assigned from 1 */
272	int		ndevices;
273
274	int		usb2_port_start;
275	int		usb3_port_start;
276};
277
278
279/* portregs and devices arrays are set up to start from idx=1 */
280#define	XHCI_PORTREG_PTR(x,n)	&(x)->portregs[(n)]
281#define	XHCI_DEVINST_PTR(x,n)	(x)->devices[(n)]
282#define	XHCI_SLOTDEV_PTR(x,n)	(x)->slots[(n)]
283
284#define	XHCI_HALTED(sc)		((sc)->opregs.usbsts & XHCI_STS_HCH)
285
286#define	XHCI_GADDR(sc,a)	paddr_guest2host((sc)->xsc_pi->pi_vmctx, \
287				    (a),                                 \
288				    XHCI_PADDR_SZ - ((a) & (XHCI_PADDR_SZ-1)))
289
290static int xhci_in_use;
291
292/* map USB errors to XHCI */
293static const int xhci_usb_errors[USB_ERR_MAX] = {
294	[USB_ERR_NORMAL_COMPLETION]	= XHCI_TRB_ERROR_SUCCESS,
295	[USB_ERR_PENDING_REQUESTS]	= XHCI_TRB_ERROR_RESOURCE,
296	[USB_ERR_NOT_STARTED]		= XHCI_TRB_ERROR_ENDP_NOT_ON,
297	[USB_ERR_INVAL]			= XHCI_TRB_ERROR_INVALID,
298	[USB_ERR_NOMEM]			= XHCI_TRB_ERROR_RESOURCE,
299	[USB_ERR_CANCELLED]		= XHCI_TRB_ERROR_STOPPED,
300	[USB_ERR_BAD_ADDRESS]		= XHCI_TRB_ERROR_PARAMETER,
301	[USB_ERR_BAD_BUFSIZE]		= XHCI_TRB_ERROR_PARAMETER,
302	[USB_ERR_BAD_FLAG]		= XHCI_TRB_ERROR_PARAMETER,
303	[USB_ERR_NO_CALLBACK]		= XHCI_TRB_ERROR_STALL,
304	[USB_ERR_IN_USE]		= XHCI_TRB_ERROR_RESOURCE,
305	[USB_ERR_NO_ADDR]		= XHCI_TRB_ERROR_RESOURCE,
306	[USB_ERR_NO_PIPE]               = XHCI_TRB_ERROR_RESOURCE,
307	[USB_ERR_ZERO_NFRAMES]          = XHCI_TRB_ERROR_UNDEFINED,
308	[USB_ERR_ZERO_MAXP]             = XHCI_TRB_ERROR_UNDEFINED,
309	[USB_ERR_SET_ADDR_FAILED]       = XHCI_TRB_ERROR_RESOURCE,
310	[USB_ERR_NO_POWER]              = XHCI_TRB_ERROR_ENDP_NOT_ON,
311	[USB_ERR_TOO_DEEP]              = XHCI_TRB_ERROR_RESOURCE,
312	[USB_ERR_IOERROR]               = XHCI_TRB_ERROR_TRB,
313	[USB_ERR_NOT_CONFIGURED]        = XHCI_TRB_ERROR_ENDP_NOT_ON,
314	[USB_ERR_TIMEOUT]               = XHCI_TRB_ERROR_CMD_ABORTED,
315	[USB_ERR_SHORT_XFER]            = XHCI_TRB_ERROR_SHORT_PKT,
316	[USB_ERR_STALLED]               = XHCI_TRB_ERROR_STALL,
317	[USB_ERR_INTERRUPTED]           = XHCI_TRB_ERROR_CMD_ABORTED,
318	[USB_ERR_DMA_LOAD_FAILED]       = XHCI_TRB_ERROR_DATA_BUF,
319	[USB_ERR_BAD_CONTEXT]           = XHCI_TRB_ERROR_TRB,
320	[USB_ERR_NO_ROOT_HUB]           = XHCI_TRB_ERROR_UNDEFINED,
321	[USB_ERR_NO_INTR_THREAD]        = XHCI_TRB_ERROR_UNDEFINED,
322	[USB_ERR_NOT_LOCKED]            = XHCI_TRB_ERROR_UNDEFINED,
323};
324#define	USB_TO_XHCI_ERR(e)	((e) < USB_ERR_MAX ? xhci_usb_errors[(e)] : \
325				XHCI_TRB_ERROR_INVALID)
326
327static int pci_xhci_insert_event(struct pci_xhci_softc *sc,
328    struct xhci_trb *evtrb, int do_intr);
329static void pci_xhci_dump_trb(struct xhci_trb *trb);
330static void pci_xhci_assert_interrupt(struct pci_xhci_softc *sc);
331static void pci_xhci_reset_slot(struct pci_xhci_softc *sc, int slot);
332static void pci_xhci_reset_port(struct pci_xhci_softc *sc, int portn, int warm);
333static void pci_xhci_update_ep_ring(struct pci_xhci_softc *sc,
334    struct pci_xhci_dev_emu *dev, struct pci_xhci_dev_ep *devep,
335    struct xhci_endp_ctx *ep_ctx, uint32_t streamid,
336    uint64_t ringaddr, int ccs);
337
338static void
339pci_xhci_set_evtrb(struct xhci_trb *evtrb, uint64_t port, uint32_t errcode,
340    uint32_t evtype)
341{
342	evtrb->qwTrb0 = port << 24;
343	evtrb->dwTrb2 = XHCI_TRB_2_ERROR_SET(errcode);
344	evtrb->dwTrb3 = XHCI_TRB_3_TYPE_SET(evtype);
345}
346
347
348/* controller reset */
349static void
350pci_xhci_reset(struct pci_xhci_softc *sc)
351{
352	int i;
353
354	sc->rtsregs.er_enq_idx = 0;
355	sc->rtsregs.er_events_cnt = 0;
356	sc->rtsregs.event_pcs = 1;
357
358	for (i = 1; i <= XHCI_MAX_SLOTS; i++) {
359		pci_xhci_reset_slot(sc, i);
360	}
361}
362
363static uint32_t
364pci_xhci_usbcmd_write(struct pci_xhci_softc *sc, uint32_t cmd)
365{
366	int do_intr = 0;
367	int i;
368
369	if (cmd & XHCI_CMD_RS) {
370		do_intr = (sc->opregs.usbcmd & XHCI_CMD_RS) == 0;
371
372		sc->opregs.usbcmd |= XHCI_CMD_RS;
373		sc->opregs.usbsts &= ~XHCI_STS_HCH;
374		sc->opregs.usbsts |= XHCI_STS_PCD;
375
376		/* Queue port change event on controller run from stop */
377		if (do_intr)
378			for (i = 1; i <= XHCI_MAX_DEVS; i++) {
379				struct pci_xhci_dev_emu *dev;
380				struct pci_xhci_portregs *port;
381				struct xhci_trb		evtrb;
382
383				if ((dev = XHCI_DEVINST_PTR(sc, i)) == NULL)
384					continue;
385
386				port = XHCI_PORTREG_PTR(sc, i);
387				port->portsc |= XHCI_PS_CSC | XHCI_PS_CCS;
388				port->portsc &= ~XHCI_PS_PLS_MASK;
389
390				/*
391				 * XHCI 4.19.3 USB2 RxDetect->Polling,
392				 *             USB3 Polling->U0
393				 */
394				if (dev->dev_ue->ue_usbver == 2)
395					port->portsc |=
396					    XHCI_PS_PLS_SET(UPS_PORT_LS_POLL);
397				else
398					port->portsc |=
399					    XHCI_PS_PLS_SET(UPS_PORT_LS_U0);
400
401				pci_xhci_set_evtrb(&evtrb, i,
402				    XHCI_TRB_ERROR_SUCCESS,
403				    XHCI_TRB_EVENT_PORT_STS_CHANGE);
404
405				if (pci_xhci_insert_event(sc, &evtrb, 0) !=
406				    XHCI_TRB_ERROR_SUCCESS)
407					break;
408			}
409	} else {
410		sc->opregs.usbcmd &= ~XHCI_CMD_RS;
411		sc->opregs.usbsts |= XHCI_STS_HCH;
412		sc->opregs.usbsts &= ~XHCI_STS_PCD;
413	}
414
415	/* start execution of schedule; stop when set to 0 */
416	cmd |= sc->opregs.usbcmd & XHCI_CMD_RS;
417
418	if (cmd & XHCI_CMD_HCRST) {
419		/* reset controller */
420		pci_xhci_reset(sc);
421		cmd &= ~XHCI_CMD_HCRST;
422	}
423
424	cmd &= ~(XHCI_CMD_CSS | XHCI_CMD_CRS);
425
426	if (do_intr)
427		pci_xhci_assert_interrupt(sc);
428
429	return (cmd);
430}
431
432static void
433pci_xhci_portregs_write(struct pci_xhci_softc *sc, uint64_t offset,
434    uint64_t value)
435{
436	struct xhci_trb		evtrb;
437	struct pci_xhci_portregs *p;
438	int port;
439	uint32_t oldpls, newpls;
440
441	if (sc->portregs == NULL)
442		return;
443
444	port = (offset - XHCI_PORTREGS_PORT0) / XHCI_PORTREGS_SETSZ;
445	offset = (offset - XHCI_PORTREGS_PORT0) % XHCI_PORTREGS_SETSZ;
446
447	DPRINTF(("pci_xhci: portregs wr offset 0x%lx, port %u: 0x%lx\r\n",
448	        offset, port, value));
449
450	assert(port >= 0);
451
452	if (port > XHCI_MAX_DEVS) {
453		DPRINTF(("pci_xhci: portregs_write port %d > ndevices\r\n",
454		    port));
455		return;
456	}
457
458	if (XHCI_DEVINST_PTR(sc, port) == NULL) {
459		DPRINTF(("pci_xhci: portregs_write to unattached port %d\r\n",
460		     port));
461	}
462
463	p = XHCI_PORTREG_PTR(sc, port);
464	switch (offset) {
465	case 0:
466		/* port reset or warm reset */
467		if (value & (XHCI_PS_PR | XHCI_PS_WPR)) {
468			pci_xhci_reset_port(sc, port, value & XHCI_PS_WPR);
469			break;
470		}
471
472		if ((p->portsc & XHCI_PS_PP) == 0) {
473			WPRINTF(("pci_xhci: portregs_write to unpowered "
474			         "port %d\r\n", port));
475			break;
476		}
477
478		/* Port status and control register  */
479		oldpls = XHCI_PS_PLS_GET(p->portsc);
480		newpls = XHCI_PS_PLS_GET(value);
481
482		p->portsc &= XHCI_PS_PED | XHCI_PS_PLS_MASK |
483		             XHCI_PS_SPEED_MASK | XHCI_PS_PIC_MASK;
484
485		if (XHCI_DEVINST_PTR(sc, port))
486			p->portsc |= XHCI_PS_CCS;
487
488		p->portsc |= (value &
489		              ~(XHCI_PS_OCA |
490		                XHCI_PS_PR  |
491			        XHCI_PS_PED |
492			        XHCI_PS_PLS_MASK   |	/* link state */
493			        XHCI_PS_SPEED_MASK |
494			        XHCI_PS_PIC_MASK   |	/* port indicator */
495			        XHCI_PS_LWS | XHCI_PS_DR | XHCI_PS_WPR));
496
497		/* clear control bits */
498		p->portsc &= ~(value &
499		               (XHCI_PS_CSC |
500		                XHCI_PS_PEC |
501		                XHCI_PS_WRC |
502		                XHCI_PS_OCC |
503		                XHCI_PS_PRC |
504		                XHCI_PS_PLC |
505		                XHCI_PS_CEC |
506		                XHCI_PS_CAS));
507
508		/* port disable request; for USB3, don't care */
509		if (value & XHCI_PS_PED)
510			DPRINTF(("Disable port %d request\r\n", port));
511
512		if (!(value & XHCI_PS_LWS))
513			break;
514
515		DPRINTF(("Port new PLS: %d\r\n", newpls));
516		switch (newpls) {
517		case 0: /* U0 */
518		case 3: /* U3 */
519			if (oldpls != newpls) {
520				p->portsc &= ~XHCI_PS_PLS_MASK;
521				p->portsc |= XHCI_PS_PLS_SET(newpls) |
522				             XHCI_PS_PLC;
523
524				if (oldpls != 0 && newpls == 0) {
525					pci_xhci_set_evtrb(&evtrb, port,
526					    XHCI_TRB_ERROR_SUCCESS,
527					    XHCI_TRB_EVENT_PORT_STS_CHANGE);
528
529					pci_xhci_insert_event(sc, &evtrb, 1);
530				}
531			}
532			break;
533
534		default:
535			DPRINTF(("Unhandled change port %d PLS %u\r\n",
536			         port, newpls));
537			break;
538		}
539		break;
540	case 4:
541		/* Port power management status and control register  */
542		p->portpmsc = value;
543		break;
544	case 8:
545		/* Port link information register */
546		DPRINTF(("pci_xhci attempted write to PORTLI, port %d\r\n",
547		        port));
548		break;
549	case 12:
550		/*
551		 * Port hardware LPM control register.
552		 * For USB3, this register is reserved.
553		 */
554		p->porthlpmc = value;
555		break;
556	}
557}
558
559struct xhci_dev_ctx *
560pci_xhci_get_dev_ctx(struct pci_xhci_softc *sc, uint32_t slot)
561{
562	uint64_t devctx_addr;
563	struct xhci_dev_ctx *devctx;
564
565	assert(slot > 0 && slot <= sc->ndevices);
566	assert(sc->opregs.dcbaa_p != NULL);
567
568	devctx_addr = sc->opregs.dcbaa_p->dcba[slot];
569
570	if (devctx_addr == 0) {
571		DPRINTF(("get_dev_ctx devctx_addr == 0\r\n"));
572		return (NULL);
573	}
574
575	DPRINTF(("pci_xhci: get dev ctx, slot %u devctx addr %016lx\r\n",
576	        slot, devctx_addr));
577	devctx = XHCI_GADDR(sc, devctx_addr & ~0x3FUL);
578
579	return (devctx);
580}
581
582struct xhci_trb *
583pci_xhci_trb_next(struct pci_xhci_softc *sc, struct xhci_trb *curtrb,
584    uint64_t *guestaddr)
585{
586	struct xhci_trb *next;
587
588	assert(curtrb != NULL);
589
590	if (XHCI_TRB_3_TYPE_GET(curtrb->dwTrb3) == XHCI_TRB_TYPE_LINK) {
591		if (guestaddr)
592			*guestaddr = curtrb->qwTrb0 & ~0xFUL;
593
594		next = XHCI_GADDR(sc, curtrb->qwTrb0 & ~0xFUL);
595	} else {
596		if (guestaddr)
597			*guestaddr += sizeof(struct xhci_trb) & ~0xFUL;
598
599		next = curtrb + 1;
600	}
601
602	return (next);
603}
604
605static void
606pci_xhci_assert_interrupt(struct pci_xhci_softc *sc)
607{
608
609	sc->rtsregs.intrreg.erdp |= XHCI_ERDP_LO_BUSY;
610	sc->rtsregs.intrreg.iman |= XHCI_IMAN_INTR_PEND;
611	sc->opregs.usbsts |= XHCI_STS_EINT;
612
613	/* only trigger interrupt if permitted */
614	if ((sc->opregs.usbcmd & XHCI_CMD_INTE) &&
615	    (sc->rtsregs.intrreg.iman & XHCI_IMAN_INTR_ENA)) {
616		if (pci_msi_enabled(sc->xsc_pi))
617			pci_generate_msi(sc->xsc_pi, 0);
618		else
619			pci_lintr_assert(sc->xsc_pi);
620	}
621}
622
623static void
624pci_xhci_deassert_interrupt(struct pci_xhci_softc *sc)
625{
626
627	if (!pci_msi_enabled(sc->xsc_pi))
628		pci_lintr_assert(sc->xsc_pi);
629}
630
631static void
632pci_xhci_init_ep(struct pci_xhci_dev_emu *dev, int epid)
633{
634	struct xhci_dev_ctx    *dev_ctx;
635	struct pci_xhci_dev_ep *devep;
636	struct xhci_endp_ctx   *ep_ctx;
637	uint32_t	pstreams;
638	int		i;
639
640	dev_ctx = dev->dev_ctx;
641	ep_ctx = &dev_ctx->ctx_ep[epid];
642	devep = &dev->eps[epid];
643	pstreams = XHCI_EPCTX_0_MAXP_STREAMS_GET(ep_ctx->dwEpCtx0);
644	if (pstreams > 0) {
645		DPRINTF(("init_ep %d with pstreams %d\r\n", epid, pstreams));
646		assert(devep->ep_sctx_trbs == NULL);
647
648		devep->ep_sctx = XHCI_GADDR(dev->xsc, ep_ctx->qwEpCtx2 &
649		                            XHCI_EPCTX_2_TR_DQ_PTR_MASK);
650		devep->ep_sctx_trbs = calloc(pstreams,
651		                      sizeof(struct pci_xhci_trb_ring));
652		for (i = 0; i < pstreams; i++) {
653			devep->ep_sctx_trbs[i].ringaddr =
654			                         devep->ep_sctx[i].qwSctx0 &
655			                         XHCI_SCTX_0_TR_DQ_PTR_MASK;
656			devep->ep_sctx_trbs[i].ccs =
657			     XHCI_SCTX_0_DCS_GET(devep->ep_sctx[i].qwSctx0);
658		}
659	} else {
660		DPRINTF(("init_ep %d with no pstreams\r\n", epid));
661		devep->ep_ringaddr = ep_ctx->qwEpCtx2 &
662		                     XHCI_EPCTX_2_TR_DQ_PTR_MASK;
663		devep->ep_ccs = XHCI_EPCTX_2_DCS_GET(ep_ctx->qwEpCtx2);
664		devep->ep_tr = XHCI_GADDR(dev->xsc, devep->ep_ringaddr);
665		DPRINTF(("init_ep tr DCS %x\r\n", devep->ep_ccs));
666	}
667
668	if (devep->ep_xfer == NULL) {
669		devep->ep_xfer = malloc(sizeof(struct usb_data_xfer));
670		USB_DATA_XFER_INIT(devep->ep_xfer);
671	}
672}
673
674static void
675pci_xhci_disable_ep(struct pci_xhci_dev_emu *dev, int epid)
676{
677	struct xhci_dev_ctx    *dev_ctx;
678	struct pci_xhci_dev_ep *devep;
679	struct xhci_endp_ctx   *ep_ctx;
680
681	DPRINTF(("pci_xhci disable_ep %d\r\n", epid));
682
683	dev_ctx = dev->dev_ctx;
684	ep_ctx = &dev_ctx->ctx_ep[epid];
685	ep_ctx->dwEpCtx0 = (ep_ctx->dwEpCtx0 & ~0x7) | XHCI_ST_EPCTX_DISABLED;
686
687	devep = &dev->eps[epid];
688	if (XHCI_EPCTX_0_MAXP_STREAMS_GET(ep_ctx->dwEpCtx0) > 0 &&
689	    devep->ep_sctx_trbs != NULL)
690			free(devep->ep_sctx_trbs);
691
692	if (devep->ep_xfer != NULL) {
693		free(devep->ep_xfer);
694		devep->ep_xfer = NULL;
695	}
696
697	memset(devep, 0, sizeof(struct pci_xhci_dev_ep));
698}
699
700
701/* reset device at slot and data structures related to it */
702static void
703pci_xhci_reset_slot(struct pci_xhci_softc *sc, int slot)
704{
705	struct pci_xhci_dev_emu *dev;
706
707	dev = XHCI_SLOTDEV_PTR(sc, slot);
708
709	if (!dev) {
710		DPRINTF(("xhci reset unassigned slot (%d)?\r\n", slot));
711	} else {
712		dev->dev_slotstate = XHCI_ST_DISABLED;
713	}
714
715	/* TODO: reset ring buffer pointers */
716}
717
718static int
719pci_xhci_insert_event(struct pci_xhci_softc *sc, struct xhci_trb *evtrb,
720    int do_intr)
721{
722	struct pci_xhci_rtsregs *rts;
723	uint64_t	erdp;
724	int		erdp_idx;
725	int		err;
726	struct xhci_trb *evtrbptr;
727
728	err = XHCI_TRB_ERROR_SUCCESS;
729
730	rts = &sc->rtsregs;
731
732	erdp = rts->intrreg.erdp & ~0xF;
733	erdp_idx = (erdp - rts->erstba_p[rts->er_deq_seg].qwEvrsTablePtr) /
734	           sizeof(struct xhci_trb);
735
736	DPRINTF(("pci_xhci: insert event 0[%lx] 2[%x] 3[%x]\r\n"
737	         "\terdp idx %d/seg %d, enq idx %d/seg %d, pcs %u\r\n"
738	         "\t(erdp=0x%lx, erst=0x%lx, tblsz=%u, do_intr %d)\r\n",
739	         evtrb->qwTrb0, evtrb->dwTrb2, evtrb->dwTrb3,
740	         erdp_idx, rts->er_deq_seg, rts->er_enq_idx,
741	         rts->er_enq_seg,
742	         rts->event_pcs, erdp, rts->erstba_p->qwEvrsTablePtr,
743	         rts->erstba_p->dwEvrsTableSize, do_intr));
744
745	evtrbptr = &rts->erst_p[rts->er_enq_idx];
746
747	/* TODO: multi-segment table */
748	if (rts->er_events_cnt >= rts->erstba_p->dwEvrsTableSize) {
749		DPRINTF(("pci_xhci[%d] cannot insert event; ring full\r\n",
750		         __LINE__));
751		err = XHCI_TRB_ERROR_EV_RING_FULL;
752		goto done;
753	}
754
755	if (rts->er_events_cnt == rts->erstba_p->dwEvrsTableSize - 1) {
756		struct xhci_trb	errev;
757
758		if ((evtrbptr->dwTrb3 & 0x1) == (rts->event_pcs & 0x1)) {
759
760			DPRINTF(("pci_xhci[%d] insert evt err: ring full\r\n",
761			         __LINE__));
762
763			errev.qwTrb0 = 0;
764			errev.dwTrb2 = XHCI_TRB_2_ERROR_SET(
765			                    XHCI_TRB_ERROR_EV_RING_FULL);
766			errev.dwTrb3 = XHCI_TRB_3_TYPE_SET(
767			                    XHCI_TRB_EVENT_HOST_CTRL) |
768			               rts->event_pcs;
769			rts->er_events_cnt++;
770			memcpy(&rts->erst_p[rts->er_enq_idx], &errev,
771			       sizeof(struct xhci_trb));
772			rts->er_enq_idx = (rts->er_enq_idx + 1) %
773			                  rts->erstba_p->dwEvrsTableSize;
774			err = XHCI_TRB_ERROR_EV_RING_FULL;
775			do_intr = 1;
776
777			goto done;
778		}
779	} else {
780		rts->er_events_cnt++;
781	}
782
783	evtrb->dwTrb3 &= ~XHCI_TRB_3_CYCLE_BIT;
784	evtrb->dwTrb3 |= rts->event_pcs;
785
786	memcpy(&rts->erst_p[rts->er_enq_idx], evtrb, sizeof(struct xhci_trb));
787	rts->er_enq_idx = (rts->er_enq_idx + 1) %
788	                  rts->erstba_p->dwEvrsTableSize;
789
790	if (rts->er_enq_idx == 0)
791		rts->event_pcs ^= 1;
792
793done:
794	if (do_intr)
795		pci_xhci_assert_interrupt(sc);
796
797	return (err);
798}
799
800static uint32_t
801pci_xhci_cmd_enable_slot(struct pci_xhci_softc *sc, uint32_t *slot)
802{
803	struct pci_xhci_dev_emu *dev;
804	uint32_t	cmderr;
805	int		i;
806
807	cmderr = XHCI_TRB_ERROR_NO_SLOTS;
808	if (sc->portregs != NULL)
809		for (i = 1; i <= XHCI_MAX_SLOTS; i++) {
810			dev = XHCI_SLOTDEV_PTR(sc, i);
811			if (dev && dev->dev_slotstate == XHCI_ST_DISABLED) {
812				*slot = i;
813				dev->dev_slotstate = XHCI_ST_ENABLED;
814				cmderr = XHCI_TRB_ERROR_SUCCESS;
815				dev->hci.hci_address = i;
816				break;
817			}
818		}
819
820	DPRINTF(("pci_xhci enable slot (error=%d) slot %u\r\n",
821		cmderr != XHCI_TRB_ERROR_SUCCESS, *slot));
822
823	return (cmderr);
824}
825
826static uint32_t
827pci_xhci_cmd_disable_slot(struct pci_xhci_softc *sc, uint32_t slot)
828{
829	struct pci_xhci_dev_emu *dev;
830	uint32_t cmderr;
831
832	DPRINTF(("pci_xhci disable slot %u\r\n", slot));
833
834	cmderr = XHCI_TRB_ERROR_NO_SLOTS;
835	if (sc->portregs == NULL)
836		goto done;
837
838	if (slot > sc->ndevices) {
839		cmderr = XHCI_TRB_ERROR_SLOT_NOT_ON;
840		goto done;
841	}
842
843	dev = XHCI_SLOTDEV_PTR(sc, slot);
844	if (dev) {
845		if (dev->dev_slotstate == XHCI_ST_DISABLED) {
846			cmderr = XHCI_TRB_ERROR_SLOT_NOT_ON;
847		} else {
848			dev->dev_slotstate = XHCI_ST_DISABLED;
849			cmderr = XHCI_TRB_ERROR_SUCCESS;
850			/* TODO: reset events and endpoints */
851		}
852	}
853
854done:
855	return (cmderr);
856}
857
858static uint32_t
859pci_xhci_cmd_reset_device(struct pci_xhci_softc *sc, uint32_t slot)
860{
861	struct pci_xhci_dev_emu *dev;
862	struct xhci_dev_ctx     *dev_ctx;
863	struct xhci_endp_ctx    *ep_ctx;
864	uint32_t	cmderr;
865	int		i;
866
867	cmderr = XHCI_TRB_ERROR_NO_SLOTS;
868	if (sc->portregs == NULL)
869		goto done;
870
871	DPRINTF(("pci_xhci reset device slot %u\r\n", slot));
872
873	dev = XHCI_SLOTDEV_PTR(sc, slot);
874	if (!dev || dev->dev_slotstate == XHCI_ST_DISABLED)
875		cmderr = XHCI_TRB_ERROR_SLOT_NOT_ON;
876	else {
877		dev->dev_slotstate = XHCI_ST_DEFAULT;
878
879		dev->hci.hci_address = 0;
880		dev_ctx = pci_xhci_get_dev_ctx(sc, slot);
881
882		/* slot state */
883		dev_ctx->ctx_slot.dwSctx3 = FIELD_REPLACE(
884		    dev_ctx->ctx_slot.dwSctx3, XHCI_ST_SLCTX_DEFAULT,
885		    0x1F, 27);
886
887		/* number of contexts */
888		dev_ctx->ctx_slot.dwSctx0 = FIELD_REPLACE(
889		    dev_ctx->ctx_slot.dwSctx0, 1, 0x1F, 27);
890
891		/* reset all eps other than ep-0 */
892		for (i = 2; i <= 31; i++) {
893			ep_ctx = &dev_ctx->ctx_ep[i];
894			ep_ctx->dwEpCtx0 = FIELD_REPLACE( ep_ctx->dwEpCtx0,
895			    XHCI_ST_EPCTX_DISABLED, 0x7, 0);
896		}
897
898		cmderr = XHCI_TRB_ERROR_SUCCESS;
899	}
900
901	pci_xhci_reset_slot(sc, slot);
902
903done:
904	return (cmderr);
905}
906
907static uint32_t
908pci_xhci_cmd_address_device(struct pci_xhci_softc *sc, uint32_t slot,
909    struct xhci_trb *trb)
910{
911	struct pci_xhci_dev_emu	*dev;
912	struct xhci_input_dev_ctx *input_ctx;
913	struct xhci_slot_ctx	*islot_ctx;
914	struct xhci_dev_ctx	*dev_ctx;
915	struct xhci_endp_ctx	*ep0_ctx;
916	uint32_t		cmderr;
917
918	input_ctx = XHCI_GADDR(sc, trb->qwTrb0 & ~0xFUL);
919	islot_ctx = &input_ctx->ctx_slot;
920	ep0_ctx = &input_ctx->ctx_ep[1];
921
922	cmderr = XHCI_TRB_ERROR_SUCCESS;
923
924	DPRINTF(("pci_xhci: address device, input ctl: D 0x%08x A 0x%08x,\r\n"
925	         "          slot %08x %08x %08x %08x\r\n"
926	         "          ep0  %08x %08x %016lx %08x\r\n",
927	        input_ctx->ctx_input.dwInCtx0, input_ctx->ctx_input.dwInCtx1,
928	        islot_ctx->dwSctx0, islot_ctx->dwSctx1,
929	        islot_ctx->dwSctx2, islot_ctx->dwSctx3,
930	        ep0_ctx->dwEpCtx0, ep0_ctx->dwEpCtx1, ep0_ctx->qwEpCtx2,
931	        ep0_ctx->dwEpCtx4));
932
933	/* when setting address: drop-ctx=0, add-ctx=slot+ep0 */
934	if ((input_ctx->ctx_input.dwInCtx0 != 0) ||
935	    (input_ctx->ctx_input.dwInCtx1 & 0x03) != 0x03) {
936		DPRINTF(("pci_xhci: address device, input ctl invalid\r\n"));
937		cmderr = XHCI_TRB_ERROR_TRB;
938		goto done;
939	}
940
941	/* assign address to slot */
942	dev_ctx = pci_xhci_get_dev_ctx(sc, slot);
943
944	DPRINTF(("pci_xhci: address device, dev ctx\r\n"
945	         "          slot %08x %08x %08x %08x\r\n",
946	        dev_ctx->ctx_slot.dwSctx0, dev_ctx->ctx_slot.dwSctx1,
947	        dev_ctx->ctx_slot.dwSctx2, dev_ctx->ctx_slot.dwSctx3));
948
949	dev = XHCI_SLOTDEV_PTR(sc, slot);
950	assert(dev != NULL);
951
952	dev->hci.hci_address = slot;
953	dev->dev_ctx = dev_ctx;
954
955	if (dev->dev_ue->ue_reset == NULL ||
956	    dev->dev_ue->ue_reset(dev->dev_sc) < 0) {
957		cmderr = XHCI_TRB_ERROR_ENDP_NOT_ON;
958		goto done;
959	}
960
961	memcpy(&dev_ctx->ctx_slot, islot_ctx, sizeof(struct xhci_slot_ctx));
962
963	dev_ctx->ctx_slot.dwSctx3 =
964	    XHCI_SCTX_3_SLOT_STATE_SET(XHCI_ST_SLCTX_ADDRESSED) |
965	    XHCI_SCTX_3_DEV_ADDR_SET(slot);
966
967	memcpy(&dev_ctx->ctx_ep[1], ep0_ctx, sizeof(struct xhci_endp_ctx));
968	ep0_ctx = &dev_ctx->ctx_ep[1];
969	ep0_ctx->dwEpCtx0 = (ep0_ctx->dwEpCtx0 & ~0x7) |
970	    XHCI_EPCTX_0_EPSTATE_SET(XHCI_ST_EPCTX_RUNNING);
971
972	pci_xhci_init_ep(dev, 1);
973
974	dev->dev_slotstate = XHCI_ST_ADDRESSED;
975
976	DPRINTF(("pci_xhci: address device, output ctx\r\n"
977	         "          slot %08x %08x %08x %08x\r\n"
978	         "          ep0  %08x %08x %016lx %08x\r\n",
979	        dev_ctx->ctx_slot.dwSctx0, dev_ctx->ctx_slot.dwSctx1,
980	        dev_ctx->ctx_slot.dwSctx2, dev_ctx->ctx_slot.dwSctx3,
981	        ep0_ctx->dwEpCtx0, ep0_ctx->dwEpCtx1, ep0_ctx->qwEpCtx2,
982	        ep0_ctx->dwEpCtx4));
983
984done:
985	return (cmderr);
986}
987
988static uint32_t
989pci_xhci_cmd_config_ep(struct pci_xhci_softc *sc, uint32_t slot,
990    struct xhci_trb *trb)
991{
992	struct xhci_input_dev_ctx *input_ctx;
993	struct pci_xhci_dev_emu	*dev;
994	struct xhci_dev_ctx	*dev_ctx;
995	struct xhci_endp_ctx	*ep_ctx, *iep_ctx;
996	uint32_t	cmderr;
997	int		i;
998
999	cmderr = XHCI_TRB_ERROR_SUCCESS;
1000
1001	DPRINTF(("pci_xhci config_ep slot %u\r\n", slot));
1002
1003	dev = XHCI_SLOTDEV_PTR(sc, slot);
1004	assert(dev != NULL);
1005
1006	if ((trb->dwTrb3 & XHCI_TRB_3_DCEP_BIT) != 0) {
1007		DPRINTF(("pci_xhci config_ep - deconfigure ep slot %u\r\n",
1008		        slot));
1009		if (dev->dev_ue->ue_stop != NULL)
1010			dev->dev_ue->ue_stop(dev->dev_sc);
1011
1012		dev->dev_slotstate = XHCI_ST_ADDRESSED;
1013
1014		dev->hci.hci_address = 0;
1015		dev_ctx = pci_xhci_get_dev_ctx(sc, slot);
1016
1017		/* number of contexts */
1018		dev_ctx->ctx_slot.dwSctx0 = FIELD_REPLACE(
1019		    dev_ctx->ctx_slot.dwSctx0, 1, 0x1F, 27);
1020
1021		/* slot state */
1022		dev_ctx->ctx_slot.dwSctx3 = FIELD_REPLACE(
1023		    dev_ctx->ctx_slot.dwSctx3, XHCI_ST_SLCTX_ADDRESSED,
1024		    0x1F, 27);
1025
1026		/* disable endpoints */
1027		for (i = 2; i < 32; i++)
1028			pci_xhci_disable_ep(dev, i);
1029
1030		cmderr = XHCI_TRB_ERROR_SUCCESS;
1031
1032		goto done;
1033	}
1034
1035	if (dev->dev_slotstate < XHCI_ST_ADDRESSED) {
1036		DPRINTF(("pci_xhci: config_ep slotstate x%x != addressed\r\n",
1037		        dev->dev_slotstate));
1038		cmderr = XHCI_TRB_ERROR_SLOT_NOT_ON;
1039		goto done;
1040	}
1041
1042	/* In addressed/configured state;
1043	 * for each drop endpoint ctx flag:
1044	 *   ep->state = DISABLED
1045	 * for each add endpoint ctx flag:
1046	 *   cp(ep-in, ep-out)
1047	 *   ep->state = RUNNING
1048	 * for each drop+add endpoint flag:
1049	 *   reset ep resources
1050	 *   cp(ep-in, ep-out)
1051	 *   ep->state = RUNNING
1052	 * if input->DisabledCtx[2-31] < 30: (at least 1 ep not disabled)
1053	 *   slot->state = configured
1054	 */
1055
1056	input_ctx = XHCI_GADDR(sc, trb->qwTrb0 & ~0xFUL);
1057	dev_ctx = dev->dev_ctx;
1058	DPRINTF(("pci_xhci: config_ep inputctx: D:x%08x A:x%08x 7:x%08x\r\n",
1059		input_ctx->ctx_input.dwInCtx0, input_ctx->ctx_input.dwInCtx1,
1060	        input_ctx->ctx_input.dwInCtx7));
1061
1062	for (i = 2; i <= 31; i++) {
1063		ep_ctx = &dev_ctx->ctx_ep[i];
1064
1065		if (input_ctx->ctx_input.dwInCtx0 &
1066		    XHCI_INCTX_0_DROP_MASK(i)) {
1067			DPRINTF((" config ep - dropping ep %d\r\n", i));
1068			pci_xhci_disable_ep(dev, i);
1069		}
1070
1071		if (input_ctx->ctx_input.dwInCtx1 &
1072		    XHCI_INCTX_1_ADD_MASK(i)) {
1073			iep_ctx = &input_ctx->ctx_ep[i];
1074
1075			DPRINTF((" enable ep[%d]  %08x %08x %016lx %08x\r\n",
1076			   i, iep_ctx->dwEpCtx0, iep_ctx->dwEpCtx1,
1077			   iep_ctx->qwEpCtx2, iep_ctx->dwEpCtx4));
1078
1079			memcpy(ep_ctx, iep_ctx, sizeof(struct xhci_endp_ctx));
1080
1081			pci_xhci_init_ep(dev, i);
1082
1083			/* ep state */
1084			ep_ctx->dwEpCtx0 = FIELD_REPLACE(
1085			    ep_ctx->dwEpCtx0, XHCI_ST_EPCTX_RUNNING, 0x7, 0);
1086		}
1087	}
1088
1089	/* slot state to configured */
1090	dev_ctx->ctx_slot.dwSctx3 = FIELD_REPLACE(
1091	    dev_ctx->ctx_slot.dwSctx3, XHCI_ST_SLCTX_CONFIGURED, 0x1F, 27);
1092	dev_ctx->ctx_slot.dwSctx0 = FIELD_COPY(
1093	    dev_ctx->ctx_slot.dwSctx0, input_ctx->ctx_slot.dwSctx0, 0x1F, 27);
1094	dev->dev_slotstate = XHCI_ST_CONFIGURED;
1095
1096	DPRINTF(("EP configured; slot %u [0]=0x%08x [1]=0x%08x [2]=0x%08x "
1097	         "[3]=0x%08x\r\n",
1098	    slot, dev_ctx->ctx_slot.dwSctx0, dev_ctx->ctx_slot.dwSctx1,
1099	    dev_ctx->ctx_slot.dwSctx2, dev_ctx->ctx_slot.dwSctx3));
1100
1101done:
1102	return (cmderr);
1103}
1104
1105static uint32_t
1106pci_xhci_cmd_reset_ep(struct pci_xhci_softc *sc, uint32_t slot,
1107    struct xhci_trb *trb)
1108{
1109	struct pci_xhci_dev_emu	*dev;
1110	struct pci_xhci_dev_ep *devep;
1111	struct xhci_dev_ctx	*dev_ctx;
1112	struct xhci_endp_ctx	*ep_ctx;
1113	uint32_t	cmderr, epid;
1114	uint32_t	type;
1115
1116	epid = XHCI_TRB_3_EP_GET(trb->dwTrb3);
1117
1118	DPRINTF(("pci_xhci: reset ep %u: slot %u\r\n", epid, slot));
1119
1120	cmderr = XHCI_TRB_ERROR_SUCCESS;
1121
1122	type = XHCI_TRB_3_TYPE_GET(trb->dwTrb3);
1123
1124	dev = XHCI_SLOTDEV_PTR(sc, slot);
1125	assert(dev != NULL);
1126
1127	if (type == XHCI_TRB_TYPE_STOP_EP &&
1128	    (trb->dwTrb3 & XHCI_TRB_3_SUSP_EP_BIT) != 0) {
1129		/* XXX suspend endpoint for 10ms */
1130	}
1131
1132	if (epid < 1 || epid > 31) {
1133		DPRINTF(("pci_xhci: reset ep: invalid epid %u\r\n", epid));
1134		cmderr = XHCI_TRB_ERROR_TRB;
1135		goto done;
1136	}
1137
1138	devep = &dev->eps[epid];
1139	if (devep->ep_xfer != NULL)
1140		USB_DATA_XFER_RESET(devep->ep_xfer);
1141
1142	dev_ctx = dev->dev_ctx;
1143	assert(dev_ctx != NULL);
1144
1145	ep_ctx = &dev_ctx->ctx_ep[epid];
1146
1147	ep_ctx->dwEpCtx0 = (ep_ctx->dwEpCtx0 & ~0x7) | XHCI_ST_EPCTX_STOPPED;
1148
1149	if (XHCI_EPCTX_0_MAXP_STREAMS_GET(ep_ctx->dwEpCtx0) == 0)
1150		ep_ctx->qwEpCtx2 = devep->ep_ringaddr | devep->ep_ccs;
1151
1152	DPRINTF(("pci_xhci: reset ep[%u] %08x %08x %016lx %08x\r\n",
1153	        epid, ep_ctx->dwEpCtx0, ep_ctx->dwEpCtx1, ep_ctx->qwEpCtx2,
1154	        ep_ctx->dwEpCtx4));
1155
1156	if (type == XHCI_TRB_TYPE_RESET_EP &&
1157	    (dev->dev_ue->ue_reset == NULL ||
1158	    dev->dev_ue->ue_reset(dev->dev_sc) < 0)) {
1159		cmderr = XHCI_TRB_ERROR_ENDP_NOT_ON;
1160		goto done;
1161	}
1162
1163done:
1164	return (cmderr);
1165}
1166
1167
1168static uint32_t
1169pci_xhci_find_stream(struct pci_xhci_softc *sc, struct xhci_endp_ctx *ep,
1170    uint32_t streamid, struct xhci_stream_ctx **osctx)
1171{
1172	struct xhci_stream_ctx *sctx;
1173	uint32_t	maxpstreams;
1174
1175	maxpstreams = XHCI_EPCTX_0_MAXP_STREAMS_GET(ep->dwEpCtx0);
1176	if (maxpstreams == 0)
1177		return (XHCI_TRB_ERROR_TRB);
1178
1179	if (maxpstreams > XHCI_STREAMS_MAX)
1180		return (XHCI_TRB_ERROR_INVALID_SID);
1181
1182	if (XHCI_EPCTX_0_LSA_GET(ep->dwEpCtx0) == 0) {
1183		DPRINTF(("pci_xhci: find_stream; LSA bit not set\r\n"));
1184		return (XHCI_TRB_ERROR_INVALID_SID);
1185	}
1186
1187	/* only support primary stream */
1188	if (streamid > maxpstreams)
1189		return (XHCI_TRB_ERROR_STREAM_TYPE);
1190
1191	sctx = XHCI_GADDR(sc, ep->qwEpCtx2 & ~0xFUL) + streamid;
1192	if (!XHCI_SCTX_0_SCT_GET(sctx->qwSctx0))
1193		return (XHCI_TRB_ERROR_STREAM_TYPE);
1194
1195	*osctx = sctx;
1196
1197	return (XHCI_TRB_ERROR_SUCCESS);
1198}
1199
1200
1201static uint32_t
1202pci_xhci_cmd_set_tr(struct pci_xhci_softc *sc, uint32_t slot,
1203    struct xhci_trb *trb)
1204{
1205	struct pci_xhci_dev_emu	*dev;
1206	struct pci_xhci_dev_ep	*devep;
1207	struct xhci_dev_ctx	*dev_ctx;
1208	struct xhci_endp_ctx	*ep_ctx;
1209	uint32_t	cmderr, epid;
1210	uint32_t	streamid;
1211
1212	cmderr = XHCI_TRB_ERROR_SUCCESS;
1213
1214	dev = XHCI_SLOTDEV_PTR(sc, slot);
1215	assert(dev != NULL);
1216
1217	DPRINTF(("pci_xhci set_tr: new-tr x%016lx, SCT %u DCS %u\r\n"
1218	         "                 stream-id %u, slot %u, epid %u, C %u\r\n",
1219	         (trb->qwTrb0 & ~0xF),  (uint32_t)((trb->qwTrb0 >> 1) & 0x7),
1220	         (uint32_t)(trb->qwTrb0 & 0x1), (trb->dwTrb2 >> 16) & 0xFFFF,
1221	         XHCI_TRB_3_SLOT_GET(trb->dwTrb3),
1222	         XHCI_TRB_3_EP_GET(trb->dwTrb3), trb->dwTrb3 & 0x1));
1223
1224	epid = XHCI_TRB_3_EP_GET(trb->dwTrb3);
1225	if (epid < 1 || epid > 31) {
1226		DPRINTF(("pci_xhci: set_tr_deq: invalid epid %u\r\n", epid));
1227		cmderr = XHCI_TRB_ERROR_TRB;
1228		goto done;
1229	}
1230
1231	dev_ctx = dev->dev_ctx;
1232	assert(dev_ctx != NULL);
1233
1234	ep_ctx = &dev_ctx->ctx_ep[epid];
1235	devep = &dev->eps[epid];
1236
1237	switch (XHCI_EPCTX_0_EPSTATE_GET(ep_ctx->dwEpCtx0)) {
1238	case XHCI_ST_EPCTX_STOPPED:
1239	case XHCI_ST_EPCTX_ERROR:
1240		break;
1241	default:
1242		DPRINTF(("pci_xhci cmd set_tr invalid state %x\r\n",
1243		        XHCI_EPCTX_0_EPSTATE_GET(ep_ctx->dwEpCtx0)));
1244		cmderr = XHCI_TRB_ERROR_CONTEXT_STATE;
1245		goto done;
1246	}
1247
1248	streamid = XHCI_TRB_2_STREAM_GET(trb->dwTrb2);
1249	if (XHCI_EPCTX_0_MAXP_STREAMS_GET(ep_ctx->dwEpCtx0) > 0) {
1250		struct xhci_stream_ctx *sctx;
1251
1252		sctx = NULL;
1253		cmderr = pci_xhci_find_stream(sc, ep_ctx, streamid, &sctx);
1254		if (sctx != NULL) {
1255			assert(devep->ep_sctx != NULL);
1256
1257			devep->ep_sctx[streamid].qwSctx0 = trb->qwTrb0;
1258			devep->ep_sctx_trbs[streamid].ringaddr =
1259			    trb->qwTrb0 & ~0xF;
1260			devep->ep_sctx_trbs[streamid].ccs =
1261			    XHCI_EPCTX_2_DCS_GET(trb->qwTrb0);
1262		}
1263	} else {
1264		if (streamid != 0) {
1265			DPRINTF(("pci_xhci cmd set_tr streamid %x != 0\r\n",
1266			        streamid));
1267		}
1268		ep_ctx->qwEpCtx2 = trb->qwTrb0 & ~0xFUL;
1269		devep->ep_ringaddr = ep_ctx->qwEpCtx2 & ~0xFUL;
1270		devep->ep_ccs = trb->qwTrb0 & 0x1;
1271		devep->ep_tr = XHCI_GADDR(sc, devep->ep_ringaddr);
1272
1273		DPRINTF(("pci_xhci set_tr first TRB:\r\n"));
1274		pci_xhci_dump_trb(devep->ep_tr);
1275	}
1276	ep_ctx->dwEpCtx0 = (ep_ctx->dwEpCtx0 & ~0x7) | XHCI_ST_EPCTX_STOPPED;
1277
1278done:
1279	return (cmderr);
1280}
1281
1282static uint32_t
1283pci_xhci_cmd_eval_ctx(struct pci_xhci_softc *sc, uint32_t slot,
1284    struct xhci_trb *trb)
1285{
1286	struct xhci_input_dev_ctx *input_ctx;
1287	struct xhci_slot_ctx      *islot_ctx;
1288	struct xhci_dev_ctx       *dev_ctx;
1289	struct xhci_endp_ctx      *ep0_ctx;
1290	uint32_t cmderr;
1291
1292	input_ctx = XHCI_GADDR(sc, trb->qwTrb0 & ~0xFUL);
1293	islot_ctx = &input_ctx->ctx_slot;
1294	ep0_ctx = &input_ctx->ctx_ep[1];
1295
1296	cmderr = XHCI_TRB_ERROR_SUCCESS;
1297	DPRINTF(("pci_xhci: eval ctx, input ctl: D 0x%08x A 0x%08x,\r\n"
1298	         "          slot %08x %08x %08x %08x\r\n"
1299	         "          ep0  %08x %08x %016lx %08x\r\n",
1300	        input_ctx->ctx_input.dwInCtx0, input_ctx->ctx_input.dwInCtx1,
1301	        islot_ctx->dwSctx0, islot_ctx->dwSctx1,
1302	        islot_ctx->dwSctx2, islot_ctx->dwSctx3,
1303	        ep0_ctx->dwEpCtx0, ep0_ctx->dwEpCtx1, ep0_ctx->qwEpCtx2,
1304	        ep0_ctx->dwEpCtx4));
1305
1306	/* this command expects drop-ctx=0 & add-ctx=slot+ep0 */
1307	if ((input_ctx->ctx_input.dwInCtx0 != 0) ||
1308	    (input_ctx->ctx_input.dwInCtx1 & 0x03) == 0) {
1309		DPRINTF(("pci_xhci: eval ctx, input ctl invalid\r\n"));
1310		cmderr = XHCI_TRB_ERROR_TRB;
1311		goto done;
1312	}
1313
1314	/* assign address to slot; in this emulation, slot_id = address */
1315	dev_ctx = pci_xhci_get_dev_ctx(sc, slot);
1316
1317	DPRINTF(("pci_xhci: eval ctx, dev ctx\r\n"
1318	         "          slot %08x %08x %08x %08x\r\n",
1319	        dev_ctx->ctx_slot.dwSctx0, dev_ctx->ctx_slot.dwSctx1,
1320	        dev_ctx->ctx_slot.dwSctx2, dev_ctx->ctx_slot.dwSctx3));
1321
1322	if (input_ctx->ctx_input.dwInCtx1 & 0x01) {	/* slot ctx */
1323		/* set max exit latency */
1324		dev_ctx->ctx_slot.dwSctx1 = FIELD_COPY(
1325		    dev_ctx->ctx_slot.dwSctx1, input_ctx->ctx_slot.dwSctx1,
1326		    0xFFFF, 0);
1327
1328		/* set interrupter target */
1329		dev_ctx->ctx_slot.dwSctx2 = FIELD_COPY(
1330		    dev_ctx->ctx_slot.dwSctx2, input_ctx->ctx_slot.dwSctx2,
1331		    0x3FF, 22);
1332	}
1333	if (input_ctx->ctx_input.dwInCtx1 & 0x02) {	/* control ctx */
1334		/* set max packet size */
1335		dev_ctx->ctx_ep[1].dwEpCtx1 = FIELD_COPY(
1336		    dev_ctx->ctx_ep[1].dwEpCtx1, ep0_ctx->dwEpCtx1,
1337		    0xFFFF, 16);
1338
1339		ep0_ctx = &dev_ctx->ctx_ep[1];
1340	}
1341
1342	DPRINTF(("pci_xhci: eval ctx, output ctx\r\n"
1343	         "          slot %08x %08x %08x %08x\r\n"
1344	         "          ep0  %08x %08x %016lx %08x\r\n",
1345	        dev_ctx->ctx_slot.dwSctx0, dev_ctx->ctx_slot.dwSctx1,
1346	        dev_ctx->ctx_slot.dwSctx2, dev_ctx->ctx_slot.dwSctx3,
1347	        ep0_ctx->dwEpCtx0, ep0_ctx->dwEpCtx1, ep0_ctx->qwEpCtx2,
1348	        ep0_ctx->dwEpCtx4));
1349
1350done:
1351	return (cmderr);
1352}
1353
1354static int
1355pci_xhci_complete_commands(struct pci_xhci_softc *sc)
1356{
1357	struct xhci_trb	evtrb;
1358	struct xhci_trb	*trb;
1359	uint64_t	crcr;
1360	uint32_t	ccs;		/* cycle state (XHCI 4.9.2) */
1361	uint32_t	type;
1362	uint32_t	slot;
1363	uint32_t	cmderr;
1364	int		error;
1365
1366	error = 0;
1367	sc->opregs.crcr |= XHCI_CRCR_LO_CRR;
1368
1369	trb = sc->opregs.cr_p;
1370	ccs = sc->opregs.crcr & XHCI_CRCR_LO_RCS;
1371	crcr = sc->opregs.crcr & ~0xF;
1372
1373	while (1) {
1374		sc->opregs.cr_p = trb;
1375
1376		type = XHCI_TRB_3_TYPE_GET(trb->dwTrb3);
1377
1378		if ((trb->dwTrb3 & XHCI_TRB_3_CYCLE_BIT) !=
1379		    (ccs & XHCI_TRB_3_CYCLE_BIT))
1380			break;
1381
1382		DPRINTF(("pci_xhci: cmd type 0x%x, Trb0 x%016lx dwTrb2 x%08x"
1383		        " dwTrb3 x%08x, TRB_CYCLE %u/ccs %u\r\n",
1384		        type, trb->qwTrb0, trb->dwTrb2, trb->dwTrb3,
1385		        trb->dwTrb3 & XHCI_TRB_3_CYCLE_BIT, ccs));
1386
1387		cmderr = XHCI_TRB_ERROR_SUCCESS;
1388		evtrb.dwTrb2 = 0;
1389		evtrb.dwTrb3 = (ccs & XHCI_TRB_3_CYCLE_BIT) |
1390		      XHCI_TRB_3_TYPE_SET(XHCI_TRB_EVENT_CMD_COMPLETE);
1391		slot = 0;
1392
1393		switch (type) {
1394		case XHCI_TRB_TYPE_LINK:			/* 0x06 */
1395			if (trb->dwTrb3 & XHCI_TRB_3_TC_BIT)
1396				ccs ^= XHCI_CRCR_LO_RCS;
1397			break;
1398
1399		case XHCI_TRB_TYPE_ENABLE_SLOT:			/* 0x09 */
1400			cmderr = pci_xhci_cmd_enable_slot(sc, &slot);
1401			break;
1402
1403		case XHCI_TRB_TYPE_DISABLE_SLOT:		/* 0x0A */
1404			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1405			cmderr = pci_xhci_cmd_disable_slot(sc, slot);
1406			break;
1407
1408		case XHCI_TRB_TYPE_ADDRESS_DEVICE:		/* 0x0B */
1409			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1410			cmderr = pci_xhci_cmd_address_device(sc, slot, trb);
1411			break;
1412
1413		case XHCI_TRB_TYPE_CONFIGURE_EP:		/* 0x0C */
1414			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1415			cmderr = pci_xhci_cmd_config_ep(sc, slot, trb);
1416			break;
1417
1418		case XHCI_TRB_TYPE_EVALUATE_CTX:		/* 0x0D */
1419			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1420			cmderr = pci_xhci_cmd_eval_ctx(sc, slot, trb);
1421			break;
1422
1423		case XHCI_TRB_TYPE_RESET_EP:			/* 0x0E */
1424			DPRINTF(("Reset Endpoint on slot %d\r\n", slot));
1425			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1426			cmderr = pci_xhci_cmd_reset_ep(sc, slot, trb);
1427			break;
1428
1429		case XHCI_TRB_TYPE_STOP_EP:			/* 0x0F */
1430			DPRINTF(("Stop Endpoint on slot %d\r\n", slot));
1431			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1432			cmderr = pci_xhci_cmd_reset_ep(sc, slot, trb);
1433			break;
1434
1435		case XHCI_TRB_TYPE_SET_TR_DEQUEUE:		/* 0x10 */
1436			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1437			cmderr = pci_xhci_cmd_set_tr(sc, slot, trb);
1438			break;
1439
1440		case XHCI_TRB_TYPE_RESET_DEVICE:		/* 0x11 */
1441			slot = XHCI_TRB_3_SLOT_GET(trb->dwTrb3);
1442			cmderr = pci_xhci_cmd_reset_device(sc, slot);
1443			break;
1444
1445		case XHCI_TRB_TYPE_FORCE_EVENT:			/* 0x12 */
1446			/* TODO: */
1447			break;
1448
1449		case XHCI_TRB_TYPE_NEGOTIATE_BW:		/* 0x13 */
1450			break;
1451
1452		case XHCI_TRB_TYPE_SET_LATENCY_TOL:		/* 0x14 */
1453			break;
1454
1455		case XHCI_TRB_TYPE_GET_PORT_BW:			/* 0x15 */
1456			break;
1457
1458		case XHCI_TRB_TYPE_FORCE_HEADER:		/* 0x16 */
1459			break;
1460
1461		case XHCI_TRB_TYPE_NOOP_CMD:			/* 0x17 */
1462			break;
1463
1464		default:
1465			DPRINTF(("pci_xhci: unsupported cmd %x\r\n", type));
1466			break;
1467		}
1468
1469		if (type != XHCI_TRB_TYPE_LINK) {
1470			/*
1471			 * insert command completion event and assert intr
1472			 */
1473			evtrb.qwTrb0 = crcr;
1474			evtrb.dwTrb2 |= XHCI_TRB_2_ERROR_SET(cmderr);
1475			evtrb.dwTrb3 |= XHCI_TRB_3_SLOT_SET(slot);
1476			DPRINTF(("pci_xhci: command 0x%x result: 0x%x\r\n",
1477			        type, cmderr));
1478			pci_xhci_insert_event(sc, &evtrb, 1);
1479		}
1480
1481		trb = pci_xhci_trb_next(sc, trb, &crcr);
1482	}
1483
1484	sc->opregs.crcr = crcr | (sc->opregs.crcr & XHCI_CRCR_LO_CA) | ccs;
1485	sc->opregs.crcr &= ~XHCI_CRCR_LO_CRR;
1486	return (error);
1487}
1488
1489static void
1490pci_xhci_dump_trb(struct xhci_trb *trb)
1491{
1492	static const char *trbtypes[] = {
1493		"RESERVED",
1494		"NORMAL",
1495		"SETUP_STAGE",
1496		"DATA_STAGE",
1497		"STATUS_STAGE",
1498		"ISOCH",
1499		"LINK",
1500		"EVENT_DATA",
1501		"NOOP",
1502		"ENABLE_SLOT",
1503		"DISABLE_SLOT",
1504		"ADDRESS_DEVICE",
1505		"CONFIGURE_EP",
1506		"EVALUATE_CTX",
1507		"RESET_EP",
1508		"STOP_EP",
1509		"SET_TR_DEQUEUE",
1510		"RESET_DEVICE",
1511		"FORCE_EVENT",
1512		"NEGOTIATE_BW",
1513		"SET_LATENCY_TOL",
1514		"GET_PORT_BW",
1515		"FORCE_HEADER",
1516		"NOOP_CMD"
1517	};
1518	uint32_t type;
1519
1520	type = XHCI_TRB_3_TYPE_GET(trb->dwTrb3);
1521	DPRINTF(("pci_xhci: trb[@%p] type x%02x %s 0:x%016lx 2:x%08x 3:x%08x\r\n",
1522	         trb, type,
1523	         type <= XHCI_TRB_TYPE_NOOP_CMD ? trbtypes[type] : "INVALID",
1524	         trb->qwTrb0, trb->dwTrb2, trb->dwTrb3));
1525}
1526
1527static int
1528pci_xhci_xfer_complete(struct pci_xhci_softc *sc, struct usb_data_xfer *xfer,
1529     uint32_t slot, uint32_t epid, int *do_intr)
1530{
1531	struct pci_xhci_dev_emu *dev;
1532	struct pci_xhci_dev_ep	*devep;
1533	struct xhci_dev_ctx	*dev_ctx;
1534	struct xhci_endp_ctx	*ep_ctx;
1535	struct xhci_trb		*trb;
1536	struct xhci_trb		evtrb;
1537	uint32_t trbflags;
1538	uint32_t edtla;
1539	int i, err;
1540
1541	dev = XHCI_SLOTDEV_PTR(sc, slot);
1542	devep = &dev->eps[epid];
1543	dev_ctx = pci_xhci_get_dev_ctx(sc, slot);
1544
1545	assert(dev_ctx != NULL);
1546
1547	ep_ctx = &dev_ctx->ctx_ep[epid];
1548
1549	err = XHCI_TRB_ERROR_SUCCESS;
1550	*do_intr = 0;
1551	edtla = 0;
1552
1553	/* go through list of TRBs and insert event(s) */
1554	for (i = xfer->head; xfer->ndata > 0; ) {
1555		evtrb.qwTrb0 = (uint64_t)xfer->data[i].hci_data;
1556		trb = XHCI_GADDR(sc, evtrb.qwTrb0);
1557		trbflags = trb->dwTrb3;
1558
1559		DPRINTF(("pci_xhci: xfer[%d] done?%u:%d trb %x %016lx %x "
1560		         "(err %d) IOC?%d\r\n",
1561		     i, xfer->data[i].processed, xfer->data[i].blen,
1562		     XHCI_TRB_3_TYPE_GET(trbflags), evtrb.qwTrb0,
1563		     trbflags, err,
1564		     trb->dwTrb3 & XHCI_TRB_3_IOC_BIT ? 1 : 0));
1565
1566		if (!xfer->data[i].processed) {
1567			xfer->head = i;
1568			break;
1569		}
1570
1571		xfer->ndata--;
1572		edtla += xfer->data[i].bdone;
1573
1574		trb->dwTrb3 = (trb->dwTrb3 & ~0x1) | (xfer->data[i].ccs);
1575
1576		pci_xhci_update_ep_ring(sc, dev, devep, ep_ctx,
1577		    xfer->data[i].streamid, xfer->data[i].trbnext,
1578		    xfer->data[i].ccs);
1579
1580		/* Only interrupt if IOC or short packet */
1581		if (!(trb->dwTrb3 & XHCI_TRB_3_IOC_BIT) &&
1582		    !((err == XHCI_TRB_ERROR_SHORT_PKT) &&
1583		      (trb->dwTrb3 & XHCI_TRB_3_ISP_BIT))) {
1584
1585			i = (i + 1) % USB_MAX_XFER_BLOCKS;
1586			continue;
1587		}
1588
1589		evtrb.dwTrb2 = XHCI_TRB_2_ERROR_SET(err) |
1590		               XHCI_TRB_2_REM_SET(xfer->data[i].blen);
1591
1592		evtrb.dwTrb3 = XHCI_TRB_3_TYPE_SET(XHCI_TRB_EVENT_TRANSFER) |
1593		    XHCI_TRB_3_SLOT_SET(slot) | XHCI_TRB_3_EP_SET(epid);
1594
1595		if (XHCI_TRB_3_TYPE_GET(trbflags) == XHCI_TRB_TYPE_EVENT_DATA) {
1596			DPRINTF(("pci_xhci EVENT_DATA edtla %u\r\n", edtla));
1597			evtrb.qwTrb0 = trb->qwTrb0;
1598			evtrb.dwTrb2 = (edtla & 0xFFFFF) |
1599			         XHCI_TRB_2_ERROR_SET(err);
1600			evtrb.dwTrb3 |= XHCI_TRB_3_ED_BIT;
1601			edtla = 0;
1602		}
1603
1604		*do_intr = 1;
1605
1606		err = pci_xhci_insert_event(sc, &evtrb, 0);
1607		if (err != XHCI_TRB_ERROR_SUCCESS) {
1608			break;
1609		}
1610
1611		i = (i + 1) % USB_MAX_XFER_BLOCKS;
1612	}
1613
1614	return (err);
1615}
1616
1617static void
1618pci_xhci_update_ep_ring(struct pci_xhci_softc *sc, struct pci_xhci_dev_emu *dev,
1619    struct pci_xhci_dev_ep *devep, struct xhci_endp_ctx *ep_ctx,
1620    uint32_t streamid, uint64_t ringaddr, int ccs)
1621{
1622
1623	if (XHCI_EPCTX_0_MAXP_STREAMS_GET(ep_ctx->dwEpCtx0) != 0) {
1624		devep->ep_sctx[streamid].qwSctx0 = (ringaddr & ~0xFUL) |
1625		                                   (ccs & 0x1);
1626
1627		devep->ep_sctx_trbs[streamid].ringaddr = ringaddr & ~0xFUL;
1628		devep->ep_sctx_trbs[streamid].ccs = ccs & 0x1;
1629		ep_ctx->qwEpCtx2 = (ep_ctx->qwEpCtx2 & ~0x1) | (ccs & 0x1);
1630
1631		DPRINTF(("xhci update ep-ring stream %d, addr %lx\r\n",
1632		    streamid, devep->ep_sctx[streamid].qwSctx0));
1633	} else {
1634		devep->ep_ringaddr = ringaddr & ~0xFUL;
1635		devep->ep_ccs = ccs & 0x1;
1636		devep->ep_tr = XHCI_GADDR(sc, ringaddr & ~0xFUL);
1637		ep_ctx->qwEpCtx2 = (ringaddr & ~0xFUL) | (ccs & 0x1);
1638
1639		DPRINTF(("xhci update ep-ring, addr %lx\r\n",
1640		    (devep->ep_ringaddr | devep->ep_ccs)));
1641	}
1642}
1643
1644/*
1645 * Outstanding transfer still in progress (device NAK'd earlier) so retry
1646 * the transfer again to see if it succeeds.
1647 */
1648static int
1649pci_xhci_try_usb_xfer(struct pci_xhci_softc *sc,
1650    struct pci_xhci_dev_emu *dev, struct pci_xhci_dev_ep *devep,
1651    struct xhci_endp_ctx *ep_ctx, uint32_t slot, uint32_t epid)
1652{
1653	struct usb_data_xfer *xfer;
1654	int		err;
1655	int		do_intr;
1656
1657	ep_ctx->dwEpCtx0 = FIELD_REPLACE(
1658		    ep_ctx->dwEpCtx0, XHCI_ST_EPCTX_RUNNING, 0x7, 0);
1659
1660	err = 0;
1661	do_intr = 0;
1662
1663	xfer = devep->ep_xfer;
1664	USB_DATA_XFER_LOCK(xfer);
1665
1666	/* outstanding requests queued up */
1667	if (dev->dev_ue->ue_data != NULL) {
1668		err = dev->dev_ue->ue_data(dev->dev_sc, xfer,
1669		            epid & 0x1 ? USB_XFER_IN : USB_XFER_OUT, epid/2);
1670		if (err == USB_ERR_CANCELLED) {
1671			if (USB_DATA_GET_ERRCODE(&xfer->data[xfer->head]) ==
1672			    USB_NAK)
1673				err = XHCI_TRB_ERROR_SUCCESS;
1674		} else {
1675			err = pci_xhci_xfer_complete(sc, xfer, slot, epid,
1676			                             &do_intr);
1677			if (err == XHCI_TRB_ERROR_SUCCESS && do_intr) {
1678				pci_xhci_assert_interrupt(sc);
1679			}
1680
1681
1682			/* XXX should not do it if error? */
1683			USB_DATA_XFER_RESET(xfer);
1684		}
1685	}
1686
1687	USB_DATA_XFER_UNLOCK(xfer);
1688
1689
1690	return (err);
1691}
1692
1693
1694static int
1695pci_xhci_handle_transfer(struct pci_xhci_softc *sc,
1696    struct pci_xhci_dev_emu *dev, struct pci_xhci_dev_ep *devep,
1697    struct xhci_endp_ctx *ep_ctx, struct xhci_trb *trb, uint32_t slot,
1698    uint32_t epid, uint64_t addr, uint32_t ccs, uint32_t streamid)
1699{
1700	struct xhci_trb *setup_trb;
1701	struct usb_data_xfer *xfer;
1702	struct usb_data_xfer_block *xfer_block;
1703	uint64_t	val;
1704	uint32_t	trbflags;
1705	int		do_intr, err;
1706	int		do_retry;
1707
1708	ep_ctx->dwEpCtx0 = FIELD_REPLACE(ep_ctx->dwEpCtx0,
1709	                                 XHCI_ST_EPCTX_RUNNING, 0x7, 0);
1710
1711	xfer = devep->ep_xfer;
1712	USB_DATA_XFER_LOCK(xfer);
1713
1714	DPRINTF(("pci_xhci handle_transfer slot %u\r\n", slot));
1715
1716retry:
1717	err = 0;
1718	do_retry = 0;
1719	do_intr = 0;
1720	setup_trb = NULL;
1721
1722	while (1) {
1723		pci_xhci_dump_trb(trb);
1724
1725		trbflags = trb->dwTrb3;
1726
1727		if (XHCI_TRB_3_TYPE_GET(trbflags) != XHCI_TRB_TYPE_LINK &&
1728		    (trbflags & XHCI_TRB_3_CYCLE_BIT) !=
1729		    (ccs & XHCI_TRB_3_CYCLE_BIT)) {
1730			DPRINTF(("Cycle-bit changed trbflags %x, ccs %x\r\n",
1731			    trbflags & XHCI_TRB_3_CYCLE_BIT, ccs));
1732			break;
1733		}
1734
1735		xfer_block = NULL;
1736
1737		switch (XHCI_TRB_3_TYPE_GET(trbflags)) {
1738		case XHCI_TRB_TYPE_LINK:
1739			if (trb->dwTrb3 & XHCI_TRB_3_TC_BIT)
1740				ccs ^= 0x1;
1741
1742			xfer_block = usb_data_xfer_append(xfer, NULL, 0,
1743			                                  (void *)addr, ccs);
1744			xfer_block->processed = 1;
1745			break;
1746
1747		case XHCI_TRB_TYPE_SETUP_STAGE:
1748			if ((trbflags & XHCI_TRB_3_IDT_BIT) == 0 ||
1749			    XHCI_TRB_2_BYTES_GET(trb->dwTrb2) != 8) {
1750				DPRINTF(("pci_xhci: invalid setup trb\r\n"));
1751				err = XHCI_TRB_ERROR_TRB;
1752				goto errout;
1753			}
1754			setup_trb = trb;
1755
1756			val = trb->qwTrb0;
1757			if (!xfer->ureq)
1758				xfer->ureq = malloc(
1759				           sizeof(struct usb_device_request));
1760			memcpy(xfer->ureq, &val,
1761			       sizeof(struct usb_device_request));
1762
1763			xfer_block = usb_data_xfer_append(xfer, NULL, 0,
1764			                                  (void *)addr, ccs);
1765			xfer_block->processed = 1;
1766			break;
1767
1768		case XHCI_TRB_TYPE_NORMAL:
1769		case XHCI_TRB_TYPE_ISOCH:
1770			if (setup_trb != NULL) {
1771				DPRINTF(("pci_xhci: trb not supposed to be in "
1772				         "ctl scope\r\n"));
1773				err = XHCI_TRB_ERROR_TRB;
1774				goto errout;
1775			}
1776			/* fall through */
1777
1778		case XHCI_TRB_TYPE_DATA_STAGE:
1779			xfer_block = usb_data_xfer_append(xfer,
1780			     (void *)(trbflags & XHCI_TRB_3_IDT_BIT ?
1781			         &trb->qwTrb0 : XHCI_GADDR(sc, trb->qwTrb0)),
1782			     trb->dwTrb2 & 0x1FFFF, (void *)addr, ccs);
1783			break;
1784
1785		case XHCI_TRB_TYPE_STATUS_STAGE:
1786			xfer_block = usb_data_xfer_append(xfer, NULL, 0,
1787			                                  (void *)addr, ccs);
1788			break;
1789
1790		case XHCI_TRB_TYPE_NOOP:
1791			xfer_block = usb_data_xfer_append(xfer, NULL, 0,
1792			                                  (void *)addr, ccs);
1793			xfer_block->processed = 1;
1794			break;
1795
1796		case XHCI_TRB_TYPE_EVENT_DATA:
1797			xfer_block = usb_data_xfer_append(xfer, NULL, 0,
1798			                                  (void *)addr, ccs);
1799			if ((epid > 1) && (trbflags & XHCI_TRB_3_IOC_BIT)) {
1800				xfer_block->processed = 1;
1801			}
1802			break;
1803
1804		default:
1805			DPRINTF(("pci_xhci: handle xfer unexpected trb type "
1806			         "0x%x\r\n",
1807			         XHCI_TRB_3_TYPE_GET(trbflags)));
1808			err = XHCI_TRB_ERROR_TRB;
1809			goto errout;
1810		}
1811
1812		trb = pci_xhci_trb_next(sc, trb, &addr);
1813
1814		DPRINTF(("pci_xhci: next trb: 0x%lx\r\n", (uint64_t)trb));
1815
1816		if (xfer_block) {
1817			xfer_block->trbnext = addr;
1818			xfer_block->streamid = streamid;
1819		}
1820
1821		if (!setup_trb && !(trbflags & XHCI_TRB_3_CHAIN_BIT) &&
1822		    XHCI_TRB_3_TYPE_GET(trbflags) != XHCI_TRB_TYPE_LINK) {
1823			break;
1824		}
1825
1826		/* handle current batch that requires interrupt on complete */
1827		if (trbflags & XHCI_TRB_3_IOC_BIT) {
1828			DPRINTF(("pci_xhci: trb IOC bit set\r\n"));
1829			if (epid == 1)
1830				do_retry = 1;
1831			break;
1832		}
1833	}
1834
1835	DPRINTF(("pci_xhci[%d]: xfer->ndata %u\r\n", __LINE__, xfer->ndata));
1836
1837	if (epid == 1) {
1838		err = USB_ERR_NOT_STARTED;
1839		if (dev->dev_ue->ue_request != NULL)
1840			err = dev->dev_ue->ue_request(dev->dev_sc, xfer);
1841		setup_trb = NULL;
1842	} else {
1843		/* handle data transfer */
1844		pci_xhci_try_usb_xfer(sc, dev, devep, ep_ctx, slot, epid);
1845		err = XHCI_TRB_ERROR_SUCCESS;
1846		goto errout;
1847	}
1848
1849	err = USB_TO_XHCI_ERR(err);
1850	if ((err == XHCI_TRB_ERROR_SUCCESS) ||
1851	    (err == XHCI_TRB_ERROR_SHORT_PKT)) {
1852		err = pci_xhci_xfer_complete(sc, xfer, slot, epid, &do_intr);
1853		if (err != XHCI_TRB_ERROR_SUCCESS)
1854			do_retry = 0;
1855	}
1856
1857errout:
1858	if (err == XHCI_TRB_ERROR_EV_RING_FULL)
1859		DPRINTF(("pci_xhci[%d]: event ring full\r\n", __LINE__));
1860
1861	if (!do_retry)
1862		USB_DATA_XFER_UNLOCK(xfer);
1863
1864	if (do_intr)
1865		pci_xhci_assert_interrupt(sc);
1866
1867	if (do_retry) {
1868		USB_DATA_XFER_RESET(xfer);
1869		DPRINTF(("pci_xhci[%d]: retry:continuing with next TRBs\r\n",
1870		         __LINE__));
1871		goto retry;
1872	}
1873
1874	if (epid == 1)
1875		USB_DATA_XFER_RESET(xfer);
1876
1877	return (err);
1878}
1879
1880static void
1881pci_xhci_device_doorbell(struct pci_xhci_softc *sc, uint32_t slot,
1882    uint32_t epid, uint32_t streamid)
1883{
1884	struct pci_xhci_dev_emu *dev;
1885	struct pci_xhci_dev_ep	*devep;
1886	struct xhci_dev_ctx	*dev_ctx;
1887	struct xhci_endp_ctx	*ep_ctx;
1888	struct pci_xhci_trb_ring *sctx_tr;
1889	struct xhci_trb	*trb;
1890	uint64_t	ringaddr;
1891	uint32_t	ccs;
1892
1893	DPRINTF(("pci_xhci doorbell slot %u epid %u stream %u\r\n",
1894	    slot, epid, streamid));
1895
1896	if (slot == 0 || slot > sc->ndevices) {
1897		DPRINTF(("pci_xhci: invalid doorbell slot %u\r\n", slot));
1898		return;
1899	}
1900
1901	dev = XHCI_SLOTDEV_PTR(sc, slot);
1902	devep = &dev->eps[epid];
1903	dev_ctx = pci_xhci_get_dev_ctx(sc, slot);
1904	if (!dev_ctx) {
1905		return;
1906	}
1907	ep_ctx = &dev_ctx->ctx_ep[epid];
1908
1909	sctx_tr = NULL;
1910
1911	DPRINTF(("pci_xhci: device doorbell ep[%u] %08x %08x %016lx %08x\r\n",
1912	        epid, ep_ctx->dwEpCtx0, ep_ctx->dwEpCtx1, ep_ctx->qwEpCtx2,
1913	        ep_ctx->dwEpCtx4));
1914
1915	if (ep_ctx->qwEpCtx2 == 0)
1916		return;
1917
1918	/* handle pending transfers */
1919	if (devep->ep_xfer->ndata > 0) {
1920		pci_xhci_try_usb_xfer(sc, dev, devep, ep_ctx, slot, epid);
1921		return;
1922	}
1923
1924	/* get next trb work item */
1925	if (XHCI_EPCTX_0_MAXP_STREAMS_GET(ep_ctx->dwEpCtx0) != 0) {
1926		sctx_tr = &devep->ep_sctx_trbs[streamid];
1927		ringaddr = sctx_tr->ringaddr;
1928		ccs = sctx_tr->ccs;
1929		trb = XHCI_GADDR(sc, sctx_tr->ringaddr & ~0xFUL);
1930		DPRINTF(("doorbell, stream %u, ccs %lx, trb ccs %x\r\n",
1931		        streamid, ep_ctx->qwEpCtx2 & XHCI_TRB_3_CYCLE_BIT,
1932		        trb->dwTrb3 & XHCI_TRB_3_CYCLE_BIT));
1933	} else {
1934		ringaddr = devep->ep_ringaddr;
1935		ccs = devep->ep_ccs;
1936		trb = devep->ep_tr;
1937		DPRINTF(("doorbell, ccs %lx, trb ccs %x\r\n",
1938		        ep_ctx->qwEpCtx2 & XHCI_TRB_3_CYCLE_BIT,
1939		        trb->dwTrb3 & XHCI_TRB_3_CYCLE_BIT));
1940	}
1941
1942	if (XHCI_TRB_3_TYPE_GET(trb->dwTrb3) == 0) {
1943		DPRINTF(("pci_xhci: ring %lx trb[%lx] EP %u is RESERVED?\r\n",
1944		        ep_ctx->qwEpCtx2, devep->ep_ringaddr, epid));
1945		return;
1946	}
1947
1948	pci_xhci_handle_transfer(sc, dev, devep, ep_ctx, trb, slot, epid,
1949	                         ringaddr, ccs, streamid);
1950}
1951
1952static void
1953pci_xhci_dbregs_write(struct pci_xhci_softc *sc, uint64_t offset,
1954    uint64_t value)
1955{
1956
1957	offset = (offset - sc->dboff) / sizeof(uint32_t);
1958
1959	DPRINTF(("pci_xhci: doorbell write offset 0x%lx: 0x%lx\r\n",
1960	        offset, value));
1961
1962	if (XHCI_HALTED(sc)) {
1963		DPRINTF(("pci_xhci: controller halted\r\n"));
1964		return;
1965	}
1966
1967	if (offset == 0)
1968		pci_xhci_complete_commands(sc);
1969	else if (sc->portregs != NULL)
1970		pci_xhci_device_doorbell(sc, offset,
1971		   XHCI_DB_TARGET_GET(value), XHCI_DB_SID_GET(value));
1972}
1973
1974static void
1975pci_xhci_rtsregs_write(struct pci_xhci_softc *sc, uint64_t offset,
1976    uint64_t value)
1977{
1978	struct pci_xhci_rtsregs *rts;
1979
1980	offset -= sc->rtsoff;
1981
1982	if (offset == 0) {
1983		DPRINTF(("pci_xhci attempted write to MFINDEX\r\n"));
1984		return;
1985	}
1986
1987	DPRINTF(("pci_xhci: runtime regs write offset 0x%lx: 0x%lx\r\n",
1988	        offset, value));
1989
1990	offset -= 0x20;		/* start of intrreg */
1991
1992	rts = &sc->rtsregs;
1993
1994	switch (offset) {
1995	case 0x00:
1996		if (value & XHCI_IMAN_INTR_PEND)
1997			rts->intrreg.iman &= ~XHCI_IMAN_INTR_PEND;
1998		rts->intrreg.iman = (value & XHCI_IMAN_INTR_ENA) |
1999		                    (rts->intrreg.iman & XHCI_IMAN_INTR_PEND);
2000
2001		if (!(value & XHCI_IMAN_INTR_ENA))
2002			pci_xhci_deassert_interrupt(sc);
2003
2004		break;
2005
2006	case 0x04:
2007		rts->intrreg.imod = value;
2008		break;
2009
2010	case 0x08:
2011		rts->intrreg.erstsz = value & 0xFFFF;
2012		break;
2013
2014	case 0x10:
2015		/* ERSTBA low bits */
2016		rts->intrreg.erstba = MASK_64_HI(sc->rtsregs.intrreg.erstba) |
2017		                      (value & ~0x3F);
2018		break;
2019
2020	case 0x14:
2021		/* ERSTBA high bits */
2022		rts->intrreg.erstba = (value << 32) |
2023		    MASK_64_LO(sc->rtsregs.intrreg.erstba);
2024
2025		rts->erstba_p = XHCI_GADDR(sc,
2026		                        sc->rtsregs.intrreg.erstba & ~0x3FUL);
2027
2028		rts->erst_p = XHCI_GADDR(sc,
2029		              sc->rtsregs.erstba_p->qwEvrsTablePtr & ~0x3FUL);
2030
2031		rts->er_enq_idx = 0;
2032		rts->er_events_cnt = 0;
2033
2034		DPRINTF(("pci_xhci: wr erstba erst (%p) ptr 0x%lx, sz %u\r\n",
2035		        rts->erstba_p,
2036		        rts->erstba_p->qwEvrsTablePtr,
2037		        rts->erstba_p->dwEvrsTableSize));
2038		break;
2039
2040	case 0x18:
2041		/* ERDP low bits */
2042		rts->intrreg.erdp =
2043		    MASK_64_HI(sc->rtsregs.intrreg.erdp) |
2044		    (rts->intrreg.erdp & XHCI_ERDP_LO_BUSY) |
2045		    (value & ~0xF);
2046		if (value & XHCI_ERDP_LO_BUSY) {
2047			rts->intrreg.erdp &= ~XHCI_ERDP_LO_BUSY;
2048			rts->intrreg.iman &= ~XHCI_IMAN_INTR_PEND;
2049		}
2050
2051		rts->er_deq_seg = XHCI_ERDP_LO_SINDEX(value);
2052
2053		break;
2054
2055	case 0x1C:
2056		/* ERDP high bits */
2057		rts->intrreg.erdp = (value << 32) |
2058		    MASK_64_LO(sc->rtsregs.intrreg.erdp);
2059
2060		if (rts->er_events_cnt > 0) {
2061			uint64_t erdp;
2062			uint32_t erdp_i;
2063
2064			erdp = rts->intrreg.erdp & ~0xF;
2065			erdp_i = (erdp - rts->erstba_p->qwEvrsTablePtr) /
2066			           sizeof(struct xhci_trb);
2067
2068			if (erdp_i <= rts->er_enq_idx)
2069				rts->er_events_cnt = rts->er_enq_idx - erdp_i;
2070			else
2071				rts->er_events_cnt =
2072				          rts->erstba_p->dwEvrsTableSize -
2073				          (erdp_i - rts->er_enq_idx);
2074
2075			DPRINTF(("pci_xhci: erdp 0x%lx, events cnt %u\r\n",
2076			        erdp, rts->er_events_cnt));
2077		}
2078
2079		break;
2080
2081	default:
2082		DPRINTF(("pci_xhci attempted write to RTS offset 0x%lx\r\n",
2083		        offset));
2084		break;
2085	}
2086}
2087
2088static uint64_t
2089pci_xhci_portregs_read(struct pci_xhci_softc *sc, uint64_t offset)
2090{
2091	int port;
2092	uint32_t *p;
2093
2094	if (sc->portregs == NULL)
2095		return (0);
2096
2097	port = (offset - 0x3F0) / 0x10;
2098
2099	if (port > XHCI_MAX_DEVS) {
2100		DPRINTF(("pci_xhci: portregs_read port %d >= XHCI_MAX_DEVS\r\n",
2101		    port));
2102
2103		/* return default value for unused port */
2104		return (XHCI_PS_SPEED_SET(3));
2105	}
2106
2107	offset = (offset - 0x3F0) % 0x10;
2108
2109	p = &sc->portregs[port].portsc;
2110	p += offset / sizeof(uint32_t);
2111
2112	DPRINTF(("pci_xhci: portregs read offset 0x%lx port %u -> 0x%x\r\n",
2113	        offset, port, *p));
2114
2115	return (*p);
2116}
2117
2118static void
2119pci_xhci_hostop_write(struct pci_xhci_softc *sc, uint64_t offset,
2120    uint64_t value)
2121{
2122	offset -= XHCI_CAPLEN;
2123
2124	if (offset < 0x400)
2125		DPRINTF(("pci_xhci: hostop write offset 0x%lx: 0x%lx\r\n",
2126		         offset, value));
2127
2128	switch (offset) {
2129	case XHCI_USBCMD:
2130		sc->opregs.usbcmd = pci_xhci_usbcmd_write(sc, value & 0x3F0F);
2131		break;
2132
2133	case XHCI_USBSTS:
2134		/* clear bits on write */
2135		sc->opregs.usbsts &= ~(value &
2136		      (XHCI_STS_HSE|XHCI_STS_EINT|XHCI_STS_PCD|XHCI_STS_SSS|
2137		       XHCI_STS_RSS|XHCI_STS_SRE|XHCI_STS_CNR));
2138		break;
2139
2140	case XHCI_PAGESIZE:
2141		/* read only */
2142		break;
2143
2144	case XHCI_DNCTRL:
2145		sc->opregs.dnctrl = value & 0xFFFF;
2146		break;
2147
2148	case XHCI_CRCR_LO:
2149		if (sc->opregs.crcr & XHCI_CRCR_LO_CRR) {
2150			sc->opregs.crcr &= ~(XHCI_CRCR_LO_CS|XHCI_CRCR_LO_CA);
2151			sc->opregs.crcr |= value &
2152			                   (XHCI_CRCR_LO_CS|XHCI_CRCR_LO_CA);
2153		} else {
2154			sc->opregs.crcr = MASK_64_HI(sc->opregs.crcr) |
2155			           (value & (0xFFFFFFC0 | XHCI_CRCR_LO_RCS));
2156		}
2157		break;
2158
2159	case XHCI_CRCR_HI:
2160		if (!(sc->opregs.crcr & XHCI_CRCR_LO_CRR)) {
2161			sc->opregs.crcr = MASK_64_LO(sc->opregs.crcr) |
2162			                  (value << 32);
2163
2164			sc->opregs.cr_p = XHCI_GADDR(sc,
2165			                  sc->opregs.crcr & ~0xF);
2166		}
2167
2168		if (sc->opregs.crcr & XHCI_CRCR_LO_CS) {
2169			/* Stop operation of Command Ring */
2170		}
2171
2172		if (sc->opregs.crcr & XHCI_CRCR_LO_CA) {
2173			/* Abort command */
2174		}
2175
2176		break;
2177
2178	case XHCI_DCBAAP_LO:
2179		sc->opregs.dcbaap = MASK_64_HI(sc->opregs.dcbaap) |
2180		                    (value & 0xFFFFFFC0);
2181		break;
2182
2183	case XHCI_DCBAAP_HI:
2184		sc->opregs.dcbaap =  MASK_64_LO(sc->opregs.dcbaap) |
2185		                     (value << 32);
2186		sc->opregs.dcbaa_p = XHCI_GADDR(sc, sc->opregs.dcbaap & ~0x3FUL);
2187
2188		DPRINTF(("pci_xhci: opregs dcbaap = 0x%lx (vaddr 0x%lx)\r\n",
2189		    sc->opregs.dcbaap, (uint64_t)sc->opregs.dcbaa_p));
2190		break;
2191
2192	case XHCI_CONFIG:
2193		sc->opregs.config = value & 0x03FF;
2194		break;
2195
2196	default:
2197		if (offset >= 0x400)
2198			pci_xhci_portregs_write(sc, offset, value);
2199
2200		break;
2201	}
2202}
2203
2204
2205static void
2206pci_xhci_write(struct vmctx *ctx, int vcpu, struct pci_devinst *pi,
2207                int baridx, uint64_t offset, int size, uint64_t value)
2208{
2209	struct pci_xhci_softc *sc;
2210
2211	sc = pi->pi_arg;
2212
2213	assert(baridx == 0);
2214
2215
2216	pthread_mutex_lock(&sc->mtx);
2217	if (offset < XHCI_CAPLEN)	/* read only registers */
2218		WPRINTF(("pci_xhci: write RO-CAPs offset %ld\r\n", offset));
2219	else if (offset < sc->dboff)
2220		pci_xhci_hostop_write(sc, offset, value);
2221	else if (offset < sc->rtsoff)
2222		pci_xhci_dbregs_write(sc, offset, value);
2223	else if (offset < sc->regsend)
2224		pci_xhci_rtsregs_write(sc, offset, value);
2225	else
2226		WPRINTF(("pci_xhci: write invalid offset %ld\r\n", offset));
2227
2228	pthread_mutex_unlock(&sc->mtx);
2229}
2230
2231static uint64_t
2232pci_xhci_hostcap_read(struct pci_xhci_softc *sc, uint64_t offset)
2233{
2234	uint64_t	value;
2235
2236	switch (offset) {
2237	case XHCI_CAPLENGTH:	/* 0x00 */
2238		value = sc->caplength;
2239		break;
2240
2241	case XHCI_HCSPARAMS1:	/* 0x04 */
2242		value = sc->hcsparams1;
2243		break;
2244
2245	case XHCI_HCSPARAMS2:	/* 0x08 */
2246		value = sc->hcsparams2;
2247		break;
2248
2249	case XHCI_HCSPARAMS3:	/* 0x0C */
2250		value = sc->hcsparams3;
2251		break;
2252
2253	case XHCI_HCSPARAMS0:	/* 0x10 */
2254		value = sc->hccparams1;
2255		break;
2256
2257	case XHCI_DBOFF:	/* 0x14 */
2258		value = sc->dboff;
2259		break;
2260
2261	case XHCI_RTSOFF:	/* 0x18 */
2262		value = sc->rtsoff;
2263		break;
2264
2265	case XHCI_HCCPRAMS2:	/* 0x1C */
2266		value = sc->hccparams2;
2267		break;
2268
2269	default:
2270		value = 0;
2271		break;
2272	}
2273
2274	DPRINTF(("pci_xhci: hostcap read offset 0x%lx -> 0x%lx\r\n",
2275	        offset, value));
2276
2277	return (value);
2278}
2279
2280static uint64_t
2281pci_xhci_hostop_read(struct pci_xhci_softc *sc, uint64_t offset)
2282{
2283	uint64_t value;
2284
2285	offset = (offset - XHCI_CAPLEN);
2286
2287	switch (offset) {
2288	case XHCI_USBCMD:	/* 0x00 */
2289		value = sc->opregs.usbcmd;
2290		break;
2291
2292	case XHCI_USBSTS:	/* 0x04 */
2293		value = sc->opregs.usbsts;
2294		break;
2295
2296	case XHCI_PAGESIZE:	/* 0x08 */
2297		value = sc->opregs.pgsz;
2298		break;
2299
2300	case XHCI_DNCTRL:	/* 0x14 */
2301		value = sc->opregs.dnctrl;
2302		break;
2303
2304	case XHCI_CRCR_LO:	/* 0x18 */
2305		value = sc->opregs.crcr & XHCI_CRCR_LO_CRR;
2306		break;
2307
2308	case XHCI_CRCR_HI:	/* 0x1C */
2309		value = 0;
2310		break;
2311
2312	case XHCI_DCBAAP_LO:	/* 0x30 */
2313		value = sc->opregs.dcbaap & 0xFFFFFFFF;
2314		break;
2315
2316	case XHCI_DCBAAP_HI:	/* 0x34 */
2317		value = (sc->opregs.dcbaap >> 32) & 0xFFFFFFFF;
2318		break;
2319
2320	case XHCI_CONFIG:	/* 0x38 */
2321		value = sc->opregs.config;
2322		break;
2323
2324	default:
2325		if (offset >= 0x400)
2326			value = pci_xhci_portregs_read(sc, offset);
2327		else
2328			value = 0;
2329
2330		break;
2331	}
2332
2333	if (offset < 0x400)
2334		DPRINTF(("pci_xhci: hostop read offset 0x%lx -> 0x%lx\r\n",
2335		        offset, value));
2336
2337	return (value);
2338}
2339
2340static uint64_t
2341pci_xhci_dbregs_read(struct pci_xhci_softc *sc, uint64_t offset)
2342{
2343
2344	/* read doorbell always returns 0 */
2345	return (0);
2346}
2347
2348static uint64_t
2349pci_xhci_rtsregs_read(struct pci_xhci_softc *sc, uint64_t offset)
2350{
2351	uint32_t	value;
2352
2353	offset -= sc->rtsoff;
2354	value = 0;
2355
2356	if (offset == XHCI_MFINDEX) {
2357		value = sc->rtsregs.mfindex;
2358	} else if (offset >= 0x20) {
2359		int item;
2360		uint32_t *p;
2361
2362		offset -= 0x20;
2363		item = offset % 32;
2364
2365		assert(offset < sizeof(sc->rtsregs.intrreg));
2366
2367		p = &sc->rtsregs.intrreg.iman;
2368		p += item / sizeof(uint32_t);
2369		value = *p;
2370	}
2371
2372	DPRINTF(("pci_xhci: rtsregs read offset 0x%lx -> 0x%x\r\n",
2373	        offset, value));
2374
2375	return (value);
2376}
2377
2378static uint64_t
2379pci_xhci_xecp_read(struct pci_xhci_softc *sc, uint64_t offset)
2380{
2381	uint32_t	value;
2382
2383	offset -= sc->regsend;
2384	value = 0;
2385
2386	switch (offset) {
2387	case 0:
2388		/* rev major | rev minor | next-cap | cap-id */
2389		value = (0x02 << 24) | (4 << 8) | XHCI_ID_PROTOCOLS;
2390		break;
2391	case 4:
2392		/* name string = "USB" */
2393		value = 0x20425355;
2394		break;
2395	case 8:
2396		/* psic | proto-defined | compat # | compat offset */
2397		value = ((XHCI_MAX_DEVS/2) << 8) | sc->usb2_port_start;
2398		break;
2399	case 12:
2400		break;
2401	case 16:
2402		/* rev major | rev minor | next-cap | cap-id */
2403		value = (0x03 << 24) | XHCI_ID_PROTOCOLS;
2404		break;
2405	case 20:
2406		/* name string = "USB" */
2407		value = 0x20425355;
2408		break;
2409	case 24:
2410		/* psic | proto-defined | compat # | compat offset */
2411		value = ((XHCI_MAX_DEVS/2) << 8) | sc->usb3_port_start;
2412		break;
2413	case 28:
2414		break;
2415	default:
2416		DPRINTF(("pci_xhci: xecp invalid offset 0x%lx\r\n", offset));
2417		break;
2418	}
2419
2420	DPRINTF(("pci_xhci: xecp read offset 0x%lx -> 0x%x\r\n",
2421	        offset, value));
2422
2423	return (value);
2424}
2425
2426
2427static uint64_t
2428pci_xhci_read(struct vmctx *ctx, int vcpu, struct pci_devinst *pi, int baridx,
2429    uint64_t offset, int size)
2430{
2431	struct pci_xhci_softc *sc;
2432	uint32_t	value;
2433
2434	sc = pi->pi_arg;
2435
2436	assert(baridx == 0);
2437
2438	pthread_mutex_lock(&sc->mtx);
2439	if (offset < XHCI_CAPLEN)
2440		value = pci_xhci_hostcap_read(sc, offset);
2441	else if (offset < sc->dboff)
2442		value = pci_xhci_hostop_read(sc, offset);
2443	else if (offset < sc->rtsoff)
2444		value = pci_xhci_dbregs_read(sc, offset);
2445	else if (offset < sc->regsend)
2446		value = pci_xhci_rtsregs_read(sc, offset);
2447	else if (offset < (sc->regsend + 4*32))
2448		value = pci_xhci_xecp_read(sc, offset);
2449	else {
2450		value = 0;
2451		WPRINTF(("pci_xhci: read invalid offset %ld\r\n", offset));
2452	}
2453
2454	pthread_mutex_unlock(&sc->mtx);
2455
2456	switch (size) {
2457	case 1:
2458		value &= 0xFF;
2459		break;
2460	case 2:
2461		value &= 0xFFFF;
2462		break;
2463	case 4:
2464		value &= 0xFFFFFFFF;
2465		break;
2466	}
2467
2468	return (value);
2469}
2470
2471static void
2472pci_xhci_reset_port(struct pci_xhci_softc *sc, int portn, int warm)
2473{
2474	struct pci_xhci_portregs *port;
2475	struct pci_xhci_dev_emu	*dev;
2476	struct xhci_trb		evtrb;
2477	int	error;
2478
2479	assert(portn <= XHCI_MAX_DEVS);
2480
2481	DPRINTF(("xhci reset port %d\r\n", portn));
2482
2483	port = XHCI_PORTREG_PTR(sc, portn);
2484	dev = XHCI_DEVINST_PTR(sc, portn);
2485	if (dev) {
2486		port->portsc &= ~(XHCI_PS_PLS_MASK | XHCI_PS_PR | XHCI_PS_PRC);
2487		port->portsc |= XHCI_PS_PED |
2488		    XHCI_PS_SPEED_SET(dev->dev_ue->ue_usbspeed);
2489
2490		if (warm && dev->dev_ue->ue_usbver == 3) {
2491			port->portsc |= XHCI_PS_WRC;
2492		}
2493
2494		if ((port->portsc & XHCI_PS_PRC) == 0) {
2495			port->portsc |= XHCI_PS_PRC;
2496
2497			pci_xhci_set_evtrb(&evtrb, portn,
2498			     XHCI_TRB_ERROR_SUCCESS,
2499			     XHCI_TRB_EVENT_PORT_STS_CHANGE);
2500			error = pci_xhci_insert_event(sc, &evtrb, 1);
2501			if (error != XHCI_TRB_ERROR_SUCCESS)
2502				DPRINTF(("xhci reset port insert event "
2503				         "failed\r\n"));
2504		}
2505	}
2506}
2507
2508static void
2509pci_xhci_init_port(struct pci_xhci_softc *sc, int portn)
2510{
2511	struct pci_xhci_portregs *port;
2512	struct pci_xhci_dev_emu	*dev;
2513
2514	port = XHCI_PORTREG_PTR(sc, portn);
2515	dev = XHCI_DEVINST_PTR(sc, portn);
2516	if (dev) {
2517		port->portsc = XHCI_PS_CCS |		/* connected */
2518		               XHCI_PS_PP;		/* port power */
2519
2520		if (dev->dev_ue->ue_usbver == 2) {
2521			port->portsc |= XHCI_PS_PLS_SET(UPS_PORT_LS_POLL) |
2522		               XHCI_PS_SPEED_SET(dev->dev_ue->ue_usbspeed);
2523		} else {
2524			port->portsc |= XHCI_PS_PLS_SET(UPS_PORT_LS_U0) |
2525		               XHCI_PS_PED |		/* enabled */
2526		               XHCI_PS_SPEED_SET(dev->dev_ue->ue_usbspeed);
2527		}
2528
2529		DPRINTF(("Init port %d 0x%x\n", portn, port->portsc));
2530	} else {
2531		port->portsc = XHCI_PS_PLS_SET(UPS_PORT_LS_RX_DET) | XHCI_PS_PP;
2532		DPRINTF(("Init empty port %d 0x%x\n", portn, port->portsc));
2533	}
2534}
2535
2536static int
2537pci_xhci_dev_intr(struct usb_hci *hci, int epctx)
2538{
2539	struct pci_xhci_dev_emu *dev;
2540	struct xhci_dev_ctx	*dev_ctx;
2541	struct xhci_trb		evtrb;
2542	struct pci_xhci_softc	*sc;
2543	struct pci_xhci_portregs *p;
2544	struct xhci_endp_ctx	*ep_ctx;
2545	int	error;
2546	int	dir_in;
2547	int	epid;
2548
2549	dir_in = epctx & 0x80;
2550	epid = epctx & ~0x80;
2551
2552	/* HW endpoint contexts are 0-15; convert to epid based on dir */
2553	epid = (epid * 2) + (dir_in ? 1 : 0);
2554
2555	assert(epid >= 1 && epid <= 31);
2556
2557	dev = hci->hci_sc;
2558	sc = dev->xsc;
2559
2560	/* check if device is ready; OS has to initialise it */
2561	if (sc->rtsregs.erstba_p == NULL ||
2562	    (sc->opregs.usbcmd & XHCI_CMD_RS) == 0 ||
2563	    dev->dev_ctx == NULL)
2564		return (0);
2565
2566	p = XHCI_PORTREG_PTR(sc, hci->hci_port);
2567
2568	/* raise event if link U3 (suspended) state */
2569	if (XHCI_PS_PLS_GET(p->portsc) == 3) {
2570		p->portsc &= ~XHCI_PS_PLS_MASK;
2571		p->portsc |= XHCI_PS_PLS_SET(UPS_PORT_LS_RESUME);
2572		if ((p->portsc & XHCI_PS_PLC) != 0)
2573			return (0);
2574
2575		p->portsc |= XHCI_PS_PLC;
2576
2577		pci_xhci_set_evtrb(&evtrb, hci->hci_port,
2578		      XHCI_TRB_ERROR_SUCCESS, XHCI_TRB_EVENT_PORT_STS_CHANGE);
2579		error = pci_xhci_insert_event(sc, &evtrb, 0);
2580		if (error != XHCI_TRB_ERROR_SUCCESS)
2581			goto done;
2582	}
2583
2584	dev_ctx = dev->dev_ctx;
2585	ep_ctx = &dev_ctx->ctx_ep[epid];
2586	if ((ep_ctx->dwEpCtx0 & 0x7) == XHCI_ST_EPCTX_DISABLED) {
2587		DPRINTF(("xhci device interrupt on disabled endpoint %d\r\n",
2588		         epid));
2589		return (0);
2590	}
2591
2592	DPRINTF(("xhci device interrupt on endpoint %d\r\n", epid));
2593
2594	pci_xhci_device_doorbell(sc, hci->hci_port, epid, 0);
2595
2596done:
2597	return (error);
2598}
2599
2600static int
2601pci_xhci_dev_event(struct usb_hci *hci, enum hci_usbev evid, void *param)
2602{
2603
2604	DPRINTF(("xhci device event port %d\r\n", hci->hci_port));
2605	return (0);
2606}
2607
2608
2609
2610static void
2611pci_xhci_device_usage(char *opt)
2612{
2613
2614	fprintf(stderr, "Invalid USB emulation \"%s\"\r\n", opt);
2615}
2616
2617static int
2618pci_xhci_parse_opts(struct pci_xhci_softc *sc, char *opts)
2619{
2620	struct pci_xhci_dev_emu	**devices;
2621	struct pci_xhci_dev_emu	*dev;
2622	struct usb_devemu	*ue;
2623	void	*devsc;
2624	char	*uopt, *xopts, *config;
2625	int	usb3_port, usb2_port, i;
2626
2627	usb3_port = sc->usb3_port_start - 1;
2628	usb2_port = sc->usb2_port_start - 1;
2629	devices = NULL;
2630
2631	if (opts == NULL)
2632		goto portsfinal;
2633
2634	devices = calloc(XHCI_MAX_DEVS, sizeof(struct pci_xhci_dev_emu *));
2635
2636	sc->slots = calloc(XHCI_MAX_SLOTS, sizeof(struct pci_xhci_dev_emu *));
2637	sc->devices = devices;
2638	sc->ndevices = 0;
2639
2640	uopt = strdup(opts);
2641	for (xopts = strtok(uopt, ",");
2642	     xopts != NULL;
2643	     xopts = strtok(NULL, ",")) {
2644		if (usb2_port == ((sc->usb2_port_start-1) + XHCI_MAX_DEVS/2) ||
2645		    usb3_port == ((sc->usb3_port_start-1) + XHCI_MAX_DEVS/2)) {
2646			WPRINTF(("pci_xhci max number of USB 2 or 3 "
2647			     "devices reached, max %d\r\n", XHCI_MAX_DEVS/2));
2648			usb2_port = usb3_port = -1;
2649			goto done;
2650		}
2651
2652		/* device[=<config>] */
2653		if ((config = strchr(xopts, '=')) == NULL)
2654			config = "";		/* no config */
2655		else
2656			*config++ = '\0';
2657
2658		ue = usb_emu_finddev(xopts);
2659		if (ue == NULL) {
2660			pci_xhci_device_usage(xopts);
2661			DPRINTF(("pci_xhci device not found %s\r\n", xopts));
2662			usb2_port = usb3_port = -1;
2663			goto done;
2664		}
2665
2666		DPRINTF(("pci_xhci adding device %s, opts \"%s\"\r\n",
2667		        xopts, config));
2668
2669		dev = calloc(1, sizeof(struct pci_xhci_dev_emu));
2670		dev->xsc = sc;
2671		dev->hci.hci_sc = dev;
2672		dev->hci.hci_intr = pci_xhci_dev_intr;
2673		dev->hci.hci_event = pci_xhci_dev_event;
2674
2675		if (ue->ue_usbver == 2) {
2676			dev->hci.hci_port = usb2_port + 1;
2677			devices[usb2_port] = dev;
2678			usb2_port++;
2679		} else {
2680			dev->hci.hci_port = usb3_port + 1;
2681			devices[usb3_port] = dev;
2682			usb3_port++;
2683		}
2684
2685		dev->hci.hci_address = 0;
2686		devsc = ue->ue_init(&dev->hci, config);
2687		if (devsc == NULL) {
2688			pci_xhci_device_usage(xopts);
2689			usb2_port = usb3_port = -1;
2690			goto done;
2691		}
2692
2693		dev->dev_ue = ue;
2694		dev->dev_sc = devsc;
2695
2696		/* assign slot number to device */
2697		sc->slots[sc->ndevices] = dev;
2698
2699		sc->ndevices++;
2700	}
2701
2702portsfinal:
2703	sc->portregs = calloc(XHCI_MAX_DEVS, sizeof(struct pci_xhci_portregs));
2704
2705	if (sc->ndevices > 0) {
2706		/* port and slot numbering start from 1 */
2707		sc->devices--;
2708		sc->portregs--;
2709		sc->slots--;
2710
2711		for (i = 1; i <= XHCI_MAX_DEVS; i++) {
2712			pci_xhci_init_port(sc, i);
2713		}
2714	} else {
2715		WPRINTF(("pci_xhci no USB devices configured\r\n"));
2716		sc->ndevices = 1;
2717	}
2718
2719done:
2720	if (devices != NULL) {
2721		if (usb2_port <= 0 && usb3_port <= 0) {
2722			sc->devices = NULL;
2723			for (i = 0; devices[i] != NULL; i++)
2724				free(devices[i]);
2725			sc->ndevices = -1;
2726
2727			free(devices);
2728		}
2729	}
2730	return (sc->ndevices);
2731}
2732
2733static int
2734pci_xhci_init(struct vmctx *ctx, struct pci_devinst *pi, char *opts)
2735{
2736	struct pci_xhci_softc *sc;
2737	int	error;
2738
2739	if (xhci_in_use) {
2740		WPRINTF(("pci_xhci controller already defined\r\n"));
2741		return (-1);
2742	}
2743	xhci_in_use = 1;
2744
2745	sc = calloc(1, sizeof(struct pci_xhci_softc));
2746	pi->pi_arg = sc;
2747	sc->xsc_pi = pi;
2748
2749	sc->usb2_port_start = (XHCI_MAX_DEVS/2) + 1;
2750	sc->usb3_port_start = 1;
2751
2752	/* discover devices */
2753	error = pci_xhci_parse_opts(sc, opts);
2754	if (error < 0)
2755		goto done;
2756	else
2757		error = 0;
2758
2759	sc->caplength = XHCI_SET_CAPLEN(XHCI_CAPLEN) |
2760	                XHCI_SET_HCIVERSION(0x0100);
2761	sc->hcsparams1 = XHCI_SET_HCSP1_MAXPORTS(XHCI_MAX_DEVS) |
2762	                 XHCI_SET_HCSP1_MAXINTR(1) |	/* interrupters */
2763	                 XHCI_SET_HCSP1_MAXSLOTS(XHCI_MAX_SLOTS);
2764	sc->hcsparams2 = XHCI_SET_HCSP2_ERSTMAX(XHCI_ERST_MAX) |
2765	                 XHCI_SET_HCSP2_IST(0x04);
2766	sc->hcsparams3 = 0;				/* no latency */
2767	sc->hccparams1 = XHCI_SET_HCCP1_NSS(1) |	/* no 2nd-streams */
2768	                 XHCI_SET_HCCP1_SPC(1) |	/* short packet */
2769	                 XHCI_SET_HCCP1_MAXPSA(XHCI_STREAMS_MAX);
2770	sc->hccparams2 = XHCI_SET_HCCP2_LEC(1) |
2771	                 XHCI_SET_HCCP2_U3C(1);
2772	sc->dboff = XHCI_SET_DOORBELL(XHCI_CAPLEN + XHCI_PORTREGS_START +
2773	            XHCI_MAX_DEVS * sizeof(struct pci_xhci_portregs));
2774
2775	/* dboff must be 32-bit aligned */
2776	if (sc->dboff & 0x3)
2777		sc->dboff = (sc->dboff + 0x3) & ~0x3;
2778
2779	/* rtsoff must be 32-bytes aligned */
2780	sc->rtsoff = XHCI_SET_RTSOFFSET(sc->dboff + (XHCI_MAX_SLOTS+1) * 32);
2781	if (sc->rtsoff & 0x1F)
2782		sc->rtsoff = (sc->rtsoff + 0x1F) & ~0x1F;
2783
2784	DPRINTF(("pci_xhci dboff: 0x%x, rtsoff: 0x%x\r\n", sc->dboff,
2785	        sc->rtsoff));
2786
2787	sc->opregs.usbsts = XHCI_STS_HCH;
2788	sc->opregs.pgsz = XHCI_PAGESIZE_4K;
2789
2790	pci_xhci_reset(sc);
2791
2792	sc->regsend = sc->rtsoff + 0x20 + 32;		/* only 1 intrpter */
2793
2794	/*
2795	 * Set extended capabilities pointer to be after regsend;
2796	 * value of xecp field is 32-bit offset.
2797	 */
2798	sc->hccparams1 |= XHCI_SET_HCCP1_XECP(sc->regsend/4);
2799
2800	pci_set_cfgdata16(pi, PCIR_DEVICE, 0x1E31);
2801	pci_set_cfgdata16(pi, PCIR_VENDOR, 0x8086);
2802	pci_set_cfgdata8(pi, PCIR_CLASS, PCIC_SERIALBUS);
2803	pci_set_cfgdata8(pi, PCIR_SUBCLASS, PCIS_SERIALBUS_USB);
2804	pci_set_cfgdata8(pi, PCIR_PROGIF,PCIP_SERIALBUS_USB_XHCI);
2805	pci_set_cfgdata8(pi, PCI_USBREV, PCI_USB_REV_3_0);
2806
2807	pci_emul_add_msicap(pi, 1);
2808
2809	/* regsend + xecp registers */
2810	pci_emul_alloc_bar(pi, 0, PCIBAR_MEM32, sc->regsend + 4*32);
2811	DPRINTF(("pci_xhci pci_emu_alloc: %d\r\n", sc->regsend + 4*32));
2812
2813
2814	pci_lintr_request(pi);
2815
2816	pthread_mutex_init(&sc->mtx, NULL);
2817
2818done:
2819	if (error) {
2820		free(sc);
2821	}
2822
2823	return (error);
2824}
2825
2826
2827
2828struct pci_devemu pci_de_xhci = {
2829	.pe_emu =	"xhci",
2830	.pe_init =	pci_xhci_init,
2831	.pe_barwrite =	pci_xhci_write,
2832	.pe_barread =	pci_xhci_read
2833};
2834PCI_EMUL_SET(pci_de_xhci);
2835