[SLOF] [PATCH 3/4] Add a global "dir" method

Benjamin Herrenschmidt benh at kernel.crashing.org
Thu Jul 7 12:09:52 AEST 2016


This adds a method akin to "boot" and "load" which takes the subsequent
command line arguments, parses them as a device specification and
calls the dir method on said device

Signed-off-by: Benjamin Herrenschmidt <benh at kernel.crashing.org>
---
 slof/fs/boot.fs               | 15 ++++++++++++
 slof/fs/packages/fat-files.fs | 56 ++++++++++++++++++++++++++++++++++---------
 2 files changed, 60 insertions(+), 11 deletions(-)

diff --git a/slof/fs/boot.fs b/slof/fs/boot.fs
index e99a164..e436380 100644
--- a/slof/fs/boot.fs
+++ b/slof/fs/boot.fs
@@ -174,6 +174,21 @@ defer go ( -- )
 \ Generic device load method:
 \ *
 
+: do-dir ( devstr len -- )
+  cr ." Directory of: " 2dup type ."  ... "
+  open-dev dup IF
+    s" dir" 2 pick ['] $call-method CATCH IF
+       ." no dir method on target !" cr
+       3drop
+    THEN
+    close-dev cr
+  ELSE drop THEN
+;
+
+: dir ( "{devstring}" -- )
+    parse-word de-alias do-dir
+;
+
 : do-load ( devstr len -- img-size )	\ Device method wrapper
    use-load-watchdog? IF
       \ Set watchdog timer to 10 minutes, multiply with 2 because DHCP
diff --git a/slof/fs/packages/fat-files.fs b/slof/fs/packages/fat-files.fs
index 9e389eb..e5b08bd 100644
--- a/slof/fs/packages/fat-files.fs
+++ b/slof/fs/packages/fat-files.fs
@@ -33,6 +33,8 @@ INSTANCE VARIABLE root-offset
 INSTANCE VARIABLE cluster-offset
 INSTANCE VARIABLE #clusters
 
+INSTANCE VARIABLE dir?
+
 : seek  s" seek" $call-parent ;
 : read  s" read" $call-parent ;
 
@@ -54,7 +56,7 @@ CREATE fat-buf 8 allot
   fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed"
   fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split
   rot IF swap THEN drop ;
-  
+
 INSTANCE VARIABLE next-cluster
 
 : read-cluster ( cluster# -- )
@@ -129,14 +131,35 @@ CREATE dos-name b allot
 : find-file ( dir-cluster name len -- cluster file-len is-dir? true | false )
   make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE
   next-cluster @ read-cluster REPEAT false ELSE true THEN ;
-: find-path ( dir-cluster name len -- cluster file-len true | false )
-  dup 0= IF 3drop false ."  empty name " EXIT THEN
-  over c@ [char] \ = IF 1 /string  RECURSE EXIT THEN
-  [char] \ split 2>r find-file 0= IF 2r> 2drop false ."  not found " EXIT THEN
-  r@ 0<> <> IF 2drop 2r> 2drop false ."  no dir<->file match " EXIT THEN
-  r@ 0<> IF drop 2r> RECURSE EXIT THEN
-  2r> 2drop true ;
-  
+
+: find-path ( dir-cluster name len -- cluster file-len is-dir? true | false )
+  dup 0= IF
+    \ empty name, assume directory
+    2drop 0 true true EXIT
+  THEN
+  \ Strip leading backslashes
+  over c@ [char] \ = IF
+    1 /string  RECURSE EXIT
+  THEN
+  \ Split at backslash
+  [char] \ split
+  \ Store right side on return stack
+  2>r
+  find-file
+  0= IF
+    2r> 2drop false ."  not found " EXIT
+  THEN
+  \ right side (from stack) has non-0 len, must be a dir
+  dup 0= r@ 0<> and IF
+     3drop 2r> 2drop false ." path component not a dir " EXIT
+  THEN
+  r@ 0<> IF
+    2drop 2r> RECURSE EXIT
+  THEN
+  2r> 2drop
+  true
+;
+
 : do-super ( -- )
   0 200 read-data
   data @ 0b + 2c@ bwjoin bytes/sector !
@@ -203,7 +226,18 @@ INSTANCE VARIABLE pos-in-data
   file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ;
 
 : close  free-data ;
+
+: dir
+  dir? @ IF file-cluster @ .dir ELSE ." not a directory!" cr THEN
+  ;
+
 : open
   do-super
-  0 my-args find-path 0= IF close false EXIT THEN
-  file-len !  file-cluster !  0 0 seek 0= ;
+  0 my-args find-path
+  0= IF free-data false EXIT
+  THEN
+  dir? ! file-len !  file-cluster !
+  dir? @ IF
+    0 0 seek 0=
+  ELSE true THEN
+;
-- 
2.7.4



More information about the SLOF mailing list