From 54409d193fd34ce6224888e3cd69ad019a6f5070 Mon Sep 17 00:00:00 2001 From: Phil Mueller Date: Tue, 19 Jan 2021 19:33:24 -0500 Subject: [PATCH 1/4] GUI: Add submit-mouse-normalized interface. Add a mouse event interface for use by HIDs that give coordinates in absolute terms. The HID values are normalized to be between 0 and 1 by dividing the reported values by the maximum values. These normalized values are then translated in the GUI code into display values by multiplying by the display dimensions as appropriate. --- gui/compositor.lisp | 9 +++++++++ gui/package.lisp | 1 + 2 files changed, 10 insertions(+) diff --git a/gui/compositor.lisp b/gui/compositor.lisp index 4c1db05d9..ab4f28994 100644 --- a/gui/compositor.lisp +++ b/gui/compositor.lisp @@ -634,6 +634,15 @@ so that windows can notice when they lose their mouse visibility.") :x-position x-position :y-position y-position))) +(defun submit-mouse-normalized (x-position y-position &key buttons) + "Submit a mouse event into the input system using positions as a fraction of screen width and height." + (multiple-value-bind (width height) (screen-dimensions) + (submit-compositor-event + (make-instance 'mouse-event + :button-state buttons + :x-position (floor (* width x-position)) + :y-position (floor (* height y-position)))))) + (defun global-mouse-state () "Fetch the current mouse state." (values *mouse-buttons* *mouse-x* *mouse-y*)) diff --git a/gui/package.lisp b/gui/package.lisp index c15bd9f01..75e3bcdfb 100644 --- a/gui/package.lisp +++ b/gui/package.lisp @@ -73,6 +73,7 @@ #:mouse-y-motion #:submit-mouse #:submit-mouse-absolute + #:submit-mouse-normalized #:global-mouse-state #:make-window #:window-create-event From 1fcf8b9f66bdfb30c8ee863a1a0d010a542f18fb Mon Sep 17 00:00:00 2001 From: Phil Mueller Date: Tue, 19 Jan 2021 19:39:50 -0500 Subject: [PATCH 2/4] USB: Update USB probe code and rewrite/reorganize the HID driver. The previous code quit searching for a driver when a probe failure used the throw mechanism to exit. This update to the USB probe code allows the search for a driver to continue after the throw mechanism is used. This change also required changing all of the calls of (throw :probe-failed NIL) to (throw :probe-failed :failed) so that the throw path can be distinguished from the normal failure exit of returning NIL. The HID driver was restructured to move the HID mouse driver to hid-mouse.lisp and the HID keyboard driver stub to hid-keyboard.lisp. (hid-keyboard.lisp contains a stub driver which contains no real functionality.) In addition, the HID report parser was re-written to more completely and correctly parse the HID report and the HID mouse driver was re-written to use this new parser output. These are major re-writes and comparison with the previous code is probably not useful. --- drivers/usb/hid-debug.lisp | 1 + drivers/usb/hid-keyboard.lisp | 36 ++ drivers/usb/hid-mouse.lisp | 551 ++++++++++++++++++ drivers/usb/hid.lisp | 1003 +++++++++------------------------ drivers/usb/mass-storage.lisp | 20 +- drivers/usb/mezzano-usb.asd | 2 + drivers/usb/packages.lisp | 3 +- drivers/usb/usb-driver.lisp | 194 ++++--- 8 files changed, 959 insertions(+), 851 deletions(-) create mode 100644 drivers/usb/hid-keyboard.lisp create mode 100644 drivers/usb/hid-mouse.lisp diff --git a/drivers/usb/hid-debug.lisp b/drivers/usb/hid-debug.lisp index 916abc6ee..2a2de3260 100644 --- a/drivers/usb/hid-debug.lisp +++ b/drivers/usb/hid-debug.lisp @@ -84,6 +84,7 @@ type tag data + #+nil (get-page-entry (parse-state-value state :page) data))) ((and (eq type :main) (eq tag :collection)) (format stream "~A ~A ~A (~A)~%" diff --git a/drivers/usb/hid-keyboard.lisp b/drivers/usb/hid-keyboard.lisp new file mode 100644 index 000000000..87aba7b7f --- /dev/null +++ b/drivers/usb/hid-keyboard.lisp @@ -0,0 +1,36 @@ +;;;; Copyright (c) 2019, 2020 Philip Mueller (phil.mueller@fittestbits.com) +;;;; This code is licensed under the MIT license. + +(in-package :mezzano.driver.usb.hid) + +;;====================================================================== +;; HID Keyboard Driver +;;====================================================================== + +(defun generate-keyboard-buf-code (state) + ;; TODO create generate-keyboard-buf-code + (values nil nil)) + + +(defun probe-hid-keyboard (usbd device configs state) + (let ((endpoint (make-hid-endpt :type :keyboard))) + (let ((endpt-desc (pop configs))) + (when (or (null endpt-desc) + (/= (aref endpt-desc +ed-type+) +desc-type-endpoint+)) + (sup:debug-print-line "HID probe failed because " + "found descriptor type " + (aref endpt-desc +ed-type+) + " instead of endpoint descriptor.") + (throw :probe-failed :failed)) + ;; TODO write keyboard-int-callback + #+nil + (let ((endpt-num (parse-endpt-descriptor usbd + endpoint + device + endpt-desc + 'keyboard-int-callback))) + (setf (aref (hid-driver-endpoints driver) endpt-num) endpoint)))) + ;; Return NIL - this driver not implemented + (values configs nil)) + +(register-hid-device-function :keyboard 'probe-hid-keyboard) diff --git a/drivers/usb/hid-mouse.lisp b/drivers/usb/hid-mouse.lisp new file mode 100644 index 000000000..aca95f2c7 --- /dev/null +++ b/drivers/usb/hid-mouse.lisp @@ -0,0 +1,551 @@ +;;;; Copyright (c) 2019, 2020, 2021 Philip Mueller (phil.mueller@fittestbits.com) +;;;; This code is licensed under the MIT license. + +(in-package :mezzano.driver.usb.hid) + +;;====================================================================== +;; Mouse event interrupt handler +;; ====================================================================== +(defvar *mouse-ints* NIL) ;; for debug + +(defun mouse-int-callback (driver endpoint-num status length buf) + (unwind-protect + (cond ((eq status :success) + (let ((endpoint (aref (hid-driver-endpoints driver) endpoint-num))) + (funcall (hid-endpt-function endpoint) length buf))) + (T + (format sys.int::*cold-stream* + "Interrupt error ~A on endpoint number ~D~%" + status endpoint-num) + (with-trace-level (1) + (format sys.int::*cold-stream* + "length: ~D~%buf: ~S~%" length buf)))) + (with-trace-level (7) + (push (format nil "~D: ~A" length buf) *mouse-ints*)) + (free-buffer buf))) + +;;====================================================================== +;; +;; At some point these variables (*threshold* and *multiplier*) and +;; the function (adjust-motion) should be settable from a user +;; configuration GUI so that users can customize their pointer's +;; operation. (Of course the (declaim (inline ...)) will have to be +;; removed. Aug. 11, 2019 +;; +;;====================================================================== + +(defvar *threshold* 50) +(defvar *multiplier* 3) + +(declaim (inline adjust-motion)) + +(defun adjust-motion (motion) + (cond ((>= motion *threshold*) + (- (* *multiplier* motion) (* (1- *multiplier*) *threshold*))) + ((>= motion (- *threshold*)) + motion) + (T + (+ (* *multiplier* motion) (* (1- *multiplier*) *threshold*))))) + +;; submit mouse function name, compositor package not defined when +;; drivers are loaded, generate the symbol at first hid mouse probe +(defvar *submit-mouse* nil) +(defvar *submit-mouse-normalized* nil) + +;;====================================================================== +;; relative-mouse-event and normalized-mouse-event are optimized for +;; time over space/code commonality. These functions are called from +;; the function generated below based on the mouse report descriptor. +;; ====================================================================== +(defun relative-mouse-event (buttons x-motion y-motion wheel-motion) + (with-trace-level (7) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "relative mouse event: ~D ~D ~D ~D~%" + buttons x-motion y-motion wheel-motion)) + (cond ((= wheel-motion 0) + (funcall *submit-mouse* buttons + (adjust-motion x-motion) (adjust-motion y-motion))) + (T + (if (> wheel-motion 0) + (funcall *submit-mouse* (logior buttons #b00001000) + (adjust-motion x-motion) (adjust-motion y-motion)) + (funcall *submit-mouse* (logior buttons #b00010000) + (adjust-motion x-motion) (adjust-motion y-motion))) + ;; button up event for buttons 4 and 5 + (funcall *submit-mouse* buttons 0 0)))) + +(defun normalized-mouse-event (buttons x-motion y-motion wheel-motion) + (with-trace-level (7) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "normalized mouse event: ~D ~D ~D ~D~%" + buttons x-motion y-motion wheel-motion)) + (cond ((= wheel-motion 0) + (funcall *submit-mouse-normalized* x-motion y-motion :buttons buttons)) + (T + ;; The qemu tablet report includes a wheel field, so include + ;; this code, but tablets with multitouch probably don't use + ;; a wheel field, and so multitouch is not supported by this + ;; HID mouse driver + (if (> wheel-motion 0) + (funcall *submit-mouse-normalized* x-motion y-motion + :buttons (logior buttons #b00001000)) + (funcall *submit-mouse-normalized* x-motion y-motion + :buttons (logior buttons #b00010000))) + (funcall *submit-mouse-normalized* x-motion y-motion + :buttons buttons)))) + +;;====================================================================== +;; Use the parsed report descriptor to generate a function that +;; extracts the buttons state, x motion, y motion and wheel motion +;; from a report buffer and calls either realtive-mouse-event or +;; absolute-mouse-event with those values. +;; ====================================================================== + +;;====================================================================== +;; Code to convert parsed report descriptor to list of field +;; descriptions +;; ====================================================================== + +(defun convert-input-field (field bit-offset button-number) + (let ((count (getf field :count)) + (size (getf field :size)) + (type (getf field :type)) + (%button-number 0)) + (values + (cond ((member :constant type) + () + #+nil ;; Are ignore fields needed? The generated code + ;; shouldn't depend on them. + (let ((num-bits (* count size))) + `((:ignore :number-bits ,num-bits + :byte-offset ,(ash bit-offset -3) + :bit-offset ,(logand bit-offset #x07))))) + ((= size 1) + ;; assume 1-bit fields are buttons + (let ((usage-count (length (getf field :usage)))) + (cond ((= usage-count count) + (loop + repeat count + for %bit-offset = bit-offset then + (incf %bit-offset) + for usages = (getf field :usage) then (cdr usages) + for usage = (car usages) + collect + `(,usage :number-bits 1 + :type :variable + :byte-offset ,(ash %bit-offset -3) + :bit-offset ,(logand %bit-offset #x07)))) + (T + (loop + for button-num from + (+ (or (getf field :usage-minimum) 1) + button-number) to + (+ (or (getf field :usage-maximum) count) + button-number) + for %bit-offset = bit-offset then + (incf %bit-offset) + do + (incf %button-number) + collect + `(,(intern (format nil "BUTTON~D" button-num) + :keyword) + :number-bits 1 + :type :variable + :byte-offset ,(ash %bit-offset -3) + :bit-offset ,(logand %bit-offset #x07))))))) + ((member :array type) + ;; assume array fields are buttons + (let ((usage-count (length (getf field :usage)))) + (cond ((= usage-count count) + (loop + repeat count + for %bit-offset = bit-offset then + (incf %bit-offset size) + for usages = (getf field :usage) then (cdr usages) + for usage = (car usages) + collect + `(,usage :number-bits ,size + :type :array + :byte-offset ,(ash %bit-offset -3) + :bit-offset ,(logand %bit-offset #x07)))) + (T + (loop + for button-num from (1+ button-number) to + (+ count button-number) + for %bit-offset = bit-offset then + (incf %bit-offset size) + do + (incf %button-number) + collect + `(,(intern (format nil "BUTTON~D" button-num) + :keyword) + :number-bits ,size + :type :array + :byte-offset ,(ash %bit-offset -3) + :bit-offset ,(logand %bit-offset #x07) + ,@(if (getf field :usage) + (list :usage (getf field :usage)) + (list :min (getf field :logical-minimum) + :max (getf field :logical-maximum))))))))) + (T + (loop + repeat count + for usages = (getf field :usage) then (cdr usages) + for usage = (car usages) + for %bit-offset = bit-offset then (incf %bit-offset size) + collect `(,usage + :number-bits ,size + :type :variable + :min ,(getf field :logical-minimum) + :max ,(getf field :logical-maximum) + :relative ,(null (member :absolute type)) + :byte-offset ,(ash %bit-offset -3) + :bit-offset ,(logand %bit-offset #x07))))) + (incf bit-offset (* count size)) + (+ button-number %button-number)))) + +(defun convert-collection (collection bit-offset button-number) + (loop + for (key value) on collection by #'cddr + with application-id = nil + with report-id = nil + with fields = (list nil) + do + (case key + (:application + (setf application-id value)) + (:report-id + (when (/= bit-offset 0) + #+mezzano + (sup:debug-print-line + "HID mouse probe failed because report id came after first field") + ;; TODO - print error message + (throw :probe-failed :failed)) + (setf report-id value + bit-offset 8)) + (:input + (multiple-value-bind (field %bit-offset %button-number) + (convert-input-field value bit-offset button-number) + (setf bit-offset %bit-offset) + (setf button-number %button-number) + (nconc fields field))) + (:feature + (let ((num-bits (* (getf value :count) (getf value :size)))) + #+nil ;; Are ignore fields needed? The generated code + ;; shouldn't depend on them + (nconc fields `((:ignore :number-bits ,num-bits + :byte-offset ,(ash bit-offset -3) + :bit-offset ,(logand bit-offset #x07)))) + (incf bit-offset num-bits))) + (:collection + (multiple-value-bind (%report-id %application-id %fields %bit-offset) + (convert-collection value bit-offset button-number) + (when %report-id + (setf report-id %report-id)) + (when %application-id + (setf application-id %application-id)) + (nconc fields %fields) + (setf bit-offset %bit-offset)))) + finally + (return (values report-id application-id (cdr fields) bit-offset)))) + +;;====================================================================== +;; Code to convert list(s) of field descriptions to a function that +;; extracts the required info and calls either relative-mouse-event or +;; absolute-mouse-event +;; ====================================================================== + +(defun fields-absolute-p (fields) + (let* ((field-x (cdr (assoc :x fields))) + (field-x-relative (getf field-x :relative)) + (field-y (cdr (assoc :y fields))) + (field-y-relative (getf field-y :relative))) + (cond ((and field-x-relative field-y-relative) + ;; common case - both x and y relative + NIL) + ((null field-x) + #+mezzano + (sup:debug-print-line "HID mouse probe failed because no :X field") + (throw :probe-failed :failed)) + ((null field-y) + #+mezzano + (sup:debug-print-line "HID mouse probe failed because no :Y field") + (throw :probe-failed :failed)) + ((and (null field-x-relative) (null field-y-relative)) + ;; both fields absolute + T) + (T + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID mouse probe failed because :X relative ~A does not ~ + match :Y relative ~A~%" + field-x-relative field-y-relative) + (throw :probe-failed :failed))))) + +(defun generate-button-code (fields offset-var) + (labels ((buf-offset (offset) + (if offset-var `(+ ,offset ,offset-var) offset)) + (optimum-case (button mask) + (if (= (getf button :bit-offset) 0) + `(logand + (aref buf ,(buf-offset (getf button :byte-offset))) + ,mask) + `(logand + (ash (aref buf ,(buf-offset (getf button :byte-offset))) + ,(- (getf button :bit-offset))) + ,mask))) + (get-button (button offset) + (when button + `((logand (ash (aref buf ,(buf-offset (getf button :byte-offset))) + ,(- offset (getf button :bit-offset))) + ,(ash 1 offset)))))) + (let ((button1 (cdr (assoc :button1 fields))) + (button2 (cdr (assoc :button2 fields))) + (button3 (cdr (assoc :button3 fields)))) + (when (or (and button1 (not (eq (getf button1 :number-bits) 1))) + (and button2 (not (eq (getf button1 :number-bits) 1))) + (and button3 (not (eq (getf button1 :number-bits) 1)))) + #+mezzano + (sup:debug-print-line + "HID mouse probe failed, multibit buttons not supported") + (throw :probe-failed :failed)) + (cond (;; three button mouse + (and button1 button2 button3 + ;; all in the same byte + (= (getf button1 :byte-offset) + (getf button2 :byte-offset) + (getf button3 :byte-offset)) + ;; bits bits are sequential + (= (+ (getf button1 :bit-offset) 2) + (+ (getf button2 :bit-offset) 1) + (getf button3 :bit-offset))) + ;; optimum case - 3 sequentail bits + (optimum-case button1 #x07)) + (;; two button mouse + (and button1 button2 (null button3) + ;; all in the same byte + (= (getf button1 :byte-offset) + (getf button2 :byte-offset)) + ;; bits bits are sequential + (= (+ (getf button1 :bit-offset) 1) + (getf button2 :bit-offset))) + ;; optimum case - 2 sequentail bits + (optimum-case button1 #x03)) + (;; one button mouse + (and button1 (null button2) (null button3)) + (optimum-case button1 #x01)) + (;; treat each button separately + T + `(logior ,@(get-button button1 0) + ,@(get-button button2 1) + ,@(get-button button3 2))))))) + +(defun generate-field-value-code (fields name offset-var required-p) + (labels ((buf-offset (offset) + (if offset-var `(+ ,offset ,offset-var) offset)) + (get-partial-byte (byte-offset bit-offset size) + `(logand (ash (aref buf ,(buf-offset byte-offset)) ,(- bit-offset)) + ,(1- (ash 1 size)))) + (accessor-code (fields) + (let ((byte-offset (getf fields :byte-offset)) + (bit-offset (getf fields :bit-offset)) + (size (getf fields :number-bits))) + (when (not (and byte-offset bit-offset size)) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID mouse probe failed because ~ + a required field is undefined: ~A ~A ~A.~%" + byte-offset bit-offset size) + (throw :probe-failed :failed)) + (cond ((and (= bit-offset 0) (= size 8)) + ;; just use the array value + `(aref buf ,(buf-offset byte-offset))) + ((and (= bit-offset 0) (< size 8)) + ;; just mask off value + `(logand (aref buf ,(buf-offset byte-offset)) + ,(1- (ash 1 size)))) + ((<= (+ bit-offset size) 8) + ;; Shift and mask off value + (get-partial-byte byte-offset bit-offset size)) + ((and (= bit-offset 0) (= size 16)) + ;; combine two full bytes + `(logior + (aref buf ,(buf-offset byte-offset)) + (ash (aref buf ,(buf-offset (1+ byte-offset))) 8))) + ((and (= bit-offset 0) (< size 16)) + `(logior + (aref buf ,(buf-offset byte-offset)) + (ash (logand (aref buf ,(buf-offset (1+ byte-offset))) + ,(1- (ash 1 (- size 8)))) + 8))) + ((<= (+ bit-offset size) 16) + ;; combine two partial bytes + (let* ((first-bits (- 8 bit-offset)) + (second-bits (- size first-bits))) + `(logior + ,(get-partial-byte byte-offset bit-offset first-bits) + (ash ,(if (= second-bits 8) + `(aref buf ,(buf-offset (1+ byte-offset))) + `(logand + (aref buf ,(buf-offset (1+ byte-offset))) + ,(1- (ash 1 second-bits)))) + ,first-bits)))) + ((<= size 16) + ;; combine two paritial bytes and one full byte + (let* ((first-bits (- 8 bit-offset)) + (last-shift (+ first-bits 8)) + (last-bits (- size last-shift))) + `(logior + ,(get-partial-byte byte-offset bit-offset first-bits) + (ash (aref buf ,(buf-offset (1+ byte-offset))) + ,first-bits) + (ash (logand (aref buf ,(buf-offset (+ 2 byte-offset))) + ,(1- (ash 1 last-bits))) + ,last-shift)))) + (T + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID mouse probe failed because ~ + field ~A with size ~D bits not supported." + name size) + (throw :probe-failed :failed)))))) + (let ((fields (cdr (assoc name fields)))) + (cond ((null fields) + (when required-p + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID mouse probe failed because field ~S is undefined.~%" + name) + (throw :probe-failed :failed)) + 0) + (T + (let ((field-value (accessor-code fields)) + (bits (getf fields :number-bits)) + (min (getf fields :min)) + (max (getf fields :max)) + (sym (gensym "X-"))) + ;; if msb of min is 1 and msb of max is 0, assume field + ;; is signed. + (if (and (logbitp (1- bits) min) (not (logbitp (1- bits) max))) + `(let ((,sym ,field-value)) + (if (logbitp ,(1- bits) ,sym) + (- (1+ (logxor ,(1- (ash 1 bits)) ,sym))) + ,sym)) + ;; usigned - assume that means absolute, so normalize + `(/ ,field-value ,max)))))))) + +(defun simple-report-code (report) + (let* ((fields (caddr report))) + `(lambda (length buf) + (loop + with offset = 0 + when (>= offset length) do + (return) + do + (,(if (fields-absolute-p fields) + 'normalized-mouse-event + 'relative-mouse-event) + ,(generate-button-code fields 'offset) + ,(generate-field-value-code fields :x 'offset T) + ,(generate-field-value-code fields :y 'offset T) + ,(generate-field-value-code fields :wheel 'offset NIL)) + (incf offset ,(/ (cadddr report) 8)))))) + +(defun generate-case-clauses (reports) + (let* ((num-mouse-reports 0) + (clauses + (loop + for report in reports + for fields = (caddr report) + collect + `(,(car report) + ,@(when (eq (cadr report) :mouse) + (incf num-mouse-reports) + `((,(if (fields-absolute-p fields) + 'normalized-mouse-event + 'relative-mouse-event) + ,(generate-button-code fields 'offset) + ,(generate-field-value-code fields :x 'offset T) + ,(generate-field-value-code fields :y 'offset T) + ,(generate-field-value-code fields :wheel 'offset NIL)))) + (incf offset ,(/ (cadddr report) 8)))))) + (when (/= num-mouse-reports 1) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID mouse probe failed because ~ + report descritor contained ~D mouse reports~%" + num-mouse-reports) + (throw :probe-failed :failed)) + clauses)) + +(defun multiple-report-code (reports) + `(lambda (length buf) + (loop + with offset = 0 + when (>= offset length) do + (return) + do + (case (aref buf offset) + ,@(generate-case-clauses reports))))) + +(defun compute-buf-size (reports) + (let ((size (/ (loop for report in reports sum (cadddr report)) 8))) + (if (> size 64) + size + (* (1+ (floor 64 size)) size)))) + +(defun generate-mouse-buf-code (descriptors) + ;; Use the parsed report descriptor(s) to generate a function that + ;; extracts the buttons state, x motion, y motion and wheel motion + ;; from a report buffer and calls relative-mouse-event or + ;; normalized-mouse-event with those values. + (let ((reports (mapcar + #'(lambda (collection) + (multiple-value-list (convert-collection collection 0 0))) + descriptors))) + (with-trace-level (1) + (format *trace-stream* "reports:~%~S~%~%" reports)) + (let ((func (if (= (length reports) 1) + (simple-report-code (car reports)) + (multiple-report-code reports)))) + (with-trace-level (1) + (format *trace-stream* "function:~%~A~%~%" func)) + (compile nil func)))) + +;;====================================================================== +;; HID Mouse Driver +;;====================================================================== +(defun probe-hid-mouse (usbd device configs descriptors) + (setf *submit-mouse* + (intern "SUBMIT-MOUSE" :mezzano.gui.compositor) + *submit-mouse-normalized* + (intern "SUBMIT-MOUSE-NORMALIZED" :mezzano.gui.compositor)) + (let ((endpoint (make-hid-endpt :type :mouse))) + (setf (hid-endpt-parse-state endpoint) descriptors + (hid-endpt-function endpoint) (generate-mouse-buf-code descriptors)) + (let ((endpt-desc (pop configs))) + (when (or (null endpt-desc) + (/= (aref endpt-desc +ed-type+) +desc-type-endpoint+)) + (sup:debug-print-line "HID probe failed because " + "found descriptor type " + (aref endpt-desc +ed-type+) + " instead of endpoint descriptor.") + (throw :probe-failed :failed)) + (let ((max-packet (logior(aref endpt-desc +ed-max-packet+) + (ash (aref endpt-desc (1+ +ed-max-packet+)) 8)))) + ;; The buffer size is computed to be the largest buffer <= 64 + ;; bytes that contains an integer number of endpoint + ;; packets. Being a multiple of endpoint packets seems to be a + ;; requirement to avoid Data Overruns. This will be a problem + ;; if a mouse report runs over the end of the buffer. + (setf (hid-endpt-buf-size endpoint) + (* (floor 64 max-packet) max-packet)) + (with-trace-level (1) + (format *trace-stream* "buffer size: ~D~%" + (hid-endpt-buf-size endpoint)))) + (let* ((driver (make-hid-driver + :usbd usbd + :device device + :endpoints (make-array 32 :initial-element NIL))) + (endpt-num + (parse-endpt-descriptor + usbd driver endpoint device endpt-desc 'mouse-int-callback))) + (setf (aref (hid-driver-endpoints driver) endpt-num) endpoint) + (values configs driver))))) + +(register-hid-device-function :mouse 'probe-hid-mouse) diff --git a/drivers/usb/hid.lisp b/drivers/usb/hid.lisp index 6d58591af..e3f4134b0 100644 --- a/drivers/usb/hid.lisp +++ b/drivers/usb/hid.lisp @@ -1,17 +1,14 @@ -;;;; Copyright (c) 2019 Philip Mueller (phil.mueller@fittestbits.com) +;;;; Copyright (c) 2019, 2020, 2021 Philip Mueller (phil.mueller@fittestbits.com) ;;;; This code is licensed under the MIT license. ;;====================================================================== ;; ;; HID (Human Interface Device) Class Driver ;; -;; This file is made up of three broad sections: -;; 1. The HID device drivers -;; 2. Code that generates a function that decodes interrupt -;; buffers (input reports) using the data structure generated -;; by section 3. -;; 3. Code that creates a data structure for use by section 2 -;; above by parsing the raw report description. +;; The HID class driver searchs for a HID driver for each interface +;; the HID device provides. It does this by reading and parsing the +;; report descriptors to see if there are any HID drivers registered +;; for the reports. ;; ;;====================================================================== @@ -22,16 +19,13 @@ (in-package :mezzano.driver.usb.hid) -(defvar *trace-stream* t #+nil sys.int::*cold-stream*) +(defvar *trace-stream* sys.int::*cold-stream*) (defvar *trace* 0) (defmacro with-trace-level ((trace-level) &body body) `(when (>= *trace* ,trace-level) ,@body)) -;; submit mouse function name, compositor package not defined when -;; drivers are loaded, generate the symbol at first hid mouse probe - (defstruct hid-endpt type ; :mouse or :keyboard buf-size ; interrupt buffer size (bytes) @@ -50,10 +44,7 @@ (usbd driver endpoint device endpt-desc callback) ;; get buffer size from report in interface ;; get packet size from endpt-desc - (let* ((address (aref endpt-desc +ed-address+)) - (endpt-in (ldb-test +ed-direction-field+ address)) - (endpt-num (ldb +ed-endpt-num-field+ address))) - + (let* ((endpt-num (ldb +ed-endpt-num-field+ (aref endpt-desc +ed-address+)))) (ecase (aref endpt-desc +ed-attributes+) (#.+ed-attr-interrupt+ (create-interrupt-endpt usbd @@ -73,524 +64,34 @@ ) ;;====================================================================== -;; HID Mouse Driver -;;====================================================================== - -(defvar *submit-mouse* nil) - -(defun probe-hid-mouse (usbd device iface-desc configs) - (when (/= (aref iface-desc +id-num-endpoints+) 1) - (sup:debug-print-line "HID Probe failed because " - "mouse interface descriptor has " - (aref iface-desc +id-num-endpoints+) - " endpoints. Only exactly 1 supported.") - (throw :probe-failed nil)) - - (when (not *submit-mouse*) - (setf *submit-mouse* (intern "SUBMIT-MOUSE" :mezzano.gui.compositor))) - - (let ((iface-num (aref iface-desc +id-number+)) - (hid-desc (pop configs)) - (endpoint (make-hid-endpt :type :mouse))) - (when (or (null hid-desc) - (/= (aref hid-desc +hd-type+) +desc-type-hid+)) - (sup:debug-print-line - "HID Probe failed because " - "mouse interface descriptor not followed by HID descriptor.") - (throw :probe-failed nil)) - - (let ((type (aref hid-desc +hd-descriptor-type+)) - (size (get-unsigned-word/16 hid-desc +hd-descriptor-length+))) - (when (/= type +desc-type-report+) - (sup:debug-print-line "HID probe failed because descriptor type " - type - " not report, the only type supported.") - (throw :probe-failed nil)) - - (let ((state (parse-report-descriptor usbd device iface-num size))) - (multiple-value-bind (buf-size function) (generate-mouse-buf-code state) - (setf (hid-endpt-buf-size endpoint) buf-size - (hid-endpt-parse-state endpoint) state - (hid-endpt-function endpoint) function)))) - - (let ((endpt-desc (pop configs))) - (when (or (null endpt-desc) - (/= (aref endpt-desc +ed-type+) +desc-type-endpoint+)) - (sup:debug-print-line "HID probe failed because " - "found descriptor type " - (aref endpt-desc +ed-type+) - " instead of endpoint descriptor.") - (throw :probe-failed nil)) - (let* ((driver (make-hid-driver - :usbd usbd - :device device - :endpoints (make-array 32 :initial-element NIL))) - (endpt-num - (parse-endpt-descriptor - usbd driver endpoint device endpt-desc 'mouse-int-callback))) - (setf (aref (hid-driver-endpoints driver) endpt-num) endpoint) - (values configs driver))))) - -(define-usb-class-driver "HID Mouse" 'probe-hid-mouse - '((#.+id-class-hid+ #.+hid-subclass-none+ #.+id-protocol-mouse+) - (#.+id-class-hid+ #.+hid-subclass-boot+ #.+id-protocol-mouse+))) - -;;====================================================================== -;; -;; At some point these variables (*threshold* and *multiplier*) and -;; the function (adjust-motion) should be settable from a user -;; configuration GUI so that users can customize their pointer's -;; operation. (Of course the (declaim (inline ...)) will have to be -;; removed. Aug. 11, 2019 +;; Human Interface Device (HID) report parser ;; -;;====================================================================== - -(defvar *threshold* 50) -(defvar *multiplier* 3) - -(declaim (inline adjust-motion)) - -(defun adjust-motion (motion) - (cond ((>= motion *threshold*) - (- (* *multiplier* motion) (* (1- *multiplier*) *threshold*))) - ((>= motion (- *threshold*)) - motion) - (T - (+ (* *multiplier* motion) (* (1- *multiplier*) *threshold*))))) - -(defun mouse-event (buttons x-motion y-motion wheel-motion) - (funcall *submit-mouse* - (logior buttons - (if (> wheel-motion 0) - #b00001000 - 0) - (if (< wheel-motion 0) - #b00010000 - 0)) - (adjust-motion x-motion) - (adjust-motion y-motion)) - (when (/= wheel-motion 0) - ;; button up event for buttons 4 and 5 - (funcall *submit-mouse* buttons 0 0))) - -(defvar *mouse-ints* NIL) ;; for debug - -(defun mouse-int-callback (driver endpoint-num status length buf) - (unwind-protect - (cond ((eq status :success) - (let ((endpoint (aref (hid-driver-endpoints driver) endpoint-num))) - (funcall (hid-endpt-function endpoint) length buf))) - (T - (format sys.int::*cold-stream* - "Interrupt error ~A on endpoint number ~D~%" - status endpoint-num))) - (with-trace-level (7) - (push (format nil "~D: ~A" length buf) *mouse-ints*)) - (free-buffer buf))) - -;;====================================================================== -;; HID Keyboard Driver -;;====================================================================== - -(defun probe-hid-keyboard (usbd driver device iface-desc configs) - (when (/= (aref iface-desc +id-num-endpoints+) 1) - (sup:debug-print-line "HID Probe failed because " - "keyboard interface descriptor has " - (aref iface-desc +id-num-endpoints+) - " endpoints. Only exactly 1 supported.") - (throw :probe-failed nil)) - - (let ((iface-num (aref iface-desc +id-number+)) - (hid-desc (pop configs)) - (endpoint (make-hid-endpt :type :keyboard))) - - (when (or (null hid-desc) - (/= (aref hid-desc +hd-type+) +desc-type-hid+)) - (sup:debug-print-line - "HID Probe failed because " - "keyboard interface descriptor not followed by HID descriptor.") - (throw :probe-failed nil)) - - (let ((type (aref hid-desc +hd-descriptor-type+)) - (size (get-unsigned-word/16 hid-desc +hd-descriptor-length+))) - (when (/= type +desc-type-report+) - (sup:debug-print-line "HID probe failed because descriptor type " - type - " not report, the only type supported.") - (throw :probe-failed nil)) - - (let ((state (parse-report-descriptor - usbd driver device iface-num size))) - (multiple-value-bind (buf-size function) - (generate-keyboard-buf-code state) - (setf (hid-endpt-buf-size endpoint) buf-size - (hid-endpt-parse-state endpoint) state - (hid-endpt-function endpoint) function)))) - - (let ((endpt-desc (pop configs))) - (when (or (null endpt-desc) - (/= (aref endpt-desc +ed-type+) +desc-type-endpoint+)) - (sup:debug-print-line "HID probe failed because " - "found descriptor type " - (aref endpt-desc +ed-type+) - " instead of endpoint descriptor.") - (throw :probe-failed nil)) - ;; TODO write keyboard-int-callback - #+nil - (let ((endpt-num (parse-endpt-descriptor usbd - endpoint - device - endpt-desc - 'keyboard-int-callback))) - (setf (aref (hid-driver-endpoints driver) endpt-num) endpoint)))) - configs) - -#+nil -(define-usb-class-driver "HID Keyboard" 'probe-hid-keyboard - '((#.+id-class-hid+ #.+hid-subclass-none+ #.+id-protocol-keyboard+) - (#.+id-class-hid+ #.+hid-subclass-boot+ #.+id-protocol-keyboard+))) - - -;;====================================================================== -;; Structures used to parse HID Report descriptor and to generate code -;; that decodes interrupt buffers (input reports). +;; This code parses USB HID report descriptors which describe the HID +;; including the type of device and a description of the messages the +;; device sends and receives. The report descriptor is defined in +;; setion 6.2.2 of USB Device Class Definition for Human Interface +;; Devices version 1.11 6/27/2001 ;; ====================================================================== -(defstruct report-field - name - byte-offset - bit-offset - num-bits - count - minimum - maximum - values) - -(defun find-report-field (report name) - (dolist (field report) - (when (eql (report-field-name field) name) - (return field)))) - -(defstruct report-info - byte-offset - bit-offset - format) - -(defstruct parse-info - input ; report-info for input report - output ; report-info for output report - feature ; report-info for feature report - input-reports - output-reports - feature-reports - state ; plist - ) - -(defun parse-state-value (state indicator) - (getf (parse-info-state state) indicator)) - -(defun (setf parse-state-value) (value state indicator) - (setf (getf (parse-info-state state) indicator) value)) - -(defun increment-position (report-info num-bits) - (multiple-value-bind (bytes bit-pos) - (truncate (+ (report-info-bit-offset report-info) num-bits) 8) - (incf (report-info-byte-offset report-info) bytes) - (setf (report-info-bit-offset report-info) bit-pos))) - -(defun get-buffer-size (report-info) - (if (= (report-info-bit-offset report-info) 0) - (report-info-byte-offset report-info) - (1+ (report-info-byte-offset report-info)))) - ;;====================================================================== +;; Pages info ;; -;; Generate a function which parses the mouse interrupt buffer and -;; returns the buttons state, x-motion and y-motion +;; Implement a sparse 2^32 entry array as hash table, this +;; implmentation may change later without affecting the parser. ;; +;; The table values come from the document USB HID Usage Tables +;; version 1.12 10/28/2004 +;; +;; This is a read-only table, it is only written here during +;; initialized here and the keys are a list of two integers between 0 +;; and #x3FFF (which combined would be the index into the 2^32 entry +;; array). Even though this table may be accessed by multiple threads, +;; because it is read-only and the keys are invariant, it is safe to +;; leave it unsynchronized. ;;====================================================================== - -(defun generate-array-index (offset offset-var) - (if offset-var - `(+ ,offset-var ,offset) - offset)) - -(defun generate-single-button (bit-offset button offset-var) - (let ((index (generate-array-index - (report-field-byte-offset button) - offset-var))) - (cond ((null button) 0) - ((or (/= (report-field-num-bits button) 1) - (/= (report-field-count button) 1)) - (error "Multi-bit button unsuported size/count: ~D/~D" - (report-field-num-bits button) - (report-field-count button))) - ((= (report-field-bit-offset button) bit-offset) - `(logand (aref buf ,index) - ,(ash 1 bit-offset))) - (T - `(ash (logand (aref buf ,index) - ,(ash 1 (report-field-bit-offset button))) - ,(- bit-offset (report-field-bit-offset button))))))) - -(defun generate-button-code (report offset-var) - ;; generate code to extract up to the first three buttons - (let ((button1 (find-report-field report :button1)) - (button2 (find-report-field report :button2)) - (button3 (find-report-field report :button3))) - (when (or (and button1 (not(= (report-field-num-bits button1) - (report-field-count button1) - 1))) - (and button2 (not(= (report-field-num-bits button2) - (report-field-count button2) - 1))) - (and button3 (not(= (report-field-num-bits button3) - (report-field-count button3) - 1)))) - (error "Multi-bit button unsupported")) - (cond ((and button1 button2 button3 ;; 3 button mouse - ;; all in the same byte - (= (report-field-byte-offset button1) - (report-field-byte-offset button2) - (report-field-byte-offset button3)) - ;; bits are sequential - (= (+ (report-field-bit-offset button1) 2) - (+ (report-field-bit-offset button2) 1) - (report-field-bit-offset button3))) - ;; optimum cases - 3 sequental bits - (let ((index (generate-array-index - (report-field-byte-offset button1) - offset-var))) - (if (= (report-field-bit-offset button1) 0) - `(logand (aref buf ,index) #x07) - `(ldb (byte 3 ,(report-field-bit-offset button1)) - (aref buf ,index))))) - - ((and button1 button2 (null button3) ;; 2 button mouse - ;; all in the same byte - (= (report-field-byte-offset button1) - (report-field-byte-offset button2)) - ;; all single bit - (= (caddr button1) (caddr button2) 1) - ;; bits are sequential - (= (+ (report-field-bit-offset button1) 1) - (report-field-bit-offset button2))) - ;; optimum cases - 2 sequential bits - (let ((index (generate-array-index - (report-field-byte-offset button1) - offset-var))) - (if (= (report-field-bit-offset button1) 0) - `(logand (aref buf ,index) #x03) - `(ldb (byte 2 ,(report-field-bit-offset button1)) - (aref buf ,index))))) - - ((and button1 (null button2) (null button3) ;; 1 button mouse - ;; single bit - (= (caddr button1) 1)) - (let ((index (generate-array-index - (report-field-byte-offset button1) - offset-var))) - ;; optimum cases - (if (= (report-field-bit-offset button1) 0) - `(logand (aref buf ,index) #x01) - `(ldb (byte 1 ,(report-field-bit-offset button1)) - (aref buf ,index))))) - - (T ;; treat each button individually - `(logior ,(generate-single-button 0 button1 offset-var) - ,(generate-single-button 1 button2 offset-var) - ,(generate-single-button 2 button3 offset-var)))))) - -(defun generate-get-bits-code (byte-offset bit-offset bits count offset-var) - ;; TODO need to handle count - (when (/= count 1) - (sup:debug-print-line "HID Probe failed because " - "count is " count " not equal to 1.") - (throw :probe-failed nil)) - (let ((index (generate-array-index byte-offset offset-var)) - (1+index (generate-array-index (1+ byte-offset) offset-var)) - (2+index (generate-array-index (+ byte-offset 2) offset-var))) - ;; Generate code to extract a bit field from the buffer - (cond ((and (= bit-offset 0) (= bits 8)) - `(aref buf ,index)) - ((and (= bit-offset 0) (< bits 8)) - `(logand (aref buf ,index) ,(1- (expt 2 bits)))) - ((<= (+ bit-offset bits) 8) - `(ldb (byte ,bits ,bit-offset) (aref buf ,index))) - ((and (= bit-offset 0) (= bits 16)) - `(dpb (aref buf ,1+index) (byte 8 8) (aref buf ,index))) - ((and (= bit-offset 0) (< bits 16)) - `(dpb (ldb (byte ,(- bits 8) 0) (aref buf ,1+index)) - (byte ,(- bits 8) 8) - (aref buf ,index))) - ((<= (+ bit-offset bits) 16) - `(dpb (aref buf ,1+index) - (byte ,(- bits (- 8 bit-offset)) ,(- 8 bit-offset)) - (ldb (byte ,(- 8 bit-offset) ,bit-offset) - (aref buf ,index)))) - ((<= bits 16) - `(dpb (aref buf ,2+index) - (byte ,(- bits (+ 8 (- 8 bit-offset))) ,(+ 8 (- 8 bit-offset))) - (dpb (aref buf ,1+index) - (byte 8 ,(- 8 bit-offset)) - (ldb (byte ,(- 8 bit-offset) ,bit-offset) - (aref buf ,index))))) - (T - (sup:debug-print-line "HID Probe failed because " - "field with size " - bits - " not supported.") - (throw :probe-failed nil))))) - -(defun signed-field-p (bits min max) - ;; if msb of min is 1 and msb of max is 0, assume field is signed. - (and (logbitp (1- bits) min) (not (logbitp (1- bits) max)))) - -(defun generate-field-value-code - (report field-name offset-var &optional (required-p T)) - ;; generate code to return the value of a field - (let ((field-format (find-report-field report field-name))) - (cond ((null field-format) - (when required-p - (format sys.int::*cold-stream* - "HID Probe failed because field ~A undefined in report." - field-name) - (throw :probe-failed nil)) - 0) - (T - (let* ((byte-offset (report-field-byte-offset field-format)) - (bit-offset (report-field-bit-offset field-format)) - (num-bits (report-field-num-bits field-format)) - (count (report-field-count field-format)) - (min (report-field-minimum field-format)) - (max (report-field-maximum field-format)) - (value (generate-get-bits-code - byte-offset bit-offset num-bits count offset-var)) - (sym (gensym "X-"))) - (cond ((signed-field-p num-bits min max) - `(let ((,sym ,value)) - (if (logbitp ,(1- num-bits) ,sym) - (- (1+ (logxor ,(1- (expt 2 num-bits)) ,sym))) - ,sym))) - (T value))))))) - -(defun input-reports-buf-size (input-reports) - (let ((sum 0)) - (dolist (report-plist input-reports) - (incf sum (getf report-plist :buf-size))) - ;; buffer should be large enough to receive all of the reports at - ;; once but might as well allow up to 64 bytes if the sum is less - ;; than that. A larger buffer shouldn't hurt ... August 9, 2019 - (max sum 64))) - -(defun generate-mouse-case-code (input-reports offset-var) - (let ((results NIL) ; list of "case" entries - (mouse-case NIL)) - (dolist (report-plist input-reports) - (let ((type (second (getf report-plist :report))) - (report-id (first (getf report-plist :report))) - (buf-size (getf report-plist :buf-size)) - (fields (getf report-plist :fields))) - (cond ((eq type :mouse) - (when mouse-case - (sup:debug-print-line "HID probe failed because " - "there are multiple mouse reports") - (throw :probe-failed nil)) - (setf mouse-case - `(,report-id - (mouse-event - ,(generate-button-code fields offset-var) - ,(generate-field-value-code fields :x offset-var) - ,(generate-field-value-code fields :y offset-var) - ,(generate-field-value-code - fields :wheel offset-var nil)) - (incf ,offset-var ,buf-size)))) - (T - (push `(,report-id - (incf ,offset-var ,buf-size)) results))))) - (when (null mouse-case) - (sup:debug-print-line "HID probe failed because " - "there is no mouse report") - (throw :probe-failed nil)) - ;; make mouse case the first case - (cons mouse-case results))) - -(defun generate-mouse-buf-code (state) - ;; Use the parsed report descriptor to generate a function that - ;; extracts the buttons state, x motion and y motion for a mouse - ;; from a buffer. The function returns (values button-state x-motion - ;; y-motion). - (cond ((report-info-format (parse-info-input state)) - ;; simple case - single report with NO report ID - - (let* ((fields (report-info-format (parse-info-input state))) - (buf-size (get-buffer-size (parse-info-input state))) - (result `(lambda (length buf) - (declare (ignore length)) - (mouse-event - ,(generate-button-code fields nil) - ,(generate-field-value-code fields :x nil) - ,(generate-field-value-code fields :y nil) - ,(generate-field-value-code - fields :wheel nil nil))))) - (with-trace-level (3) - (format *trace-stream* "~A~%" result)) - (values buf-size (compile nil result)))) - ((= (length (parse-info-input-reports state)) 1) - ;; next most simple case - single report with report ID - (let* ((report-plist (car (parse-info-input-reports state))) - (type (second (getf report-plist :report))) - (buf-size (getf report-plist :buf-size)) - (fields (getf report-plist :fields))) - - (when (not (eq type :mouse)) - (format - sys.int::*cold-stream* - "HID Probe failed because report type is ~A instead of :mouse." - type) - (throw :probe-failed nil)) - - (let ((result `(function (lambda (length buf) - (declare (ignore length)) - (mouse-event - ,(generate-button-code fields nil) - ,(generate-field-value-code fields :x nil) - ,(generate-field-value-code fields :y nil) - ,(generate-field-value-code - fields :wheel nil nil)))))) - (with-trace-level (3) - (format *trace-stream* "~A~%" result)) - (values buf-size (eval result))))) - (T ;; complex case - multiple reports with report IDs - (let* ((input-reports (parse-info-input-reports state)) - (buf-size (input-reports-buf-size input-reports)) - (result `(function (lambda (length buf) - (do ((offset 0)) - ((>= offset length)) - (case (aref buf offset) - ,@(generate-mouse-case-code input-reports - 'offset) - )))))) - (with-trace-level (3) - (format *trace-stream* "~A~%" result)) - (values buf-size (eval result)))))) - -(defun generate-keyboard-buf-code (state) - ;; TODO create generate-keyboard-buf-code - (values nil nil)) - -;;====================================================================== -;; Code that parses HID reports -;;====================================================================== - -;;====================================================================== -;; Pages info - implement sparse array as hash table - may change later -;;====================================================================== - -;; This looks like it might be read by multiple threads, but only written -;; here during initialization and only invariant keys are used. -;; It is safe to leave it unsynchronized with invariant keys. -(defvar *pages* (make-hash-table :test 'equal :enforce-gc-invariant-keys t)) +(defvar *pages* (make-hash-table + :test 'equal + #+mezzano :enforce-gc-invariant-keys #+mezzano t)) (setf (gethash (list 1 #x01) *pages*) :pointer @@ -656,7 +157,32 @@ (gethash (list 9 #x10) *pages*) :button16 (gethash (list 12 #x001) *pages*) :consumer-control - (gethash (list 12 #x238) *pages*) :ac-pan + (gethash (list 12 #x0B0) *pages*) :play + (gethash (list 12 #x0B1) *pages*) :pause + (gethash (list 12 #x0B2) *pages*) :record + (gethash (list 12 #x0B3) *pages*) :fast-forward + (gethash (list 12 #x0B4) *pages*) :rewind + (gethash (list 12 #x0B5) *pages*) :scan-next-track + (gethash (list 12 #x0B6) *pages*) :scan-previous-track + (gethash (list 12 #x0B7) *pages*) :stop + (gethash (list 12 #x0B8) *pages*) :eject + (gethash (list 12 #x0CD) *pages*) :pause-play + (gethash (list 12 #x0E2) *pages*) :mute + (gethash (list 12 #x0E9) *pages*) :volume-increment + (gethash (list 12 #x0EA) *pages*) :volume-decrement + (gethash (list 12 #x183) *pages*) :app-launch-ctl-config + (gethash (list 12 #x18A) *pages*) :app-launch-email-reader + (gethash (list 12 #x192) *pages*) :app-launch-calculator + (gethash (list 12 #x194) *pages*) :app-launch-machine-browser + (gethash (list 12 #x221) *pages*) :app-ctl-search + (gethash (list 12 #x222) *pages*) :app-ctl-go-to + (gethash (list 12 #x223) *pages*) :app-ctl-home + (gethash (list 12 #x224) *pages*) :app-ctl-back + (gethash (list 12 #x225) *pages*) :app-ctl-forward + (gethash (list 12 #x226) *pages*) :app-ctl-stop + (gethash (list 12 #x227) *pages*) :app-ctl-refresh + (gethash (list 12 #x22A) *pages*) :app-ctl-bookmarks + (gethash (list 12 #x238) *pages*) :app-ctl-pan ) (defun get-page-entry (page item) @@ -671,7 +197,58 @@ result)))) ;;====================================================================== +;; Structures used to parse HID Report descriptor used by HID drivers +;; to decode interrupt buffers (input reports). +;; ====================================================================== + +(defstruct parse-fields + (report-count nil) + (report-size nil) + (logical-minimum nil) + (logical-maximum nil) + (usage-minimum nil) + (usage-maximum nil) + (usage-page nil) + (usage nil)) + +(defstruct parse-info + (global-fields (make-parse-fields)) + (local-fields (make-parse-fields)) + collection + results) + +(defun reset-parse-fields (fields) + (setf (parse-fields-report-count fields) nil + (parse-fields-report-size fields) nil + (parse-fields-logical-minimum fields) nil + (parse-fields-logical-maximum fields) nil + (parse-fields-usage-minimum fields) nil + (parse-fields-usage-maximum fields) nil + (parse-fields-usage-page fields) nil + (parse-fields-usage fields) nil)) + +;; Define accessors of the form parse-info- which gives +;; priority to the local value over the global value +(macrolet + ((def-parse-info-field (&rest field-names) + (let ((results '(progn))) + (dolist (field-name field-names (reverse results)) + (let ((info-name (intern (concatenate 'string + "PARSE-INFO-" + (symbol-name field-name)))) + (accessor-name (intern (concatenate 'string + "PARSE-FIELDS-" + (symbol-name field-name))))) + (push `(defun ,info-name (info) + (or (,accessor-name (parse-info-local-fields info)) + (,accessor-name (parse-info-global-fields info)))) + results)))))) + (def-parse-info-field report-count report-size logical-minimum logical-maximum + usage-minimum usage-maximum usage-page usage)) + ;;====================================================================== +;; Start of parser code +;; ====================================================================== (defun parse-item (state buf offset) (let ((header (aref buf offset))) @@ -694,235 +271,113 @@ *trace-stream* state buf offset header size type data)) (values type tag data (+ offset size 1)))))) -(defun parse-fields (state report-info data) - (cond ((logbitp 0 data) - ;; constant field - want to ignore - (let ((num-bits (* (parse-state-value state :report-size) - (parse-state-value state :report-count)))) - (push - (make-report-field - :name :constant - :byte-offset (report-info-byte-offset report-info) - :bit-offset (report-info-bit-offset report-info) - :num-bits num-bits - :count 1 - :minimum NIL - :maximum NIL - :values NIL) - (report-info-format report-info)) - (increment-position report-info num-bits))) - ((logbitp 1 data) - ;; variable - (loop - with usage-count = (or (parse-state-value state :usage-count) - (parse-state-value state :report-count)) - for idx from - (1- usage-count) downto 0 - with num-bits = (parse-state-value state :report-size) - with symbols = (parse-state-value state :usage) - do (push - (make-report-field - :name (nth idx symbols) - :byte-offset (report-info-byte-offset report-info) - :bit-offset (report-info-bit-offset report-info) - :num-bits num-bits - :count 1 - :minimum (parse-state-value state :logical-minimum) - :maximum (parse-state-value state :logical-maximum) - :values NIL) - (report-info-format report-info)) - (increment-position report-info num-bits) - finally - (when (and (parse-state-value state :usage-count) - (/= (parse-state-value state :usage-count) - (parse-state-value state :report-count))) - (increment-position report-info - (- (parse-state-value state :report-count) - (parse-state-value state :usage-count)))) - - (setf (parse-state-value state :usage) - (nthcdr usage-count symbols) - (parse-state-value state :usage-count) - NIL))) - ((not (logbitp 1 data)) - ;; Array number of used entries = max - min + 1 - (let* ((num-bits (parse-state-value state :report-size)) - (count (parse-state-value state :report-count)) - (num-entries - (1+ (- (parse-state-value state :logical-maximum) - (parse-state-value state :logical-minimum)))) - (symbols (last (reverse (parse-state-value state :usage)) - num-entries))) - (push - (make-report-field - :name (nth num-entries (parse-state-value state :usage)) - :byte-offset (report-info-byte-offset report-info) - :bit-offset (report-info-bit-offset report-info) - :num-bits num-bits - :count count - :minimum (parse-state-value state :logical-minimum) - :maximum (parse-state-value state :logical-maximum) - :values symbols) - (report-info-format report-info)) - (setf (parse-state-value state :usage) - (nthcdr (1+ num-entries) - (parse-state-value state :usage)) - (parse-state-value state :usage-count) - NIL) - (increment-position report-info (* num-bits count)))) - )) +(defun parse-main-data (tag data) + (let ((result nil)) + (push (if (logbitp 8 data) :buffered-bytes :bit-field) result) + (when (or (= tag #x09) (= tag #x0B)) + (push (if (logbitp 7 data) :volatile :non-volatile) result)) + (when (logbitp 6 data) + (push :null-state result)) + (when (not (logbitp 5 data)) + (push :preferred-state result)) + (when (logbitp 4 data) + (push :non-linear result)) + (when (logbitp 3 data) + (push :wrap result)) + (push (if (logbitp 2 data) :relative :absolute) result) + (push (if (logbitp 1 data) :variable :array) result) + (push (if (logbitp 0 data) :constant :data) result) + result)) (defun parse-main (state tag data) (case tag - (#x08 ; Input - (parse-fields state (parse-info-input state) data)) - (#x09 ; Output - (parse-fields state (parse-info-output state) data)) + ((#x08 #x09 #x0B) ; Input, Output or Feature + (nconc (car (parse-info-collection state)) + (list (case tag (#x08 :input) (#x09 :output) (#x0B :feature)) + (list :type (parse-main-data tag data) + :count (parse-info-report-count state) + :size (parse-info-report-size state) + :logical-minimum (parse-info-logical-minimum state) + :logical-maximum (parse-info-logical-maximum state) + :usage-minimum (parse-info-usage-minimum state) + :usage-maximum (parse-info-usage-maximum state) + :usage (reverse (parse-info-usage state))))) + (reset-parse-fields (parse-info-local-fields state))) (#x0A ; Collection - (case data - (#x00 - (push :physical (parse-state-value state :collection))) - (#x01 - (push :application (parse-state-value state :collection))) - )) - (#x0B ; Feature - (parse-fields state (parse-info-feature state) data)) - (#x0C ;; End Collection - (pop (parse-state-value state :collection)) - (pop (parse-state-value state :usage))) - )) - -(defun end-of-report-id (state) - (let ((report-info (parse-info-input state))) - (when (report-info-format report-info) - ;; It was an input report - (push (list :report (parse-state-value state :report-id) - :buf-size (get-buffer-size report-info) - :fields (report-info-format report-info)) - (parse-info-input-reports state)))) - (setf (parse-info-input state) - (make-report-info :byte-offset 0 - :bit-offset 0 - :format nil)) - - (let ((report-info(parse-info-output state))) - (when (report-info-format report-info) - ;; It was an output report - (push (list :report (parse-state-value state :report-id) - :buf-size (get-buffer-size report-info) - :fields (report-info-format report-info)) - (parse-info-output-reports state)))) - (setf (parse-info-output state) - (make-report-info :byte-offset 0 - :bit-offset 0 - :format nil)) - - (let ((report-info (parse-info-feature state))) - (when (report-info-format report-info) - ;; It was an feature report - (push (list :report (parse-state-value state :report-id) - :buf-size (get-buffer-size report-info) - :fields (report-info-format report-info)) - (parse-info-feature-reports state)))) - (setf (parse-info-feature state) - (make-report-info :byte-offset 0 - :bit-offset 0 - :format nil))) + (push (list (case data + (#x00 :physical) + (#x01 :application) + (#x02 :logical) + (#x03 :report) + (#x04 :named-array) + (#x05 :usage-switch) + (#x06 :usage-modifier)) + (car (parse-info-usage state))) + (parse-info-collection state)) + (setf (parse-fields-usage (parse-info-local-fields state)) nil)) + (#x0C ; End Collection + (let ((collection (pop (parse-info-collection state)))) + (cond ((null (parse-info-collection state)) + (push collection (parse-info-results state)) + (setf (parse-info-collection state) nil) + (reset-parse-fields (parse-info-local-fields state)) + (reset-parse-fields (parse-info-global-fields state))) + (T + (nconc (car (parse-info-collection state)) + (list :collection collection)))))))) (defun parse-global (state tag data) - (case tag - (#x00 ; usage page - (setf (parse-state-value state :page) data)) - (#x01 - (setf (parse-state-value state :logical-minimum) data)) - (#x02 - (setf (parse-state-value state :logical-maximum) data)) - (#x07 - (setf (parse-state-value state :report-size) data)) - (#x08 - (when (parse-state-value state :report-id) - ;; start of new report - end of previous report - (end-of-report-id state)) - (setf (parse-state-value state :report-id) - (list data (car (parse-state-value state :usage))) - (report-info-byte-offset (parse-info-input state)) 1 - (report-info-byte-offset (parse-info-output state)) 1 - (report-info-byte-offset (parse-info-feature state)) 1)) - (#x09 - (setf (parse-state-value state :report-count) data)) - )) + (let ((fields (parse-info-global-fields state))) + (case tag + (#x00 + (setf (parse-fields-usage-page fields) data)) + (#x01 + (setf (parse-fields-logical-minimum fields) data)) + (#x02 + (setf (parse-fields-logical-maximum fields) data)) + (#x07 + (setf (parse-fields-report-size fields) data)) + (#x08 + (setf (getf (car (parse-info-collection state)) :report-id) data)) + (#x09 + (setf (parse-fields-report-count fields) data))))) (defun parse-local (state tag data) - (case tag - (#x00 ; usage - (push (get-page-entry (parse-state-value state :page) data) - (parse-state-value state :usage))) - (#x01 - (let ((max (parse-state-value state :usage-maximum))) - (cond (max - (remf (parse-info-state state) :usage-maximum) - (loop for idx from data to max - do (push - (get-page-entry (parse-state-value state :page) idx) - (parse-state-value state :usage))) - (setf (parse-state-value state :usage-count) - (1+ (- max data)))) - (T - (setf (parse-state-value state :usage-minimum) data))))) - (#x02 - (let ((min (parse-state-value state :usage-minimum))) - (cond (min - (remf (parse-info-state state) :usage-minimum) - (loop for idx from min to data - do (push - (get-page-entry (parse-state-value state :page) idx) - (parse-state-value state :usage))) - (setf (parse-state-value state :usage-count) - (1+ (- data min)))) - (T - (setf (parse-state-value state :usage-maximum) data))))) - )) - -(defun parse-report-finish (state) - (when (parse-state-value state :report-id) - ;;end of report descriptor - end of previous report - (end-of-report-id state)) - - (with-trace-level (6) - (format *trace-stream* "~A~%~%" state))) + (let ((fields (parse-info-local-fields state))) + (case tag + (#x00 + (push (get-page-entry (parse-info-usage-page state) data) + (parse-fields-usage fields))) + (#x01 + (setf (parse-fields-usage-minimum fields) data)) + (#x02 + (setf (parse-fields-usage-maximum fields) data))))) (defun %parse-report-descriptor (buf size) - ;; Returns number of bytes and list of report fields for input, - ;; output and features. - (do ((offset 0) - (state (make-parse-info :input (make-report-info :byte-offset 0 - :bit-offset 0 - :format nil) - :output (make-report-info :byte-offset 0 - :bit-offset 0 - :format nil) - :feature (make-report-info :byte-offset 0 - :bit-offset 0 - :format nil) - :input-reports nil - :output-reports nil - :feature-reports nil - :state NIL))) - ((>= offset size) (parse-report-finish state) state) - (multiple-value-bind (type tag data new-offset) - (parse-item state buf offset) - (setf offset new-offset) - (case type - (:main - (parse-main state tag data)) - (:global - (parse-global state tag data)) - (:local - (parse-local state tag data)) - ) - (with-trace-level (6) - (format *trace-stream* "~A~%~%" state)) - ))) + ;; Returns data structure defining report fields + (loop + with offset = 0 + with state = (make-parse-info) + when (>= offset size) do + (let ((result (nreverse (parse-info-results state)))) + (with-trace-level (1) + (format *trace-stream* "report-descriptor:~%~S~%~%" result)) + (return result)) + do + (multiple-value-bind (type tag data new-offset) + (parse-item state buf offset) + (setf offset new-offset) + (case type + (:main + (parse-main state tag data)) + (:global + (parse-global state tag data)) + (:local + (parse-local state tag data)) + ) + (with-trace-level (6) + (format *trace-stream* "~A~%~%" state)) + ))) (defun parse-report-descriptor (usbd device iface-num size) (sup:debug-print-line "iface num " iface-num) @@ -947,9 +402,61 @@ " bytes instead of " size ".") - (throw :probe-failed nil))) + (throw :probe-failed :failed))) (with-trace-level (3) (format sys.int::*cold-stream* "report descriptor: ~%") (print-buffer sys.int::*cold-stream* report-buf :indent " ")) (%parse-report-descriptor report-buf size))) + +;;====================================================================== +;;====================================================================== + +(defvar *hid-probe-fcns* NIL) + +(defun register-hid-device-function (device-type function) + (setf (getf *hid-probe-fcns* device-type) function)) + +;;====================================================================== +;; +;; Probe HID device, parse the report descriptor, and call appropriate +;; HID device driver based on the application type. +;; +;;====================================================================== + +(defun probe-hid-device (usbd device iface-desc configs) + (when (/= (aref iface-desc +id-num-endpoints+) 1) + (sup:debug-print-line "HID Probe failed because " + "interface descriptor has " + (aref iface-desc +id-num-endpoints+) + " endpoints. Only exactly 1 supported.") + (throw :probe-failed :failed)) + + (let ((iface-num (aref iface-desc +id-number+)) + (hid-desc (pop configs))) + (when (or (null hid-desc) + (/= (aref hid-desc +hd-type+) +desc-type-hid+)) + (sup:debug-print-line + "HID Probe failed because " + "interface descriptor not followed by HID descriptor.") + (throw :probe-failed :failed)) + (let ((type (aref hid-desc +hd-descriptor-type+)) + (size (get-unsigned-word/16 hid-desc +hd-descriptor-length+))) + (when (/= type +desc-type-report+) + (sup:debug-print-line "HID probe failed because descriptor type " + type + " not report, the only type supported.") + (throw :probe-failed :failed)) + (let* ((descriptors (parse-report-descriptor usbd device iface-num size))) + (loop + for descriptor in descriptors + for probe-fcn = (getf *hid-probe-fcns* (getf descriptor :application)) + when probe-fcn do + (multiple-value-bind (%configs driver) + (funcall probe-fcn usbd device configs descriptors) + (when driver + (return-from probe-hid-device (values %configs driver))))))) + (values configs NIL))) + +(define-usb-class-driver "HID" 'probe-hid-device + '((#.+id-class-hid+ NIL NIL))) diff --git a/drivers/usb/mass-storage.lisp b/drivers/usb/mass-storage.lisp index 483ad993a..d1eb929e4 100644 --- a/drivers/usb/mass-storage.lisp +++ b/drivers/usb/mass-storage.lisp @@ -460,7 +460,7 @@ "endpoint type is " (aref endpt-desc +ed-attributes+) " instead of a bulk endpoint") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) (create-bulk-endpt usbd device @@ -557,16 +557,16 @@ ;;command failed (sup:debug-print-line "Mass Storage Probe failed because " "Inquiry command failed") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) ((= (aref status-buf 12) 2) (sup:debug-print-line "Mass Storage Probe failed because " "Inquiry command got phase error") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) (T (sup:debug-print-line "Mass Storage Probe failed because " "Inquiry failed with unkown error " (aref status-buf 12)) - (throw :probe-failed nil)))))) + (throw :probe-failed :failed)))))) (defun parse-read-capacity (usbd device mass-storage cap/10-p) (enter-function "parse-read-capacity") @@ -654,16 +654,16 @@ ;;command failed (sup:debug-print-line "Mass Storage Probe failed because " "read capacity command failed") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) ((= (aref status-buf 12) 2) (sup:debug-print-line "Mass Storage Probe failed because " "read capacity command got phase error") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) (T (sup:debug-print-line "Mass Storage Probe failed because " "read capacity failed with unkown error " (aref status-buf 12)) - (throw :probe-failed nil)))))) + (throw :probe-failed :failed)))))) (defun probe-mass-storage-scsi (usbd device iface-desc configs) (when (/= (aref iface-desc +id-num-endpoints+) 2) @@ -671,7 +671,7 @@ "interface descriptor has " (aref iface-desc +id-num-endpoints+) " endpoints, Only exactly 2 supported.") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) (let ((mass-storage (make-mass-storage :usbd usbd @@ -691,14 +691,14 @@ "found descriptor type " (aref endpt-desc +ed-type+) " instead of endpoint descriptor.") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) (parse-endpt-descriptor usbd device mass-storage endpt-desc))) (when (or (null (mass-storage-bulk-in-endpt-num mass-storage)) (null (mass-storage-bulk-out-endpt-num mass-storage))) (sup:debug-print-line "Mass Storage probe failed because " "did not have both in and out bulk endpoints") - (throw :probe-failed nil)) + (throw :probe-failed :failed)) (parse-inquiry usbd device mass-storage) (parse-read-capacity usbd device mass-storage T) diff --git a/drivers/usb/mezzano-usb.asd b/drivers/usb/mezzano-usb.asd index 3ee9b76ce..6e3731662 100644 --- a/drivers/usb/mezzano-usb.asd +++ b/drivers/usb/mezzano-usb.asd @@ -76,6 +76,8 @@ :description "Class drivers" :depends-on ("mezzano-usb") :components ((:file "hid") + (:file "hid-mouse" :depends-on ("hid")) + (:file "hid-keyboard" :depends-on ("hid")) (:file "mass-storage"))) (defsystem "mezzano-usb/debug" diff --git a/drivers/usb/packages.lisp b/drivers/usb/packages.lisp index 55a51feda..1bb09e71a 100644 --- a/drivers/usb/packages.lisp +++ b/drivers/usb/packages.lisp @@ -5,7 +5,8 @@ (:use :cl) (:local-nicknames (:sup :mezzano.supervisor) (:pci :mezzano.supervisor.pci) - (:sync :mezzano.sync)) + (:sync :mezzano.sync) + (:sys.int :mezzano.internals)) (:export ;; USB driver (USBD) Interface functions for device drivers :define-usb-driver diff --git a/drivers/usb/usb-driver.lisp b/drivers/usb/usb-driver.lisp index be552340d..b9fbde81b 100644 --- a/drivers/usb/usb-driver.lisp +++ b/drivers/usb/usb-driver.lisp @@ -334,7 +334,6 @@ ;;====================================================================== ;; Code for USB device driver registration ;; -;; classes: list of (class subclass) pairs ;; products: list of ( ) pairs ;; ;;====================================================================== @@ -385,19 +384,61 @@ do (loop for (driver-class driver-subclass driver-protocol) in (driver-classes driver) when (and (= class driver-class) - (= subclass driver-subclass) - (= protocol driver-protocol)) do + (or (null driver-subclass) + (= subclass driver-subclass)) + (or (null driver-protocol) + (= protocol driver-protocol))) do (return-from find-usb-class-driver driver))))) -(defun probe-usb-driver (usbd device buf) - (let* ((vendor-id (dpb (aref buf +dd-vendor-id-high+) - (byte 8 8) - (aref buf +dd-vendor-id-low+))) - (product-id (dpb (aref buf +dd-product-id-high+) - (byte 8 8) - (aref buf +dd-product-id-low+))) - (class (aref buf +dd-device-class+)) - (subclass (aref buf +dd-device-sub-class+)) +(defun probe-interface (usbd device descriptors) + (let ((iface-desc (car descriptors))) + (if (= (aref iface-desc +id-type+) +desc-type-interface+) + (let ((driver (find-usb-class-driver (aref iface-desc +id-class+) + (aref iface-desc +id-sub-class+) + (aref iface-desc +id-protocol+)))) + (if driver + (multiple-value-bind (result1 result2) + (catch :probe-failed (funcall (driver-probe driver) + usbd + device + iface-desc + (cdr descriptors))) + (if (eq result1 :failed) + (values (cdr descriptors) NIL) + (values result1 result2))) + (values (cdr descriptors) NIL))) + (values (cdr descriptors) NIL)))) + +(defun probe-configuration (usbd device config config-idx) + ;; config is a list of descriptors for this particular configuration + ;; Some devices seem to require that the configuration be set before + ;; getting the report descriptor, so set the configuration here. + (let ((config-desc (car config))) + (when (/= (aref config-desc +cd-type+) +desc-type-configuration+) + (sup:debug-print-line + "probe-configuration for configuration index " + config-idx + " failed because first descritor is type " + (aref config-desc +cd-type+) + " which is not a configuration descriptor.") + (return-from probe-configuration)) + (set-configuration usbd device (aref config-desc +cd-config-value+))) + + ;; Use probe-interface to try the class driver for each interface + (loop + with descriptors = (cdr config) + with driver + while descriptors do + (multiple-value-setq (descriptors driver) + (probe-interface usbd device descriptors)) + (when driver + (push driver (usb-device-drivers device))))) + +(defun probe-usb-driver (usbd device device-desc) + (let* ((vendor-id (sys.int::ub16ref/le device-desc +dd-vendor-id-low+)) + (product-id (sys.int::ub16ref/le device-desc +dd-product-id-low+)) + (class (aref device-desc +dd-device-class+)) + (subclass (aref device-desc +dd-device-sub-class+)) (driver (find-usb-driver vendor-id product-id class subclass))) (setf (slot-value device 'vendor-id) vendor-id @@ -407,102 +448,71 @@ (sup:debug-print-line "vendor id " vendor-id " product id " product-id) + ;; if there's a device specific driver, try to use it. (when driver - (let ((probe-result (funcall (driver-probe driver) usbd device))) - (when probe-result - (push probe-result (usb-device-drivers device)) - (return-from probe-usb-driver T)))) + (setf (usb-device-drivers device) + (funcall (driver-probe driver) usbd device)) + (when (usb-device-drivers device) + (return-from probe-usb-driver T))) ;; Either there was no driver, or the device specific driver didn't - ;; accept the device. Try the class drivers. - (catch :probe-failed - (let ((configuration (get-configuration usbd device))) - (setf (usb-device-configuration device) configuration) - (do ((desc (car configuration) (car configs)) - (configs (cdr configuration) (cdr configs)) - (config-set-p NIL)) - ((null desc)) - - ;; Some devices seem to require that the configuration be - ;; set before getting the report descriptor, so set the - ;; configuration here. But, then what to do if there are - ;; multiple configurations? Error for now. - (when (= (aref desc +dd-type+) +desc-type-configuration+) - (when config-set-p - (sup:debug-print-line - "Probe failed because " - "multiple configuration descriptors are not supported") - (delete-device usbd device) - (return-from probe-usb-driver NIL)) - (setf config-set-p T) - (set-configuration usbd device (aref desc +cd-config-value+))) - - (when (= (aref desc +dd-type+) +desc-type-interface+) - (let ((driver (find-usb-class-driver (aref desc +id-class+) - (aref desc +id-sub-class+) - (aref desc +id-protocol+)))) - (when driver - (multiple-value-bind (remaining-configs probe-result) - (funcall (driver-probe driver) usbd device desc configs) - (when probe-result - (push probe-result (usb-device-drivers device)) - (setf configs remaining-configs)))))))) - - ;; Loop exited normally - (cond ((null (usb-device-drivers device)) - ;; No driver accepted the device, delete it. - (delete-device usbd device) - (return-from probe-usb-driver NIL)) - (T - ;; One or more drivers accepted the device, keep it + ;; accept the device. Try the class drivers for each configuartion. + (loop + for config-idx upto (1- (aref device-desc +dd-num-configurations+)) + for config = (get-configuration usbd device config-idx) + do + (when config + (probe-configuration usbd device config config-idx) + (when (usb-device-drivers device) (return-from probe-usb-driver T)))) - ;; Loop exited via the catch - probe failed + ;; No driver accepted the device, delete it and return failure (delete-device usbd device) NIL)) -(defun %get-configuration (usbd device length buf) +(defun %get-configuration (usbd device idx length buf) (let ((num-bytes (get-descriptor usbd device - +desc-type-configuration+ 0 + +desc-type-configuration+ idx length buf))) - (when (/= num-bytes length) - ;; Unable to get configuration descriptor - (sup:debug-print-line "HID Probe failed because " - "unable to get config descriptor, only got " - num-bytes - " bytes instead of " - length - ".") - (throw :probe-failed nil)))) - -(defun get-configuration (usbd device) + (if (= num-bytes length) + T + (progn + ;; Unable to get configuration descriptor + (sup:debug-print-line "Probe failed because " + "unable to get config descriptor, only got " + num-bytes + " bytes instead of " + length + ".") + NIL)))) + +(defun get-configuration (usbd device idx) (with-buffers ((buf-pool usbd) (buf /8 9)) ;; Get first configuration descriptor - need full descriptor length - (%get-configuration usbd device 9 buf) + (%get-configuration usbd device idx 9 buf) (let ((length (aref buf 2))) (with-buffers ((buf-pool usbd) (config-buf /8 length)) ;; Get full descriptor - (%get-configuration usbd device length config-buf) - - (with-trace-level (3) - (print-descriptor mezzano.internals::*cold-stream* config-buf)) - - ;; split configuration descriptor into separate descriptors - (do* ((offset 0 (+ offset (aref config-buf offset))) - (result nil)) - ((>= offset length) (nreverse result)) - (let ((size (aref config-buf offset))) - (when (= size 0) - (sup:debug-print-line "HID Probe failed because " - "of an invalid descriptor with size = 0.") - (throw :probe-failed nil)) - (push (loop - for idx from 0 to (1- size) - with desc = (make-array size) - do (setf (aref desc idx) - (aref config-buf (+ offset idx))) - finally (return desc)) result))))))) + (when (%get-configuration usbd device idx length config-buf) + (with-trace-level (3) + (print-descriptor mezzano.internals::*cold-stream* config-buf)) + + ;; split configuration descriptor into separate descriptors + (do* ((offset 0 (+ offset (aref config-buf offset))) + (result nil)) + ((>= offset length) (nreverse result)) + (let ((size (aref config-buf offset))) + (when (= size 0) + (sup:debug-print-line "Probe failed because " + "of an invalid descriptor with size = 0.") + (return-from get-configuration NIL)) + (push (loop + for idx from 0 to (1- size) + with desc = (make-array size) + do (setf (aref desc idx) + (aref config-buf (+ offset idx))) + finally (return desc)) result)))))))) ;;====================================================================== ;; From 5c477ef2e0fcfd5e5ca12483b28a72c38ac73746 Mon Sep 17 00:00:00 2001 From: Phil Mueller Date: Thu, 11 Mar 2021 16:15:39 -0700 Subject: [PATCH 3/4] USB: Small refactor of hid-mouse code. Merge the single report and multiple report code. --- drivers/usb/hid-mouse.lisp | 47 +++++++++++++------------------------- 1 file changed, 16 insertions(+), 31 deletions(-) diff --git a/drivers/usb/hid-mouse.lisp b/drivers/usb/hid-mouse.lisp index aca95f2c7..71479e104 100644 --- a/drivers/usb/hid-mouse.lisp +++ b/drivers/usb/hid-mouse.lisp @@ -430,24 +430,7 @@ ;; usigned - assume that means absolute, so normalize `(/ ,field-value ,max)))))))) -(defun simple-report-code (report) - (let* ((fields (caddr report))) - `(lambda (length buf) - (loop - with offset = 0 - when (>= offset length) do - (return) - do - (,(if (fields-absolute-p fields) - 'normalized-mouse-event - 'relative-mouse-event) - ,(generate-button-code fields 'offset) - ,(generate-field-value-code fields :x 'offset T) - ,(generate-field-value-code fields :y 'offset T) - ,(generate-field-value-code fields :wheel 'offset NIL)) - (incf offset ,(/ (cadddr report) 8)))))) - -(defun generate-case-clauses (reports) +(defun generate-mouse-case-clauses (reports) (let* ((num-mouse-reports 0) (clauses (loop @@ -473,15 +456,18 @@ (throw :probe-failed :failed)) clauses)) -(defun multiple-report-code (reports) - `(lambda (length buf) - (loop - with offset = 0 - when (>= offset length) do - (return) - do - (case (aref buf offset) - ,@(generate-case-clauses reports))))) +(defun generate-mouse-buf-function (reports) + (let ((case-clauses (generate-mouse-case-clauses reports))) + `(lambda (length buf) + (loop + with offset = 0 + when (>= offset length) do + (return) + do + ,@(if (= (length case-clauses) 1) + (cdar case-clauses) + `((case (aref buf offset) + ,@case-clauses))))))) (defun compute-buf-size (reports) (let ((size (/ (loop for report in reports sum (cadddr report)) 8))) @@ -496,13 +482,12 @@ ;; normalized-mouse-event with those values. (let ((reports (mapcar #'(lambda (collection) - (multiple-value-list (convert-collection collection 0 0))) + (multiple-value-list (convert-collection + collection 0 0 0))) descriptors))) (with-trace-level (1) (format *trace-stream* "reports:~%~S~%~%" reports)) - (let ((func (if (= (length reports) 1) - (simple-report-code (car reports)) - (multiple-report-code reports)))) + (let ((func (generate-mouse-buf-function reports))) (with-trace-level (1) (format *trace-stream* "function:~%~A~%~%" func)) (compile nil func)))) From ae5c42461e8fb2d96f91ba10234a28fe3243e2c8 Mon Sep 17 00:00:00 2001 From: Phil Mueller Date: Thu, 11 Mar 2021 16:21:56 -0700 Subject: [PATCH 4/4] USB: Implement hid-keyboard driver. hid.lisp: Update comments to reflect data table in hid-keyboard.lisp. hid-mouse.lisp: Change the way array report items are handled, instead of treating an array as a sequence of buttons, treat it as an array. This fits in better with keyboard reports where an array of characters is defined. hid-keyboard.lisp: Implement the hid keyboard driver. --- drivers/usb/hid-keyboard.lisp | 403 ++++++++++++++++++++++++++++++++-- drivers/usb/hid-mouse.lisp | 67 ++---- drivers/usb/hid.lisp | 12 +- 3 files changed, 417 insertions(+), 65 deletions(-) diff --git a/drivers/usb/hid-keyboard.lisp b/drivers/usb/hid-keyboard.lisp index 87aba7b7f..424386a2b 100644 --- a/drivers/usb/hid-keyboard.lisp +++ b/drivers/usb/hid-keyboard.lisp @@ -1,19 +1,377 @@ -;;;; Copyright (c) 2019, 2020 Philip Mueller (phil.mueller@fittestbits.com) +;;;; Copyright (c) 2019, 2020, 2021 Philip Mueller (phil.mueller@fittestbits.com) ;;;; This code is licensed under the MIT license. (in-package :mezzano.driver.usb.hid) ;;====================================================================== -;; HID Keyboard Driver +;; Page info +;; +;; Map from HID keyboard key values to characters. This is one "page" +;; of the HID pages described in the document USB HID Usage Tables +;; version 1.12 10/28/2004 +;; +;; This is the Keyboard/Keypad Page (page 0x07). It is actually has +;; 64KB entries, however, only the first 256 are defined. So, we use a +;; 256 entry array. +;; +;; The Mezzano version only includes characters that are mapped in +;; gui/keymaps.lisp, all other entries are keywords. When a USB +;; keyboard generates a value that maps to a keyword entry, that value +;; is dropped (not passed on to the compositor code). +;; +;; The non-Mezzano version is used for testing with SBCL which doesn't +;; allow arbitrarily defined characters and therefore only supports a +;; subset of the characters supported by Mezzano. +;; +;; This is a read-only table, it is only written here during +;; initialized. ;;====================================================================== -(defun generate-keyboard-buf-code (state) - ;; TODO create generate-keyboard-buf-code - (values nil nil)) +(defvar hid-keymap + #+mezzano + #(:no-key :roll-over-error :post-fail-error :undefined-error + #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J + #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T + #\U #\V #\W #\X #\Y #\Z + #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\0 + #\Newline #\Esc #\Backspace #\Tab #\Space + #\- #\= #\[ #\] #\\ #\# #\; #\' #\` #\, #\. #\/ + #\Caps-Lock + #\F1 #\F2 #\F3 #\F4 #\F5 #\F6 #\F7 #\F8 #\F9 #\F10 #\F11 #\F12 + #\Print-Screen #\Scroll-Lock #\Pause #\Insert #\Home + #\Page-Up #\Delete #\End #\Page-Down + #\Right-Arrow #\Left-Arrow #\Down-Arrow #\Up-Arrow + :KP-num-lock #\KP-Divide #\KP-Multiply #\KP-Minus #\KP-Plus #\KP-Enter + #\KP-1 #\KP-2 #\KP-3 #\KP-4 #\KP-5 #\KP-6 #\KP-7 #\KP-8 #\KP-9 #\KP-0 + #\KP-Period + #\\ :application :power :KP-equal + :F13 :F4 :F15 :F16 :F17 :F18 :F19 :F20 :F21 :F22 :F23 :F24 + :Execute :Help #\Menu :Select :Stop :Again :Undo + :Cut :Copy :Paste :Find :Mute :Volume-Up :Volume-Down + :Locking-Caps-Lock :Locking-Num-Lock :Locking-Scroll-Lock + :KP-Comma :KP-Equal + :Int-1 :Int-2 :Int-3 :Int-4 :Int-5 :Int-6 :Int-7 :Int-8 :Int-9 + :Lang-1 :Lang-2 :Lang-3 :Lang-4 :Lang-5 :Lang-6 :Lang-7 :Lang-8 :Lang-9 + :Erase :Attention :Cancel :Clear :Prior :Return :Separator :Out :Oper + :Clear/Again :CrSel/Props :ExSel + :reserved-A5 :reserved-A6 :reserved-A7 + :reserved-A8 :reserved-A9 :reserved-AA :reserved-AB + :reserved-AC :reserved-AD :reserved-AE :reserved-AF + :KP-00 :KP-000 + :Thousands-Separator :Decimal-Separator + :Currency-Unit :Currency-Sub-Unit + :KP-Left-Paren :KP-Right-Paren :KP-Left-Brace :KP-Right-Brace + :KP-Tab :KP-Backspace + :KP-A :KP-B :KP-C :KP-D :KP-E :KP-F + :KP-XOR :KP-^ :KP-% :KP-< :KP-> :KP-& :KP-&& :KP-Bar :KP-Bar-Bar + :KP-Colon :KP-Pound :KP-Space :KP-@ :KP-! + :KP-Mem-Store :KP-Mem-Recall :KP-Mem-Clear + :KP-Mem-Add :KP-Mem-Minus :KP-Mem-Multiply :KP-Mem-Divide + :KP-Plus-Minus :KP-Clear :KP-Clear-Entry + :KP-Binary :KP-Octal :KP-Decimal :KP-Hexadecimal + :reserved-DE :reserved-DF + :Left-Control :Left-Shift :Left-Alt :Left-GUI + :Right-Control :Right-Shift :Right-Alt :Right-GUI + :reserved-E8 :reserved-E9 :reserved-EA :reserved-EB + :reserved-EC :reserved-ED :reserved-EE :reserved-EF + :reserved-F0 :reserved-F1 :reserved-F2 :reserved-F3 + :reserved-F4 :reserved-F5 :reserved-F6 :reserved-F7 + :reserved-F8 :reserved-F9 :reserved-FA :reserved-FB + :reserved-FC :reserved-FD :reserved-FE :reserved-FF) + #-mezzano + #(:no-key :roll-over-error :post-fail-error :undefined-error + #\A #\B #\C #\D #\E #\F #\G #\H #\I #\J + #\K #\L #\M #\N #\O #\P #\Q #\R #\S #\T + #\U #\V #\W #\X #\Y #\Z + #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\0 + #\Newline #\Esc #\Backspace #\Tab #\Space + #\- #\= #\[ #\] #\\ #\# #\; #\' #\` #\, #\. #\/ + :caps-lock + :F1 :F2 :F3 :F4 :F5 :F6 :F7 :F8 :F9 :F10 :F11 :F12 + :Print-Screen :Scroll-Lock :Pause :Insert :Home + :Page-Up :Delete :End :Page-Down + :Right-Arrow :Left-Arrow :Down-Arrow :Up-Arrow + :KP-num-lock :KP-Divide :KP-Multiply :KP-Minus :KP-Plus :KP-Enter + :KP-1 :KP-2 :KP-3 :KP-4 :KP-5 :KP-6 :KP-7 :KP-8 :KP-9 :KP-0 + :KP-Period + #\\ :application :power :KP-equal + :F13 :F4 :F15 :F16 :F17 :F18 :F19 :F20 :F21 :F22 :F23 :F24 + :Execute :Help :Menu :Select :Stop :Again :Undo + :Cut :Copy :Paste :Find :Mute :Volume-Up :Volume-Down + :Locking-Caps-Lock :Locking-Num-Lock :Locking-Scroll-Lock + :KP-Comma :KP-Equal + :Int-1 :Int-2 :Int-3 :Int-4 :Int-5 :Int-6 :Int-7 :Int-8 :Int-9 + :Lang-1 :Lang-2 :Lang-3 :Lang-4 :Lang-5 :Lang-6 :Lang-7 :Lang-8 :Lang-9 + :Erase :Attention :Cancel :Clear :Prior :Return :Separator :Out :Oper + :Clear/Again :CrSel/Props :ExSel + :reserved-A5 :reserved-A6 :reserved-A7 + :reserved-A8 :reserved-A9 :reserved-AA :reserved-AB + :reserved-AC :reserved-AD :reserved-AE :reserved-AF + :KP-00 :KP-000 + :Thousands-Separator :Decimal-Separator + :Currency-Unit :Currency-Sub-Unit + :KP-Left-Paren :KP-Right-Paren :KP-Left-Brace :KP-Right-Brace + :KP-Tab :KP-Backspace + :KP-A :KP-B :KP-C :KP-D :KP-E :KP-F + :KP-XOR :KP-^ :KP-% :KP-< :KP-> :KP-& :KP-&& :KP-Bar :KP-Bar-Bar + :KP-Colon :KP-Pound :KP-Space :KP-@ :KP-! + :KP-Mem-Store :KP-Mem-Recall :KP-Mem-Clear + :KP-Mem-Add :KP-Mem-Minus :KP-Mem-Multiply :KP-Mem-Divide + :KP-Plus-Minus :KP-Clear :KP-Clear-Entry + :KP-Binary :KP-Octal :KP-Decimal :KP-Hexadecimal + :reserved-DE :reserved-DF + :Left-Control :Left-Shift :Left-Alt :Left-GUI + :Right-Control :Right-Shift :Right-Alt :Right-GUI + :reserved-E8 :reserved-E9 :reserved-EA :reserved-EB + :reserved-EC :reserved-ED :reserved-EE :reserved-EF + :reserved-F0 :reserved-F1 :reserved-F2 :reserved-F3 + :reserved-F4 :reserved-F5 :reserved-F6 :reserved-F7 + :reserved-F8 :reserved-F9 :reserved-FA :reserved-FB + :reserved-FC :reserved-FD :reserved-FE :reserved-FF)) +;; submit key function name, the compositor package may not defined +;; when USB drivers are loaded, the symbol is generated when a hid +;; keyboard is probed. +(defvar *submit-key* nil) -(defun probe-hid-keyboard (usbd device configs state) - (let ((endpoint (make-hid-endpt :type :keyboard))) +;;====================================================================== +;; HID Keyboard interrupt handler +;;====================================================================== +(defvar *keyboard-ints* NIL) ;; for debug + +(defstruct (hid-keyboard-endpt (:include hid-endpt) (:conc-name hid-endpt-)) + pressed-keys + pressed-modifiers) + +(defun keyboard-int-callback (driver endpoint-num status length buf) + (unwind-protect + (cond ((eq status :success) + (let ((endpoint (aref (hid-driver-endpoints driver) endpoint-num))) + (funcall (hid-endpt-function endpoint) endpoint length buf))) + (T + (format sys.int::*cold-stream* + "Interrupt error ~A on endpoint number ~D~%" + status endpoint-num) + (with-trace-level (1) + (format sys.int::*cold-stream* + "length: ~D~%buf: ~S~%" length buf)))) + (with-trace-level (7) + (push (format nil "~D: ~A" length buf) *keyboard-ints*)) + (free-buffer buf))) + +;;====================================================================== +;; Code which generates function to process interrupt buffer data +;;====================================================================== +(defvar *modifier-buttons* + ;; Modifier buttons can either be :button-e[0-7] or : + ;; depending on how the HID descriptor is defined, so we have to + ;; check for both cases. + '(:button-e0 :button-e1 :button-e2 :button-e3 + :button-e4 :button-e5 :button-e6 :button-e7 + :left-control :left-shift :left-alt :left-gui + :right-control :right-shift :right-alt :right-gui)) + +(defvar *modifier->char* + ;; Modifier buttons can either be :button-e[0-7] or : + ;; depending on how the HID descriptor is defined, so we have to + ;; translate both cases. + #+mezzano + '((:button-e0 . #\Left-Control) + (:button-e1 . #\Left-Shift) + (:button-e2 . #\Left-Meta) ;; USB: alt + (:button-e3 . #\Left-Super) ;; USB: gui + (:button-e4 . #\Right-Control) + (:button-e5 . #\Right-Shift) + (:button-e6 . #\Right-Meta) ;; USB: alt + (:button-e7 . #\Right-Super) ;; USB: gui + (:left-control . #\Left-Control) + (:left-shift . #\Left-Shift) + (:left-alt . #\Left-Meta) + (:left-meta . #\Left-Super) + (:right-control . #\Right-Control) + (:right-shift . #\Right-Shift) + (:right-alt . #\Right-Meta) + (:right-gui . #\Right-Super) + #-mezzano + '((:button-e0 . :left-control) + (:button-e1 . :left-shift) + (:button-e2 . :left-meta) ;; USB: alt + (:button-e3 . :left-super) ;; USB: gui + (:button-e4 . :right-control) + (:button-e5 . :right-shift) + (:button-e6 . :right-meta) ;; USB: alt + (:button-e7 . :right-super) ;; USB: gui + (:left-control . :left-control) + (:left-shift . :left-shift) + (:left-alt . :left-meta) + (:left-gui . :left-super) + (:right-control . :right-control) + (:right-shift . :right-shift) + (:right-alt . :right-meta) + (:right-gui . :right-super)))) + +(defun get-scattered-modifier-bits (fields buf offset) + ;; Handle general case where modifier bits are in multiple buffer + ;; bytes by gathering the bits into a single byte. This case is not + ;; expected to be used, because all of the hid keyboard examples + ;; seen so far have the modifier bits in a single byte. However, + ;; this code is provided for completeness. + `(logior + ,@(loop + for key in *modifier-buttons* + for field = (cdr (assoc key fields)) + with bit-pos = 0 + when field collect + `(ash (aref ,buf (+ ,offset ,(getf field :byte-offset))) + ,(- bit-pos (getf field :bit-offset))) + when field do + (incf bit-pos)))) + +(defun get-modifier-bits (fields buf offset) + (let ((byte-offset NIL) + (single-offset-p T)) + (loop + for key in *modifier-buttons* + for field-byte-offset = (getf (cdr (assoc key fields)) :byte-offset) + do + (cond ((null byte-offset) + (setf byte-offset field-byte-offset)) + ((and field-byte-offset + (/= field-byte-offset byte-offset)) + (setf single-offset-p NIL)))) + (cond ((null byte-offset) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID keyboard probe failed because ~ + no modifier buttons found~%") + (throw :probe-failed :failed)) + (single-offset-p + ;; this is the common case - all of the modifiers in a single byte + `(aref ,buf (+ ,offset ,byte-offset))) + (T + (get-scattered-modifier-bits fields buf offset))))) + +(defun modifier-release-code (fields modifiers old-modifiers) + (let ((%released-modifiers (gensym "RELEASED-MODIFIERS-"))) + `(let ((,%released-modifiers (logandc2 ,old-modifiers ,modifiers))) + (when (/= ,%released-modifiers 0) + ,@(loop + for (button . key) in *modifier->char* + for field = (cdr (assoc button fields)) + when field collect + `(when (logbitp ,(getf field :bit-offset) ,%released-modifiers) + (funcall *submit-key* ,key T))))))) + +(defun modifier-press-code (fields modifiers old-modifiers) + (let ((%pressed-modifiers (gensym "PRESSED-MODIFIERS-"))) + `(let ((,%pressed-modifiers (logandc2 ,modifiers ,old-modifiers))) + (when (/= ,%pressed-modifiers 0) + ,@(loop + for (button . key) in *modifier->char* + for field = (cdr (assoc button fields)) + when field collect + `(when (logbitp ,(getf field :bit-offset) ,%pressed-modifiers) + (funcall *submit-key* ,key NIL))))))) + +(defun key-release-code (cur-keys old-keys) + (let ((%key (gensym "KEY-"))) + `(dolist (,%key (set-difference ,old-keys ,cur-keys)) + (funcall *submit-key* ,%key T)))) + +(defun key-press-code (cur-keys old-keys) + (let ((%key (gensym "KEY-"))) + `(dolist (,%key (set-difference ,cur-keys ,old-keys)) + (funcall *submit-key* ,%key NIL)))) + +(defun generate-keyboard-code (report) + (let* ((fields (caddr report)) + (array-field (cdr (assoc :array-01 fields)))) + (when (null array-field) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID keyboard probe failed because ~ + no character array field found~%") + (throw :probe-failed :failed)) + `(,(car report) + (let ((cur-keys (loop + repeat ,(getf array-field :count) + for idx = (+ offset ,(getf array-field :byte-offset)) + then (1+ idx) + for key = (aref buf idx) + when (/= key 0) collect (aref hid-keymap key))) + (cur-modifiers ,(get-modifier-bits fields 'buf 'offset))) + ,@(with-trace-level (5) + '((push (list old-keys old-modifiers cur-keys cur-modifiers) + logs))) + ,(key-release-code 'cur-keys 'old-keys) + ,(modifier-release-code fields 'cur-modifiers 'old-modifiers) + ,(modifier-press-code fields 'cur-modifiers 'old-modifiers) + ,(key-press-code 'cur-keys 'old-keys) + (setf old-keys cur-keys + old-modifiers cur-modifiers) + (incf offset ,(/ (cadddr report) 8)))))) + +(defun generate-keyboard-case-clauses (reports) + (let* ((keyboard-report-p NIL) + (clauses + (loop + for report in reports + collect + (cond ((eq (cadr report) :keyboard) + (setf keyboard-report-p T) + (generate-keyboard-code report)) + (T + `(incf offset ,(/ (cadddr report) 8))))))) + (when (not keyboard-report-p) + (format #+mezzano sys.int::*cold-stream* #-mezzano t + "HID keyboard probe failed because ~ + report descritor contained no keyboard reports~%") + (throw :probe-failed :failed)) + clauses)) + +(defun generate-keyboard-buf-function (reports) + (let ((case-clauses (generate-keyboard-case-clauses reports))) + `(lambda (endpoint length buf) + (loop + with offset = 0 + with old-keys = (hid-endpt-pressed-keys endpoint) + with old-modifiers = (hid-endpt-pressed-modifiers endpoint) + ,@(with-trace-level (5) '(with logs = nil)) + when (>= offset length) do + (progn + ,@(with-trace-level (5) + '((loop + for log in (reverse logs) + do + (format sys.int::*cold-stream* "~A ~A - ~A ~A~%" + (car log) (cadr log) (caddr log) (cadddr log))))) + (setf (hid-endpt-pressed-keys endpoint) old-keys + (hid-endpt-pressed-modifiers endpoint) old-modifiers) + (return)) + do + ,@(if (= (length case-clauses) 1) + (cdar case-clauses) + `((case (aref buf offset) + ,@case-clauses))))))) + +(defun generate-keyboard-buf-code (descriptors) + (let ((reports (mapcar + #'(lambda (collection) + (multiple-value-list (convert-collection + collection 0 0 0))) + descriptors))) + (with-trace-level (1) + (format *trace-stream* "reports:~%~S~%~%" reports)) + (let ((func (generate-keyboard-buf-function reports))) + (with-trace-level (1) + (format *trace-stream* "function:~%~A~%~%" func)) + (compile nil func)))) + +(defun probe-hid-keyboard (usbd device configs descriptors) + (setf *submit-key* (intern "SUBMIT-KEY" :mezzano.gui.compositor)) + (let ((endpoint (make-hid-keyboard-endpt :type :keyboard))) + (setf (hid-endpt-parse-state endpoint) descriptors + (hid-endpt-function endpoint) (generate-keyboard-buf-code descriptors) + (hid-endpt-pressed-keys endpoint) NIL + (hid-endpt-pressed-modifiers endpoint) 0) (let ((endpt-desc (pop configs))) (when (or (null endpt-desc) (/= (aref endpt-desc +ed-type+) +desc-type-endpoint+)) @@ -22,15 +380,26 @@ (aref endpt-desc +ed-type+) " instead of endpoint descriptor.") (throw :probe-failed :failed)) - ;; TODO write keyboard-int-callback - #+nil - (let ((endpt-num (parse-endpt-descriptor usbd - endpoint - device - endpt-desc - 'keyboard-int-callback))) - (setf (aref (hid-driver-endpoints driver) endpt-num) endpoint)))) - ;; Return NIL - this driver not implemented - (values configs nil)) + (let ((max-packet (logior(aref endpt-desc +ed-max-packet+) + (ash (aref endpt-desc (1+ +ed-max-packet+)) 8)))) + ;; The buffer size is computed to be the largest buffer <= 64 + ;; bytes that contains an integer number of endpoint + ;; packets. Being a multiple of endpoint packets seems to be a + ;; requirement to avoid Data Overruns. This will be a problem + ;; if a keyboard report runs over the end of the buffer. + (setf (hid-endpt-buf-size endpoint) + (* (floor 56 max-packet) max-packet)) + (with-trace-level (1) + (format *trace-stream* "buffer size: ~D~%" + (hid-endpt-buf-size endpoint)))) + (let* ((driver (make-hid-driver + :usbd usbd + :device device + :endpoints (make-array 32 :initial-element NIL))) + (endpt-num + (parse-endpt-descriptor + usbd driver endpoint device endpt-desc 'keyboard-int-callback))) + (setf (aref (hid-driver-endpoints driver) endpt-num) endpoint) + (values configs driver))))) (register-hid-device-function :keyboard 'probe-hid-keyboard) diff --git a/drivers/usb/hid-mouse.lisp b/drivers/usb/hid-mouse.lisp index 71479e104..f77dd66b4 100644 --- a/drivers/usb/hid-mouse.lisp +++ b/drivers/usb/hid-mouse.lisp @@ -106,7 +106,7 @@ ;; descriptions ;; ====================================================================== -(defun convert-input-field (field bit-offset button-number) +(defun convert-input-field (field bit-offset button-number array-number) (let ((count (getf field :count)) (size (getf field :size)) (type (getf field :type)) @@ -147,46 +147,21 @@ do (incf %button-number) collect - `(,(intern (format nil "BUTTON~D" button-num) + `(,(intern (format nil "BUTTON-~2,'0X" button-num) :keyword) :number-bits 1 :type :variable :byte-offset ,(ash %bit-offset -3) :bit-offset ,(logand %bit-offset #x07))))))) ((member :array type) - ;; assume array fields are buttons - (let ((usage-count (length (getf field :usage)))) - (cond ((= usage-count count) - (loop - repeat count - for %bit-offset = bit-offset then - (incf %bit-offset size) - for usages = (getf field :usage) then (cdr usages) - for usage = (car usages) - collect - `(,usage :number-bits ,size - :type :array - :byte-offset ,(ash %bit-offset -3) - :bit-offset ,(logand %bit-offset #x07)))) - (T - (loop - for button-num from (1+ button-number) to - (+ count button-number) - for %bit-offset = bit-offset then - (incf %bit-offset size) - do - (incf %button-number) - collect - `(,(intern (format nil "BUTTON~D" button-num) - :keyword) - :number-bits ,size - :type :array - :byte-offset ,(ash %bit-offset -3) - :bit-offset ,(logand %bit-offset #x07) - ,@(if (getf field :usage) - (list :usage (getf field :usage)) - (list :min (getf field :logical-minimum) - :max (getf field :logical-maximum))))))))) + (incf array-number) + `((,(intern (format nil "ARRAY-~2,'0X" array-number) :keyword) + :number-bits ,(* count size) + :type :array + :byte-offset ,(ash bit-offset -3) + :bit-offset ,(logand bit-offset #x07) + :count ,count + :size ,size))) (T (loop repeat count @@ -202,9 +177,10 @@ :byte-offset ,(ash %bit-offset -3) :bit-offset ,(logand %bit-offset #x07))))) (incf bit-offset (* count size)) - (+ button-number %button-number)))) + (+ button-number %button-number) + array-number))) -(defun convert-collection (collection bit-offset button-number) +(defun convert-collection (collection bit-offset button-number array-number) (loop for (key value) on collection by #'cddr with application-id = nil @@ -224,10 +200,11 @@ (setf report-id value bit-offset 8)) (:input - (multiple-value-bind (field %bit-offset %button-number) - (convert-input-field value bit-offset button-number) - (setf bit-offset %bit-offset) - (setf button-number %button-number) + (multiple-value-bind (field %bit-offset %button-number %array-number) + (convert-input-field value bit-offset button-number array-number) + (setf bit-offset %bit-offset + button-number %button-number + array-number %array-number) (nconc fields field))) (:feature (let ((num-bits (* (getf value :count) (getf value :size)))) @@ -239,7 +216,7 @@ (incf bit-offset num-bits))) (:collection (multiple-value-bind (%report-id %application-id %fields %bit-offset) - (convert-collection value bit-offset button-number) + (convert-collection value bit-offset button-number array-number) (when %report-id (setf report-id %report-id)) (when %application-id @@ -298,9 +275,9 @@ `((logand (ash (aref buf ,(buf-offset (getf button :byte-offset))) ,(- offset (getf button :bit-offset))) ,(ash 1 offset)))))) - (let ((button1 (cdr (assoc :button1 fields))) - (button2 (cdr (assoc :button2 fields))) - (button3 (cdr (assoc :button3 fields)))) + (let ((button1 (cdr (assoc :button-01 fields))) + (button2 (cdr (assoc :button-02 fields))) + (button3 (cdr (assoc :button-03 fields)))) (when (or (and button1 (not (eq (getf button1 :number-bits) 1))) (and button2 (not (eq (getf button1 :number-bits) 1))) (and button3 (not (eq (getf button1 :number-bits) 1)))) diff --git a/drivers/usb/hid.lisp b/drivers/usb/hid.lisp index e3f4134b0..7dbbe9dfa 100644 --- a/drivers/usb/hid.lisp +++ b/drivers/usb/hid.lisp @@ -77,18 +77,24 @@ ;; Pages info ;; ;; Implement a sparse 2^32 entry array as hash table, this -;; implmentation may change later without affecting the parser. +;; implementation may change later without affecting the parser. ;; ;; The table values come from the document USB HID Usage Tables ;; version 1.12 10/28/2004 ;; ;; This is a read-only table, it is only written here during -;; initialized here and the keys are a list of two integers between 0 +;; initialized and the keys are a list of two integers between 0 ;; and #x3FFF (which combined would be the index into the 2^32 entry ;; array). Even though this table may be accessed by multiple threads, ;; because it is read-only and the keys are invariant, it is safe to ;; leave it unsynchronized. -;;====================================================================== +;; +;; The first 256 entries of page 0x07 of this table are implemented as +;; an array in hid-keyboard.lisp. It is used to translate input bytes +;; from USB keyboards to characters. The few items of page 0x07 +;; defined below may be used for parsing report descriptors as the +;; "shift" keys are often handled separately from the other keys. +;; ====================================================================== (defvar *pages* (make-hash-table :test 'equal #+mezzano :enforce-gc-invariant-keys #+mezzano t))