ENDCASE
; immediate
+\ We basically try to open the file in read-only mode. That seems to
+\ be the best that we can do with ANSI C. If we ever want to do
+\ something more sophisticated, like calling access(2), we must create
+\ a proper primitive. (OTOH, portable programs can't assume much
+\ about FILE-STATUS and non-portable programs could create a custom
+\ function for access(2).)
+: FILE-STATUS ( c-addr u -- 0 ior )
+ r/o bin open-file ( fileid ior1 )
+ ?dup
+ IF nip 0 swap ( 0 ior1 )
+ ELSE close-file 0 swap ( 0 ior2 )
+ THEN
+;
+
privatize
include? [if] condcomp.fth
include? save-input save-input.fth
include? read-line file.fth
+include? require require.fth
\ load floating point support if basic support is in kernel
exists? F*
--- /dev/null
+\ REQUIRE and REQUIRED
+\
+\ This code is part of pForth.
+\
+\ The pForth software code is dedicated to the public domain,
+\ and any third party may reproduce, distribute and modify
+\ the pForth software code or any derivative works thereof
+\ without any compensation or license. The pForth software
+\ code is provided on an "as is" basis without any warranty
+\ of any kind, including, without limitation, the implied
+\ warranties of merchantability and fitness for a particular
+\ purpose and their equivalents under the laws of any jurisdiction.
+
+private{
+
+\ Has the file with name C-ADDR/U already been included?
+\
+\ This searches the "::::<filename>" marker created by INCLUDED. This
+\ works for now, but may break if pForth ever receives wordlists.
+: INCLUDED? ( c-addr u -- flag )
+ s" ::::" here place ( c-addr u )
+ here $append ( )
+ here find nip 0<> ( found? )
+;
+
+\ FIXME: use real PARSE-NAME when available
+: (PARSE-NAME) ( "word" -- c-addr u ) bl parse-word ;
+
+}private
+
+: REQUIRED ( i*x c-addr u -- j*x ) 2dup included? IF 2drop ELSE included THEN ;
+: REQUIRE ( i*x "name" -- i*x ) (parse-name) required ;
+
+privatize
variable TRACE-INCLUDE
: INCLUDE.MARK.START ( c-addr u -- , mark start of include for FILE?)
- " ::::" pad $MOVE
- pad $APPEND
- pad ['] noop (:)
+ dup 5 + allocate throw >r
+ " ::::" r@ $move
+ r@ $append
+ r@ ['] noop (:)
+ r> free throw
;
: INCLUDE.MARK.END ( -- , mark end of include )
true fp-require-e !
-true value verbose
+false value verbose
: testing
verbose IF
: s= compare 0= ;
: $" state IF postpone s" else ['] s" execute THEN ; immediate
-\ FIXME: stubs for missing definitions
-: file-status 2drop 0 -1 ;
-
TESTING File Access word set
DECIMAL
\ Tidy the test folder
T{ fn3 DELETE-FILE DROP -> }T
+\ ------------------------------------------------------------------------------
+TESTING REQUIRED REQUIRE INCLUDED
+\ Tests taken from Forth 2012 RfD
+
+T{ 0 S" t_required_helper1.fth" REQUIRED
+ REQUIRE t_required_helper1.fth
+ INCLUDE t_required_helper1.fth
+ -> 2 }T
+
+T{ 0 INCLUDE t_required_helper2.fth
+ S" t_required_helper2.fth" REQUIRED
+ REQUIRE t_required_helper2.fth
+ S" t_required_helper2.fth" INCLUDED
+ -> 2 }T
+
\ ----------------------------------------------------------------------------
TESTING two buffers available for S" and/or S\" (Forth 2012)
--- /dev/null
+\ For testing REQUIRED etc
+
+1+
--- /dev/null
+\ For testing REQUIRED etc
+
+1+