[OpenBIOS] r522 - ofw/core
svn at openbios.org
svn at openbios.org
Fri Aug 3 02:57:32 CEST 2007
Author: wmb
Date: 2007-08-03 02:57:32 +0200 (Fri, 03 Aug 2007)
New Revision: 522
Modified:
ofw/core/filecmds.fth
ofw/core/ofwfw.fth
Log:
Integrated OFW device tree "$create-file" into the Forthmacs file interface
wordset so you can say, e.g. "writing <device_specifier>".
Modified: ofw/core/filecmds.fth
===================================================================
--- ofw/core/filecmds.fth 2007-08-03 00:55:32 UTC (rev 521)
+++ ofw/core/filecmds.fth 2007-08-03 00:57:32 UTC (rev 522)
@@ -297,6 +297,13 @@
public
+: $delete1 ( path$ -- )
+ open-directory ?dup 0= abort" Can't open directory" ( name$ dir-ih )
+ >r " $delete!" r@ $call-method abort" Can't delete file" ( r: dir-ih )
+ r> close-dev
+;
+' $delete1 to _ofdelete
+
: $delete-all ( pattern-adr pattern-len -- )
begin-search begin another-match? while ( 8*attributes name$ )
\ Check attributes to see if this is a directory
@@ -438,6 +445,7 @@
r> close-dev ( path$2 )
$open-file
;
+' $create-file to _ofcreate
internal
Modified: ofw/core/ofwfw.fth
===================================================================
--- ofw/core/ofwfw.fth 2007-08-03 00:55:32 UTC (rev 521)
+++ ofw/core/ofwfw.fth 2007-08-03 00:57:32 UTC (rev 522)
@@ -76,10 +76,30 @@
\ succeeds, returns the addresses of routines to perform I/O on the
\ open file and true. If the operation fails, returns false.
+
+defer _ofcreate
+: null-create ( name -- 0 ) 2drop 0 ;
+' null-create to _ofcreate
+
+defer _ofdelete
+' 2drop to _ofdelete
+
: _ofopen
( name mode -- [ fid mode sizeop alignop closeop writeop readop ] okay? )
- >r count open-dev
- dup 0= if r> 2drop false exit then ( fid )
+ >r count ( name$ r: mode )
+ r@ create-flag and if ( name$ r: mode )
+ 2dup ['] _ofdelete catch if 2drop then ( name$ r: mode )
+ then ( name$ r: mode )
+
+ 2dup open-dev ?dup 0= if ( name$ r: mode )
+ r@ r/o = if ( name$ r: mode )
+ 0 ( name$ 0 r: mode )
+ else ( name$ r: mode )
+ 2dup _ofcreate ( name$ ih r: mode )
+ then ( name$ ih r: mode )
+ ?dup 0= if r> 3drop false exit then ( name$ ih r: mode )
+ then ( name$ ih r: mode )
+ nip nip ( ih r: mode )
r@ ['] _ofsize ['] _dfalign ['] _ofclose ['] _ofseek
r@ r/o = if ['] nullwrite else ['] _ofwrite then
r> w/o = if ['] nullread else ['] _ofread then
More information about the OpenBIOS
mailing list