| \ ***************************************************************************** |
| \ * Copyright (c) 2004, 2008 IBM Corporation |
| \ * All rights reserved. |
| \ * This program and the accompanying materials |
| \ * are made available under the terms of the BSD License |
| \ * which accompanies this distribution, and is available at |
| \ * http://www.opensource.org/licenses/bsd-license.php |
| \ * |
| \ * Contributors: |
| \ * IBM Corporation - initial implementation |
| \ ****************************************************************************/ |
| |
| |
| \ Citrine storage controller. |
| 2dup type |
| |
| device-name s" ide" device-type |
| |
| |
| 3 encode-int s" #address-cells" property |
| 0 encode-int s" #size-cells" property |
| |
| : decode-unit 3 hex-decode-unit ; |
| : encode-unit 3 hex-encode-unit ; |
| |
| |
| : >ioa [ 10 config-l@ -10 and ] LITERAL + ; |
| : ioa@ >ioa rl@-le ; |
| : ioa! >ioa rl!-le ; |
| |
| |
| \ Clear request completion doorbell. |
| 2 228 ioa! |
| |
| \ status |
| CREATE ioasa 200 allot ioasa 200 erase \ can reduce to 8 later |
| |
| \ request/response queue |
| CREATE rrq 100 allot rrq 100 erase \ can be smaller |
| |
| \ data descriptor |
| CREATE ioadl 8 allot |
| |
| \ control block |
| CREATE ioarcb 80 allot ioarcb 80 erase |
| ioarcb dup l! |
| 60708090 ioarcb c + l! \ user handle |
| ioadl ioarcb 2c + l! \ read ioadl |
| ioasa ioarcb 34 + l! 200 ioarcb 38 + w! |
| |
| \ ioa config data (max. 16 devices) |
| CREATE ioacfg 404 allot ioacfg 404 erase |
| CREATE setsupbuff 2c allot |
| setsupbuff 2c erase |
| 2c setsupbuff w! |
| 1 setsupbuff 3 + c! |
| |
| : wait-ready ( -- ) |
| 82800000 214 ioa! |
| 80000000 BEGIN dup 224 ioa@ cr .s dup 8000000 and IF |
| cr ." Unit check on SAS-Controller detected" |
| cr 42c ioa@ . |
| 8 110 ioa! |
| BEGIN cr 0 config-l@ dup . ffffffff <> UNTIL |
| \ ABORT" Unit check on SAS-Controller detected" |
| THEN |
| and |
| UNTIL drop |
| ; |
| |
| \ wait-ready |
| |
| : wait-ioa ( int-mask -- ) BEGIN dup 224 ioa@ and UNTIL drop ; |
| : init-ioa ( -- ) 82800000 214 ioa! 80000000 wait-ioa ; |
| : do-request ( -- ) ioasa 20 erase ioarcb 404 ioa! |
| 2 wait-ioa 2 228 ioa! |
| ; |
| |
| : setup-ioarcb ( rsrc type addr len -- ) |
| tuck 49000000 or ioadl l! ioadl 4 + l! \ setup ioadl |
| ioarcb 20 + l! ioadl ioarcb 2c + l! 8 ioarcb 30 + l! \ set len, ioadl addr |
| ioarcb 3e + c! ioarcb 8 + l! \ set type and resource |
| ioarcb 40 + 40 erase ; |
| |
| : setup-wrioarcb ( rsrc type addr len -- ) |
| tuck 49000000 or ioadl l! ioadl 4 + l! \ setup ioadl |
| ioarcb 1C + l! ioadl ioarcb 24 + l! 8 ioarcb 28 + l! \ set len, ioadl addr |
| ioarcb 3e + c! ioarcb 8 + l! \ set type and resource |
| ioarcb 40 + 40 erase ; |
| |
| : setup-idrrq ( rrq len -- ) |
| c4 ioarcb 42 + c! 8 lshift ioarcb 48 + l! ioarcb 44 + l! ; |
| : do-idrrq ( -- ) -1 1 0 0 setup-ioarcb rrq 100 setup-idrrq do-request ; |
| |
| : setup-query ( len -- ) c5 ioarcb 42 + c! 8 lshift ioarcb 48 + l! ; |
| : do-query ( -- ) -1 1 ioacfg 404 setup-ioarcb 404 setup-query do-request ; |
| |
| : setup-startUnit ( -- ) 1b ioarcb 42 + c! 3 ioarcb 46 + c! ; |
| : do-startUnit ( hndl -- ) 0 0 0 setup-ioarcb setup-startUnit do-request ; |
| |
| : setup-setsupported ( len -- ) 80 ioarcb 40 + c! fb ioarcb 42 + c! 8 lshift ioarcb 48 + l! ; |
| : do-setsupported ( -- ) -1 1 setsupbuff 2c setup-wrioarcb 2c setup-setsupported do-request ; |
| |
| \ ******************************** |
| \ read capacity |
| \ ******************************** |
| CREATE cap 8 allot |
| |
| : setup-cap ( -- ) 25 ioarcb 42 + c! cap 8 erase ; |
| : do-cap ( rsrc addr -- ) |
| >r 0 r> 8 setup-ioarcb setup-cap do-request ; |
| |
| : .id ( id -- ) ." @" lwsplit 2 0.r ." ," wbsplit 2 0.r ." ," 2 0.r ; |
| |
| : .cap ( rsrc -- ) |
| cap do-cap cap l@ cap 4 + l@ * d# 50000000 + d# 100000000 / |
| base @ >r decimal d# 10 /mod 4 .r ." ." 0 .r ." GB" r> base ! ; |
| |
| \ ******************************** |
| \ Test Unit Ready |
| \ ******************************** |
| : setup-test-unit-ready ( -- ) |
| 00 ioarcb 42 + c! \ SCSI cmd: Test-Unit-Ready |
| ; |
| |
| : do-test-unit-ready ( rsrc -- ) |
| 0 0 0 setup-ioarcb ( rsrc type addr len -- ) |
| setup-test-unit-ready |
| do-request |
| ; |
| |
| \ ******************************** |
| \ Check devices |
| \ ******************************** |
| : check-device ( ioacfg-entry -- ) |
| dup 2 + w@ 2001 and 0<> \ generic or raid disk |
| IF \ is an IOA resource ? |
| dup 8 + l@ ( ioacfg-entry rsrc ) \ get resource handle |
| 8 0 |
| DO ( ioacfg-entry rsrc ) |
| dup do-test-unit-ready ( ioacfg-entry rsrc ) |
| ioasa l@ 0= \ read returned status |
| IF |
| LEAVE |
| THEN |
| LOOP |
| drop ( ioacfg-entry ) |
| THEN |
| drop ( ) |
| ; |
| |
| : check-devices ( -- ) |
| ioacfg 4 + ( ioacfg-entry ) \ config block for 16 devices |
| ioacfg c@ 0 \ amount of detected devices |
| ?DO |
| dup |
| check-device ( ioacfg-entry ) |
| 40 + |
| LOOP |
| drop |
| ; |
| |
| \ ******************************** |
| \ Show Devices |
| \ ******************************** |
| : show-device ( ioacfg-entry -- ) |
| cr ." " dup 2 + w@ |
| dup 8000 and IF ." Controller :" THEN |
| dup 2000 and IF ." Disk (RAID Member):" THEN |
| dup 0002 and IF ." Disk (Volume Set) :" THEN |
| 0001 and IF ." Disk (Generic) :" THEN |
| space dup 4 + l@ ffffff and dup ffffff <> IF |
| .id |
| ELSE drop 9 spaces THEN space |
| dup 1c + 8 type space dup 24 + 10 type |
| dup 2 + w@ 8000 and 0= IF |
| space dup 8 + l@ .cap |
| THEN drop |
| ; |
| |
| : show-devices ( -- ) |
| ioacfg 4 + ioacfg c@ 0 |
| ?DO dup show-device 40 + LOOP drop |
| ; |
| |
| : setup-read ( lba len -- ) \ len is in blocks |
| 28 ioarcb 42 + c! |
| swap ioarcb 44 + l! |
| 8 lshift ioarcb 48 + l! |
| ; |
| |
| : do-read ( hndl lba len addr -- ) \ len is in blocks |
| over >r rot >r swap 0 -rot 200 * ( 0 hndl addr len* ) |
| setup-ioarcb r> r> ( lba len ) |
| setup-read do-request |
| ; |
| |
| : make-subnode ( rsrc-type rsrc-handle id -- ) |
| rot 2 and IF \ only device which are part of a RAID should be started |
| over do-startUnit \ at least on citrine there are problems starting |
| \ Generic SCSI devices |
| THEN do-setsupported |
| dup ffffff <> IF |
| \ we need max-#blocks for citrine-disk.fs |
| ( rsrc id ) |
| over cap do-cap cap l@ ( rsrc id max-#blocks ) |
| swap rot swap ( max-#block rsrc id ) \ this is what citrine-disk.fs expects... |
| s" citrine-disk.fs" included |
| ELSE |
| 2drop |
| THEN |
| ; |
| |
| : make-subnodes ( -- ) |
| ioacfg 4 + ioacfg c@ 0 ?DO dup 2 + w@ dup ( ioacfg rsrc-type rsrc-type ) |
| A000 \ 8000 = Resource Subtype is IOA Focal Point. |
| \ 2000 = Device is a member of a data redundancy group (eg. RAID). |
| \ (1000 = Device is designated for use as a hot spare. |
| \ Unfortunately obsidian reports disk which are not part of |
| \ of a RAID also as hot space even if they are not.) |
| \ all these devices should not appeat in DT |
| \ SIS40 page 60 |
| and 0= IF |
| swap dup ( rsrc-type ioacfg ioacfg ) |
| 8 + l@ over 4 + l@ ( rsrc-type ioacfg rsrc-handle rsrc-addr ) |
| ffffff and 2swap swap 2swap ( ioacfg rsrc-type rsrc-handle rsrc-addr ) |
| make-subnode ELSE drop THEN 40 + LOOP drop ; |
| |
| : do-it ( -- ) |
| init-ioa do-idrrq |
| do-query |
| check-devices |
| show-devices |
| ; |
| |
| : setup-shutdown ( -- ) |
| f7 ioarcb 42 + c! 0 ioarcb 48 + l! 0 ioarcb 44 + l! ; |
| : do-shutdown ( -- ) -1 1 0 0 setup-ioarcb setup-shutdown do-request ; |
| |
| : open true ; |
| : close ; |
| |
| : start ['] do-it CATCH IF cr ." Citrine disabled" ELSE make-subnodes THEN ; |
| |
| cr start cr cr |