qemu/roms/SLOF/board-qemu/slof/virtio-block.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2011 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 \ ." Populating " pwd cr
  14
  15 s" block" device-type
  16
  17 FALSE VALUE initialized?
  18
  19 \ Required interface for deblocker
  20
  21 200 VALUE block-size
  22 8000 CONSTANT max-transfer
  23
  24 INSTANCE VARIABLE deblocker
  25
  26 virtio-setup-vd VALUE virtiodev
  27
  28 \ Quiesce the virtqueue of this device so that no more background
  29 \ transactions can be pending.
  30 : shutdown  ( -- )
  31     initialized? IF
  32         my-phandle node>path open-dev ?dup IF
  33             virtiodev virtio-blk-shutdown
  34             close-dev
  35         THEN
  36         FALSE to initialized?
  37     THEN
  38 ;
  39
  40 \ Basic device initialization - which has only to be done once
  41 : init  ( -- )
  42    virtiodev virtio-blk-init to block-size
  43    TRUE to initialized?
  44    ['] shutdown add-quiesce-xt
  45 ;
  46
  47 \ Read multiple blocks - called by deblocker package
  48 : read-blocks  ( addr block# #blocks -- #read )
  49    virtiodev virtio-blk-read
  50 ;
  51
  52 \ Standard node "open" function
  53 : open  ( -- okay? )
  54    open 0= IF false EXIT THEN
  55    dup initialized? 0= AND IF
  56       init
  57    THEN
  58    0 0 s" deblocker" $open-package dup deblocker ! dup IF
  59       s" disk-label" find-package IF
  60          my-args rot interpose
  61       THEN
  62    THEN
  63    0<>
  64 ;
  65
  66 \ Standard node "close" function
  67 : close  ( -- )
  68    deblocker @ close-package
  69    close
  70 ;
  71
  72 \ Standard node "seek" function
  73 : seek  ( pos.lo pos.hi -- status )
  74    s" seek" deblocker @ $call-method
  75 ;
  76
  77 \ Standard node "read" function
  78 : read  ( addr len -- actual )
  79    s" read" deblocker @ $call-method
  80 ;
  81
  82 \ Set disk alias if none is set yet
  83 : (set-alias)
  84    s" disk" get-next-alias ?dup IF
  85       get-node node>path set-alias
  86    THEN
  87 ;
  88 (set-alias)