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 ;