245 lines
7.3 KiB
Forth
245 lines
7.3 KiB
Forth
\ *****************************************************************************
|
|
\ * 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
|