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     ! 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.