[openfirmware] r1638 - cpu/x86/pc/olpc/via ofw/fs/cifs
svn at openfirmware.info
svn at openfirmware.info
Tue Dec 29 00:21:07 CET 2009
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
;
More information about the openfirmware
mailing list