Return to deblocker.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / SLOF / slof / fs / packages

Annotation of qemu/roms/SLOF/slof/fs/packages/deblocker.fs, revision 1.1.1.1

1.1       root        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: 
                     29: : open
                     30:   s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN
                     31:   block-size !
                     32:   s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN
                     33:   max-transfer !
                     34:   block-size @ alloc-mem my-block !
                     35:   0 offset !
                     36:   true ;
                     37: : close  my-block @ block-size @ free-mem ;
                     38: 
                     39: : seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying
                     40:                            \      device would fail at this offset
                     41:   lxjoin offset !  0 ;
                     42: : block+remainder ( -- block# remainder )  offset @ block-size @ u/mod swap ;
                     43: : read-blocks ( addr block# #blocks -- actual )  s" read-blocks" $call-parent ;
                     44: : read ( addr len -- actual )
                     45:   dup >r  len ! adr !
                     46:   \ First, handle a partial block at the start.
                     47:   block+remainder dup IF ( block# offset-in-block )
                     48:   >r my-block @ swap 1 read-blocks drop
                     49:   my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move
                     50:   r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN
                     51: 
                     52:   \ Now, in a loop read max. max-transfer sized runs of whole blocks.
                     53:   BEGIN len @ block-size @ >= WHILE
                     54:   adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks
                     55:   block-size @ * dup negate len +! dup adr +! offset +! REPEAT
                     56: 
                     57:   \ And lastly, handle a partial block at the end.
                     58:   len @ IF my-block @ block+remainder drop 1 read-blocks drop
                     59:   my-block @ adr @ len @ move THEN
                     60: 
                     61:   r> ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.