From patchwork Thu Jun 9 03:46:46 2016 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Benjamin Herrenschmidt X-Patchwork-Id: 632614 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from lists.ozlabs.org (lists.ozlabs.org [103.22.144.68]) (using TLSv1.2 with cipher AECDH-AES256-SHA (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3rQB7g0DfVz9sf9 for ; Thu, 9 Jun 2016 13:46:55 +1000 (AEST) Received: from ozlabs.org (lists.ozlabs.org [IPv6:2401:3900:2:1::3]) by lists.ozlabs.org (Postfix) with ESMTP id 3rQB7f6bXSzDqST for ; Thu, 9 Jun 2016 13:46:54 +1000 (AEST) X-Original-To: slof@lists.ozlabs.org Delivered-To: slof@lists.ozlabs.org Received: from gate.crashing.org (gate.crashing.org [63.228.1.57]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by lists.ozlabs.org (Postfix) with ESMTPS id 3rQB7b5wl7zDqR3 for ; Thu, 9 Jun 2016 13:46:51 +1000 (AEST) Received: from localhost.localdomain (localhost.localdomain [127.0.0.1]) by gate.crashing.org (8.14.1/8.13.8) with ESMTP id u593kkra032212 for ; Wed, 8 Jun 2016 22:46:47 -0500 Message-ID: <1465444006.2948.24.camel@kernel.crashing.org> From: Benjamin Herrenschmidt To: slof@lists.ozlabs.org Date: Thu, 09 Jun 2016 13:46:46 +1000 X-Mailer: Evolution 3.18.5.2 (3.18.5.2-1.fc23) Mime-Version: 1.0 Subject: [SLOF] [PATCH] Add a global "dir" method X-BeenThere: slof@lists.ozlabs.org X-Mailman-Version: 2.1.22 Precedence: list List-Id: "Patches for https://github.com/aik/SLOF" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: slof-bounces+incoming=patchwork.ozlabs.org@lists.ozlabs.org Sender: "SLOF" 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 ---  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 5d578f1..ac2f141 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# -- ) @@ -130,14 +132,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 ! @@ -204,7 +227,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 +;