Add submodule dependency filesHEADmaster

Change-Id: Iaf8d18082d3991dec7c0ebbea540f092188eb4ec

1 files changed, 91 insertions, 0 deletions

diff --git a/roms/SLOF/slof/fs/packages/deblocker.fs b/roms/SLOF/slof/fs/packages/deblocker.fs
new file mode 100644
index 000000000..ebed5cf0a
--- /dev/null
+++ b/roms/SLOF/slof/fs/packages/deblocker.fs
@@ -0,0 +1,91 @@
+\ *****************************************************************************
+\ * 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> ;
+
+: write-blocks ( addr block# #blocks -- #writtenblks )
+    s" write-blocks" $call-parent
+;
+
+: write ( addr len -- actual )
+    dup block-size @ mod IF
+        ." ERROR: Can not write partial sector length." cr
+        2drop 0 EXIT
+    THEN
+    block-size @ /                             ( addr #blocks )
+    offset @                                   ( addr #blocks offset )
+    dup block-size @ mod IF
+        ." ERROR: Can not write at partial sector offset." cr
+        3drop 0 EXIT
+    THEN
+    block-size @ / swap                        ( addr block# #blocks )
+    write-blocks                               ( #writtenblks )
+    block-size @ *
+    dup offset +!
+;