Annotation of qemu/roms/SLOF/slof/fs/usb/usb-keyboard.fs, revision 1.1.1.2

1.1       root        1: \ *****************************************************************************
                      2: \ * Copyright (c) 2004, 2008 IBM Corporation
                      3: \ * All rights reserved.
                      4: \ * This program and the accompanying materials
                      5: \ * are made available under the terms of the BSD License
                      6: \ * which accompanies this distribution, and is available at
                      7: \ * http://www.opensource.org/licenses/bsd-license.php
                      8: \ *
                      9: \ * Contributors:
                     10: \ *     IBM Corporation - initial implementation
                     11: \ ****************************************************************************/
                     12: 
                     13: 
                     14: s" keyboard" device-name
                     15: s" keyboard" device-type
                     16: 
                     17: ."   USB Keyboard" cr
                     18: 
                     19: 3 encode-int s" assigned-addresses" property
                     20: 1 encode-int s" reg" property
                     21: 1 encode-int s" configuration#" property
                     22: s" EN" encode-string s" language" property
                     23: 
                     24: 1 constant NumLk
                     25: 2 constant CapsLk
                     26: 4 constant ScrLk
                     27: 
1.1.1.2 ! root       28: TRUE VALUE use-interrupt-transfers?
        !            29: 
        !            30: \ Check whether we're running on QEMU - in this case we disable the
        !            31: \ interrupt transfers since they are not working very well there yet.
        !            32: s" model" s" /" find-node get-property 0= IF
        !            33:    2dup s" qemu" find-substr = TO use-interrupt-transfers?
        !            34:    drop
        !            35: THEN
        !            36: 
        !            37: 
1.1       root       38: 00 value kbd-addr
                     39: to kbd-addr                                \ save speed bit
1.1.1.2 ! root       40: 
1.1       root       41: 8 value mps-dcp
                     42: 8 constant DEFAULT-CONTROL-MPS
1.1.1.2 ! root       43: 0 value multi-key
1.1       root       44: 0 value led-state
                     45: 0 value temp1
                     46: 0 value temp2
                     47: 0 value temp3
                     48: 0 value ret
                     49: 0 value scancode
                     50: 0 value kbd-shift
                     51: 0 value kbd-scan
                     52: 0 value key-old
                     53: 0 value expire-ms
                     54: 0 value mps-int-in
                     55: 0 value int-in-ep
                     56: 0 value int-in-toggle
                     57: 
1.1.1.2 ! root       58: \ Buffers which must be capable of DMA:
        !            59: 
        !            60: STRUCT
        !            61:    80 FIELD kb>cfg              \ For config descriptors etc, size 0x80
        !            62:    8  FIELD kb>report           \ For keyboard report, size 8
        !            63:    8  FIELD kb>setup-packet     \ For setup-packet, size 8
        !            64:    4  FIELD kb>data             \ Various data, size 4
        !            65: CONSTANT /kbd-buf
        !            66: 
        !            67: 0 VALUE kbd-buf
        !            68: 0 VALUE kbd-buf-dma
        !            69: 
        !            70: : (kbd-buf-init)  ( -- )
        !            71:    /kbd-buf s" dma-alloc" $call-parent TO kbd-buf
        !            72:    kbd-buf /kbd-buf 0 s" dma-map-in" $call-parent TO kbd-buf-dma
        !            73: 
        !            74:    s" kbd-buf = " kbd-buf usb-debug-print-val
        !            75: ;
        !            76: 
        !            77: : (kbd-buf-free)  ( -- )
        !            78:    kbd-buf kbd-buf-dma /kbd-buf s" dma-map-out" $call-parent
        !            79:    kbd-buf /kbd-buf s" dma-free" $call-parent
        !            80:    0 TO kbd-buf
        !            81:    0 TO kbd-buf-dma
        !            82: ;
        !            83: 
        !            84: 
1.1       root       85: s" usb-kbd-device-support.fs" included
                     86: 
1.1.1.2 ! root       87: 
1.1       root       88: : control-cls-set-report ( reportvalue FuncAddr -- TRUE|FALSE )
                     89:   to temp1
                     90:   to temp2
1.1.1.2 ! root       91:   2109000200000100 kbd-buf kb>setup-packet !
        !            92:   temp2 kbd-buf kb>data l!-le
        !            93:   1 kbd-buf kb>data 1 kbd-buf kb>setup-packet
        !            94:   DEFAULT-CONTROL-MPS temp1 controlxfer
1.1       root       95: ;
                     96: 
                     97: : control-cls-get-report ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE )
                     98:   to temp1
                     99:   to temp2
                    100:   to temp3
1.1.1.2 ! root      101:   a101000100000000 kbd-buf kb>setup-packet !
        !           102:   temp3 kbd-buf kb>setup-packet 6 + w!-le
        !           103:   0 swap temp3 kbd-buf kb>setup-packet
        !           104:   temp2 temp1 controlxfer
        !           105: ;
        !           106: 
        !           107: : int-get-report ( -- )                                     \ get report for interrupt transfer
        !           108:    0 2 int-in-toggle kbd-buf kb>report 8 mps-int-in
        !           109:    kbd-addr int-in-ep 7 lshift or rw-endpoint               \ get report
        !           110:    swap to int-in-toggle IF
        !           111:       kbd-buf kb>report @
        !           112:       ff00000000000000 and 38 rshift to kbd-shift           \ store shift status
        !           113:       kbd-buf kb>report @
        !           114:       0000ffffffffffff and to kbd-scan                      \ store scan codes
        !           115:    ELSE
        !           116:       0 to kbd-shift                                        \ clear shift status
        !           117:       0 to kbd-scan                                         \ clear scan code buffer
        !           118:    THEN
1.1       root      119: ;
                    120: 
1.1.1.2 ! root      121: : ctl-get-report ( -- )                                     \ get report for control transfer
        !           122:    kbd-buf kb>report 8 8 kbd-addr
        !           123:    control-cls-get-report IF                                \ get report
        !           124:       kbd-buf kb>report @
        !           125:       ff00000000000000 and 38 rshift to kbd-shift           \ store shift status
        !           126:       kbd-buf kb>report @
        !           127:       0000ffffffffffff and to kbd-scan                      \ store scan codes
        !           128:    ELSE
        !           129:       0 to kbd-shift                                        \ clear shift status
        !           130:       0 to kbd-scan                                         \ clear scan code buffer
        !           131:    THEN
1.1       root      132: ;
                    133: 
1.1.1.2 ! root      134: : kbd-get-report  ( -- )
        !           135:    use-interrupt-transfers? IF
        !           136:       int-get-report
        !           137:    ELSE
        !           138:       ctl-get-report
        !           139:    THEN
1.1       root      140: ;
                    141: 
1.1.1.2 ! root      142: 
        !           143: : set-led ( led -- )
        !           144:   dup to led-state
1.1       root      145:   kbd-addr control-cls-set-report drop
                    146: ;
                    147: 
                    148: : is-shift ( -- true|false )
                    149:     kbd-shift 22 and if
                    150:        true
                    151:     else
                    152:        false
                    153:     then
                    154: ;
                    155: 
                    156: : is-alt ( -- true|false )
                    157:     kbd-shift 44 and if
                    158:        true
                    159:     else
                    160:        false
                    161:     then
                    162: ;
                    163: 
                    164: : is-ctrl ( -- true|false )
                    165:     kbd-shift 11 and if
                    166:        true
                    167:     else
                    168:        false
                    169:     then
                    170: ;
                    171: 
                    172: : ctrl_alt_del_key ( char -- )
                    173:     is-ctrl if                                           \ ctrl is pressed?
                    174:        is-alt if                                        \ alt is pressed?
                    175:            4c = if                                      \ del is pressed?
1.1.1.2 ! root      176:                s" reboot.... " usb-debug-print
1.1       root      177:                \ reset-all                              \ reboot
                    178:                drop false                               \ invalidate del key on top of stack
                    179:            then
                    180:            false                                        \ dummy for last drop
                    181:        then
                    182:     then
1.1.1.2 ! root      183:     drop                                                 \ clear stack
1.1       root      184: ;
                    185: 
                    186: : get-ukbd-char ( ScanCode -- char|false )
1.1.1.2 ! root      187:     dup ctrl_alt_del_key                                 \ check ctrl+alt+del
1.1       root      188:     dup to scancode                                      \ store scan code
                    189:     case                                                 \ translate scan code --> char
1.1.1.2 ! root      190:         04 of [char] a endof
        !           191:         05 of [char] b endof
        !           192:         06 of [char] c endof
        !           193:         07 of [char] d endof
        !           194:         08 of [char] e endof
        !           195:         09 of [char] f endof
        !           196:         0a of [char] g endof
        !           197:         0b of [char] h endof
        !           198:         0c of [char] i endof
        !           199:         0d of [char] j endof
        !           200:         0e of [char] k endof
        !           201:         0f of [char] l endof
        !           202:         10 of [char] m endof
        !           203:         11 of [char] n endof
        !           204:         12 of [char] o endof
        !           205:         13 of [char] p endof
        !           206:         14 of [char] q endof
        !           207:         15 of [char] r endof
        !           208:         16 of [char] s endof
        !           209:         17 of [char] t endof
        !           210:         18 of [char] u endof
        !           211:         19 of [char] v endof
        !           212:         1a of [char] w endof
        !           213:         1b of [char] x endof
        !           214:         1c of [char] y endof
        !           215:         1d of [char] z endof
        !           216:         1e of [char] 1 endof
        !           217:         1f of [char] 2 endof
        !           218:         20 of [char] 3 endof
        !           219:         21 of [char] 4 endof
        !           220:         22 of [char] 5 endof
        !           221:         23 of [char] 6 endof
        !           222:         24 of [char] 7 endof
        !           223:         25 of [char] 8 endof
        !           224:         26 of [char] 9 endof
        !           225:         27 of [char] 0 endof
1.1       root      226:         28 of 0d endof                            \ Enter
1.1.1.2 ! root      227:         29 of 1b endof                            \ ESC
        !           228:         2a of 08 endof                            \ Backsace
1.1       root      229:         2b of 09 endof                            \ Tab
1.1.1.2 ! root      230:         2c of 20 endof                            \ Space
        !           231:         2d of [char] - endof
        !           232:         2e of [char] = endof
        !           233:         2f of [char] [ endof
        !           234:         30 of [char] ] endof
        !           235:         31 of [char] \ endof
        !           236:         33 of [char] ; endof
        !           237:         34 of [char] ' endof
        !           238:         35 of [char] ` endof
        !           239:         36 of [char] , endof
        !           240:         37 of [char] . endof
1.1       root      241:         38 of [char] / endof
                    242:         39 of led-state CapsLk xor set-led false endof  \ CapsLk
                    243:         3a of 1b 7e31315b to multi-key endof      \ F1
                    244:         3b of 1b 7e32315b to multi-key endof      \ F2
                    245:         3c of 1b 7e33315b to multi-key endof      \ F3
                    246:         3d of 1b 7e34315b to multi-key endof      \ F4
                    247:         3e of 1b 7e35315b to multi-key endof      \ F5
                    248:         3f of 1b 7e37315b to multi-key endof      \ F6
                    249:         40 of 1b 7e38315b to multi-key endof      \ F7
                    250:         41 of 1b 7e39315b to multi-key endof      \ F8
                    251:         42 of 1b 7e30315b to multi-key endof      \ F9
                    252:         43 of 1b 7e31315b to multi-key endof      \ F10
                    253:         44 of 1b 7e33315b to multi-key endof      \ F11
                    254:         45 of 1b 7e34315b to multi-key endof      \ F12
                    255:         47 of led-state ScrLk xor set-led false endof   \ ScrLk
                    256:         49 of 1b 7e315b to multi-key endof        \ Ins
                    257:         4a of 1b 7e325b to multi-key endof        \ Home
                    258:         4b of 1b 7e335b to multi-key endof        \ PgUp
                    259:         4c of 1b 7e345b to multi-key endof        \ Del
                    260:         4d of 1b 7e355b to multi-key endof        \ End
                    261:         4e of 1b 7e365b to multi-key endof        \ PgDn
                    262:         4f of 1b 435b to multi-key endof          \ R-arrow
                    263:         50 of 1b 445b to multi-key endof          \ L-arrow
                    264:         51 of 1b 425b to multi-key endof          \ D-arrow
                    265:         52 of 1b 415b to multi-key endof          \ U-arrow
                    266:         53 of led-state NumLk xor set-led false endof   \ NumLk
1.1.1.2 ! root      267:         54 of [char] / endof                      \ keypad /
1.1       root      268:         55 of [char] * endof                      \ keypad *
                    269:         56 of [char] - endof                      \ keypad -
                    270:         57 of [char] + endof                      \ keypad +
                    271:         58 of 0d endof                            \ keypad Enter
1.1.1.2 ! root      272:         89 of [char] \ endof                      \ japanese yen
1.1       root      273:         dup of false endof                        \ other keys are false
                    274:      endcase
                    275:      to ret                                        \ store char
                    276:      led-state CapsLk and 0 <> if                  \ if CapsLk is on
                    277:         scancode 03 > if                          \ from a to z ?
                    278:             scancode 1e < if
                    279:                 ret 20 - to ret                   \ to Upper case
                    280:             then
                    281:         then
                    282:      then
                    283:      is-shift if                                   \ if shift is on
                    284:         scancode 03 > if                          \ from a to z ?
                    285:             scancode 1e < if
                    286:                 ret 20 - to ret                   \ to Upper case
                    287:             else
                    288:                 scancode
                    289:                 case                              \ translate scan code --> char
                    290:                     1e of [char] ! endof
                    291:                     1f of [char] @ endof
                    292:                     20 of [char] # endof
                    293:                     21 of [char] $ endof
                    294:                     22 of [char] % endof
                    295:                     23 of [char] ^ endof
                    296:                     24 of [char] & endof
                    297:                     25 of [char] * endof
                    298:                     26 of [char] ( endof
                    299:                     27 of [char] ) endof
                    300:                     2d of [char] _ endof
                    301:                     2e of [char] + endof
                    302:                     2f of [char] { endof
                    303:                     30 of [char] } endof
                    304:                     31 of [char] | endof
                    305:                     33 of [char] : endof
                    306:                     34 of [char] " endof
                    307:                     35 of [char] ~ endof
                    308:                     36 of [char] < endof
                    309:                     37 of [char] > endof
                    310:                     38 of [char] ? endof
                    311:                     dup of ret endof              \ other keys are no change
                    312:                 endcase
1.1.1.2 ! root      313:                 to ret                            \ overwrite new char
1.1       root      314:             then
                    315:         then
                    316:      then
                    317:      led-state NumLk and 0 <> if                   \ if NumLk is on
1.1.1.2 ! root      318:        scancode
1.1       root      319:        case                                        \ translate scan code --> char
                    320:         59 of [char] 1 endof
                    321:         5a of [char] 2 endof
                    322:         5b of [char] 3 endof
                    323:         5c of [char] 4 endof
                    324:         5d of [char] 5 endof
                    325:         5e of [char] 6 endof
                    326:         5f of [char] 7 endof
                    327:         60 of [char] 8 endof
                    328:         61 of [char] 9 endof
                    329:         62 of [char] 0 endof
                    330:         63 of [char] . endof                      \ keypad .
                    331:         dup of ret endof                          \ other keys are no change
                    332:        endcase
1.1.1.2 ! root      333:        to ret                                      \ overwrite new char
1.1       root      334:      then
                    335:      ret                                           \ return char
                    336: ;
                    337: 
                    338: : key-available? ( -- true|false )
1.1.1.2 ! root      339:    multi-key 0 <> IF
1.1       root      340:       true \ multi scan code key was pressed... so key is available
                    341:       EXIT \ done
                    342:    THEN
1.1.1.2 ! root      343:    kbd-scan 0 = IF      \ if no kbd-scan code is currently available
        !           344:       kbd-get-report    \ check for new scan codes
1.1       root      345:    THEN
1.1.1.2 ! root      346:    kbd-scan 0 <>        \ if a kbd-scan is available, report true, else false
1.1       root      347: ;
                    348: 
1.1.1.2 ! root      349: : usb-kread ( -- char|false )                     \ usb key read for control transfer
        !           350:    multi-key 0 <> if                              \ if multi scan code key is pressed
        !           351:       multi-key ff and                            \ read one byte from buffer
        !           352:       multi-key 8 rshift to multi-key             \ move to next byte
        !           353:    else                                           \ normal key check
        !           354:       \ check for new scan code only, if kbd-scan is not set, e.g.
        !           355:       \ by a previous call to key-available?
        !           356:       kbd-scan 0 = IF
        !           357:          kbd-get-report                           \ read scan-code report
        !           358:       THEN
        !           359:       kbd-scan 0 <> if                            \ scan code exist?
        !           360:          begin kbd-scan ff and dup 00 = while     \ get a last scancode in report buffer
        !           361:             kbd-scan 8 rshift to kbd-scan         \ This algorithm is wrong --> must be fixed!
        !           362:             drop                                  \ KBD doesn't set scancode in pressed order!!!
        !           363:          repeat
        !           364:          ff and dup to kbd-scan                   \ we can only digest one key at a time
        !           365:          dup key-old <> if                        \ if the scancode is new
        !           366:             dup to key-old                        \ save current scan code
        !           367:             get-ukbd-char                         \ translate scan code --> char
        !           368:             milliseconds fa + to expire-ms        \ set typematic delay 250ms
        !           369:          else                                     \ scan code is not changed
        !           370:             milliseconds expire-ms > if           \ if timer is expired ... should be considered timer carry over
        !           371:                get-ukbd-char                      \ translate scan code --> char
        !           372:                milliseconds 21 + to expire-ms     \ set typematic rate 30cps
        !           373:             else                                  \ timer is not expired
        !           374:                drop false                         \ do nothing
        !           375:             then
        !           376:          then
        !           377:          kbd-scan 8 rshift to kbd-scan            \ handled scan-code
        !           378:       else
        !           379:          0 to key-old                             \ clear privious key
        !           380:          false                                    \ no scan code --> return false
        !           381:       then
        !           382:    then
1.1       root      383: ;
                    384: 
                    385: 
                    386: : key-read ( -- char )
                    387:     0 begin drop usb-kread dup 0 <> until                \ read key input (Interrupt transfer)
                    388: ;
                    389: 
                    390: 
                    391: : read ( addr len -- actual )
                    392:    0= IF drop 0 EXIT THEN
                    393:    usb-kread ?dup  IF  swap c! 1  ELSE  0 swap c! -2  THEN
                    394: ;
                    395: 
1.1.1.2 ! root      396: (kbd-buf-init)
1.1       root      397: kbd-init                                                 \ keyboard initialize
                    398: milliseconds to expire-ms                                \ Timer initialize
                    399: 0 to multi-key                                           \ multi key buffer clear
                    400: 7 set-led                                                \ flash leds
                    401: 250 ms
                    402: 0 set-led
1.1.1.2 ! root      403: (kbd-buf-free)
1.1       root      404: 
                    405: s" keyboard" get-node node>path set-alias
                    406: 
                    407: : open ( -- true )
1.1.1.2 ! root      408:    (kbd-buf-init)
1.1       root      409:    7 set-led
                    410:    100 ms
                    411:    3 set-led
                    412:    100 ms
                    413:    1 set-led
                    414:    100 ms
                    415:    \ read once from keyboard before actually using it
                    416:    usb-kread drop
                    417:    0 set-led
                    418:    true
                    419: ;
                    420: 
1.1.1.2 ! root      421: : close
        !           422:    (kbd-buf-free)
        !           423: ;
        !           424: 
        !           425: 
        !           426: s" Keyboard init done"  usb-debug-print

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.