blob: 83cd71278aa4b2607cad5235628f3fd958eace7e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
\ *****************************************************************************
\ * Copyright (c) 2004, 2008 IBM Corporation
\ * All rights reserved.
\ * This program and the accompanying materials
\ * are made available under the terms of the BSD License
\ * which accompanies this distribution, and is available at
\ * http://www.opensource.org/licenses/bsd-license.php
\ *
\ * Contributors:
\ * IBM Corporation - initial implementation
\ ****************************************************************************/
\ =============================================================================
\ =============================================================================
\ The deblocker. Allows block devices to be used as a (seekable) byte device.
s" deblocker" device-name
INSTANCE VARIABLE offset
INSTANCE VARIABLE block-size
INSTANCE VARIABLE max-transfer
INSTANCE VARIABLE my-block
INSTANCE VARIABLE adr
INSTANCE VARIABLE len
INSTANCE VARIABLE fail-count
: open
s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN
block-size !
s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN
max-transfer !
block-size @ alloc-mem my-block !
0 offset !
true ;
: close my-block @ block-size @ free-mem ;
: seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying
\ device would fail at this offset
lxjoin offset ! 0 ;
: block+remainder ( -- block# remainder ) offset @ block-size @ u/mod swap ;
: read-blocks ( addr block# #blocks -- actual ) s" read-blocks" $call-parent ;
: read ( addr len -- actual )
dup >r len ! adr !
\ First, handle a partial block at the start.
block+remainder dup IF ( block# offset-in-block )
>r my-block @ swap 1 read-blocks drop
my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move
r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN
\ Now, in a loop read max. max-transfer sized runs of whole blocks.
0 fail-count !
BEGIN len @ block-size @ >= WHILE
adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks
dup 0= IF
1 fail-count +!
fail-count @ 5 >= IF r> drop EXIT THEN
ELSE
0 fail-count !
THEN
block-size @ * dup negate len +! dup adr +! offset +!
REPEAT
\ And lastly, handle a partial block at the end.
len @ IF my-block @ block+remainder drop 1 read-blocks drop
my-block @ adr @ len @ move THEN
r> ;
|
