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