[openfirmware] r1638 - cpu/x86/pc/olpc/via ofw/fs/cifs

[svn at openfirmware.info]

Author: wmb
Date: 2009-12-29 00:21:06 +0100 (Tue, 29 Dec 2009)
New Revision: 1638

Modified:
   cpu/x86/pc/olpc/via/factory.fth
   ofw/fs/cifs/smb.fth
Log:
OLPC trac 9931 - Fixed bug in factory.fth related to calling open-file
Forth word instead of similarly-named method in CIFS driver.  Renamed
CIFS methods "open-file" and "close-file" to "do-open" and "do-close"
to avoid the name collision.


Modified: cpu/x86/pc/olpc/via/factory.fth
===================================================================
--- cpu/x86/pc/olpc/via/factory.fth	2009-12-21 15:54:00 UTC (rev 1637)
+++ cpu/x86/pc/olpc/via/factory.fth	2009-12-28 23:21:06 UTC (rev 1638)
@@ -68,12 +68,12 @@
 : put-key+value  ( value$ key$ -- )  cifs-write  put-key-line  ;
 : submit-file  ( subdir$ -- )
    " flush" $call-cifs abort" CIFS flush failed"
-   " close-file" $call-cifs  abort" CIFS close-file failed"
+   " do-close" $call-cifs  abort" CIFS do-close failed"
    tempname$  2swap  " %s\\%s" sprintf  ( new-name$ )
 
    \ Check for preexisting destination file
-   2dup 0 open-file  0=  if             ( new-name$ )
-      close-file drop                   ( new-name$ )
+   2dup 0 " do-open" $call-cifs  0=  if ( new-name$ )
+      " do-close" $call-cifs drop       ( new-name$ )
       ." Error: " type ."  already exists on the server" cr   ( )
       tempname$ $delete drop            ( )
       abort
@@ -85,7 +85,7 @@
    tempname$  2swap  " %s\\%s" sprintf  ( response-name$ )
    d# 10 0 do                           ( response-name$ )
       d# 1000 ms                        ( response-name$ )
-      2dup  0 " open-file" $call-cifs  0=  if         ( response-name$ )
+      2dup  0 " do-open" $call-cifs  0=  if         ( response-name$ )
          2drop                          ( )
          " size" $call-cifs             ( d.size )
          abort" Size is > 4 GB"         ( size )

Modified: ofw/fs/cifs/smb.fth
===================================================================
--- ofw/fs/cifs/smb.fth	2009-12-21 15:54:00 UTC (rev 1637)
+++ ofw/fs/cifs/smb.fth	2009-12-28 23:21:06 UTC (rev 1638)
@@ -105,10 +105,10 @@
 : -xb  ( adr len -- adr' len' byte )
    1 needed  over c@ >r  1 /string r>
 ;
-: -xw  ( adr len -- adr' len' byte )
+: -xw  ( adr len -- adr' len' word )
    2 needed  over le-w@ >r  2 /string r>
 ;
-: -xl  ( adr len -- adr' len' byte )
+: -xl  ( adr len -- adr' len' long )
    4 needed  over le-l@ >r  4 /string r>
 ;
 : drop-b  ( rem$ -- rem$' )  -xb drop  ;
@@ -410,7 +410,7 @@
 \ Good value for access: h# 0002
 \ Bits: 4000: WriteThrough  1000:DontCache  700:LocalityOfReference
 \ 70: SharingMode  7: Access-0:RO,1:WO,2:RW,3:Exec
-: open-file  ( path$ access -- error? )
+: do-open  ( path$ access -- error? )
    h# 02 smb{      ( path$ access )
    +xw             ( path$ )
    attributes +xw  ( path$ )
@@ -434,7 +434,7 @@
    1 smb{  +path}smb  empty-response
 ;
 
-: close-file  ( -- error? )
+: do-close  ( -- error? )
    4 smb{
    fid +xw
    0 +xl  \ Time
@@ -490,16 +490,17 @@
    position nip +xl   ( adr )
    --bytes--          ( adr )
    }smb  if  drop -1 exit  then        ( adr rem$ )
-   d# 12 expect-wcnt                   ( adr rem$' )
-   drop-andx                           ( adr rem$' )
-   drop-w  \ Reserved                  ( adr rem$' )
-   drop-w  \ Data compaction mode      ( adr rem$' )
-   drop-w  \ Reserved                  ( adr rem$' )
-   -xw >r  \ Actual length             ( adr rem$' r: actual )
-   drop-w  \ Offset to data            ( adr rem$' r: actual )
-   drop-w drop-w drop-w drop-w drop-w  ( adr rem$' r: actual )
-   -xw  if  drop-b  then               ( adr rem$' r: actual ) \ Byte count and pad
-   drop swap r@ move  r>               ( actual )
+   over d# 32 - -rot  \ SMB address    ( adr smb-adr rem$ )
+   d# 12 expect-wcnt                   ( adr smb-adr rem$' )
+   drop-andx                           ( adr smb-adr rem$' )
+   drop-w     \ Remaining              ( adr smb-adr rem$' )
+   drop-w     \ Data compaction mode   ( adr smb-adr rem$' )
+   drop-w     \ Reserved               ( adr smb-adr rem$' )
+   -xw >r     \ Actual length          ( adr smb-adr rem$' r: actual )
+   -xw        \ Offset to data         ( adr smb-adr rem$' data-offset r: actual )
+   nip nip                             ( adr smb-adr data-offset r: actual )
+   +                                   ( adr data-adr r: actual )
+   swap r@ move  r>                    ( actual )
    dup 0  position d+ to position      ( actual )
 ;
 : read  ( adr len -- actual )
@@ -537,7 +538,7 @@
    6 expect-wcnt                       ( rem$' )
    drop-andx                           ( rem$' )
    -xw >r  \ Actual length             ( rem$' r: actual )
-\ We don't anything following
+\ We don't need anything following
 \  drop-w  \ Remaining                 ( rem$' )
 \  drop-l  \ Reserved                  ( rem$' )
    2drop  r>                           ( actual )
@@ -811,9 +812,9 @@
    h# 10 and  if  true exit  then    ( )
 
    \ It's a file, so open it - first try to open read/write.
-   pathname$ 2 open-file  if         ( )
+   pathname$ 2 do-open  if         ( )
       \ Failing that, try to open read-only            
-      pathname$ 0 open-file  if      ( )
+      pathname$ 0 do-open  if      ( )
          free-buffers  false exit
       then                           ( )
    then                              ( )
@@ -827,7 +828,7 @@
    then                              ( okay? )
 ;
 : close  ( -- )
-   fid  if  close-file drop  then
+   fid  if  do-close drop  then
    tree-disconnect drop
    free-buffers
 ;