102 lines
2.4 KiB
Forth
102 lines
2.4 KiB
Forth
|
\ *****************************************************************************
|
||
|
\ * Copyright (c) 2011 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
|
||
|
\ ****************************************************************************/
|
||
|
|
||
|
\ ." Populating " pwd cr
|
||
|
|
||
|
s" block" device-type
|
||
|
|
||
|
FALSE VALUE initialized?
|
||
|
|
||
|
\ Required interface for deblocker
|
||
|
|
||
|
200 VALUE block-size
|
||
|
8000 CONSTANT max-transfer
|
||
|
|
||
|
INSTANCE VARIABLE deblocker
|
||
|
|
||
|
virtio-setup-vd VALUE virtiodev
|
||
|
|
||
|
\ Quiesce the virtqueue of this device so that no more background
|
||
|
\ transactions can be pending.
|
||
|
: shutdown ( -- )
|
||
|
initialized? IF
|
||
|
my-phandle node>path open-dev ?dup IF
|
||
|
virtiodev virtio-blk-shutdown
|
||
|
close-dev
|
||
|
THEN
|
||
|
FALSE to initialized?
|
||
|
THEN
|
||
|
;
|
||
|
|
||
|
\ Basic device initialization - which has only to be done once
|
||
|
: init ( -- )
|
||
|
virtiodev virtio-blk-init to block-size
|
||
|
TRUE to initialized?
|
||
|
['] shutdown add-quiesce-xt
|
||
|
;
|
||
|
|
||
|
\ Read multiple blocks - called by deblocker package
|
||
|
: read-blocks ( addr block# #blocks -- #read )
|
||
|
virtiodev virtio-blk-read
|
||
|
;
|
||
|
|
||
|
: write-blocks ( addr block# #blocks -- #written )
|
||
|
\ Do not allow writes to the partition table (GPT is in first 34 sectors)
|
||
|
over 22 < IF
|
||
|
." virtio-blk ERROR: Write access to partition table is not allowed." cr
|
||
|
3drop 0 EXIT
|
||
|
THEN
|
||
|
virtiodev virtio-blk-write
|
||
|
;
|
||
|
|
||
|
\ Standard node "open" function
|
||
|
: open ( -- okay? )
|
||
|
open 0= IF false EXIT THEN
|
||
|
dup initialized? 0= AND IF
|
||
|
init
|
||
|
THEN
|
||
|
0 0 s" deblocker" $open-package dup deblocker ! dup IF
|
||
|
s" disk-label" find-package IF
|
||
|
my-args rot interpose
|
||
|
THEN
|
||
|
THEN
|
||
|
0<>
|
||
|
;
|
||
|
|
||
|
\ Standard node "close" function
|
||
|
: close ( -- )
|
||
|
deblocker @ close-package
|
||
|
close
|
||
|
;
|
||
|
|
||
|
\ Standard node "seek" function
|
||
|
: seek ( pos.lo pos.hi -- status )
|
||
|
s" seek" deblocker @ $call-method
|
||
|
;
|
||
|
|
||
|
\ Standard node "read" function
|
||
|
: read ( addr len -- actual )
|
||
|
s" read" deblocker @ $call-method
|
||
|
;
|
||
|
|
||
|
: write ( addr len -- actual )
|
||
|
s" write" deblocker @ $call-method
|
||
|
;
|
||
|
|
||
|
\ Set disk alias if none is set yet
|
||
|
: (set-alias)
|
||
|
s" disk" get-next-alias ?dup IF
|
||
|
get-node node>path set-alias
|
||
|
THEN
|
||
|
;
|
||
|
(set-alias)
|