qemu/roms/SLOF/slof/fs/packages/deblocker.fs

   1 \ *****************************************************************************
   2 \ * Copyright (c) 2004, 2008 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
  14 \ =============================================================================
  15 \ =============================================================================
  16
  17
  18 \ The deblocker.  Allows block devices to be used as a (seekable) byte device.
  19
  20 s" deblocker" device-name
  21
  22 INSTANCE VARIABLE offset
  23 INSTANCE VARIABLE block-size
  24 INSTANCE VARIABLE max-transfer
  25 INSTANCE VARIABLE my-block
  26 INSTANCE VARIABLE adr
  27 INSTANCE VARIABLE len
  28 INSTANCE VARIABLE fail-count
  29
  30 : open
  31   s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN
  32   block-size !
  33   s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN
  34   max-transfer !
  35   block-size @ alloc-mem my-block !
  36   0 offset !
  37   true ;
  38 : close  my-block @ block-size @ free-mem ;
  39
  40 : seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying
  41                            \      device would fail at this offset
  42   lxjoin offset !  0 ;
  43 : block+remainder ( -- block# remainder )  offset @ block-size @ u/mod swap ;
  44 : read-blocks ( addr block# #blocks -- actual )  s" read-blocks" $call-parent ;
  45 : read ( addr len -- actual )
  46   dup >r  len ! adr !
  47   \ First, handle a partial block at the start.
  48   block+remainder dup IF ( block# offset-in-block )
  49   >r my-block @ swap 1 read-blocks drop
  50   my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move
  51   r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN
  52
  53   \ Now, in a loop read max. max-transfer sized runs of whole blocks.
  54   0 fail-count !
  55   BEGIN len @ block-size @ >= WHILE
  56     adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks
  57     dup 0= IF
  58       1 fail-count +!
  59       fail-count @ 5 >= IF r> drop EXIT THEN
  60     ELSE
  61       0 fail-count !
  62     THEN
  63     block-size @ * dup negate len +! dup adr +! offset +!
  64   REPEAT
  65
  66   \ And lastly, handle a partial block at the end.
  67   len @ IF my-block @ block+remainder drop 1 read-blocks drop
  68   my-block @ adr @ len @ move THEN
  69
  70   r> ;