Diff for /gforth/kernel/paths.fs between versions 1.14 and 1.15

version 1.14, 2000/06/17 20:18:15 version 1.15, 2000/08/17 12:46:59
Line 37 Line 37
 \ It is possible to use the search mechanism on yourself.  \ It is possible to use the search mechanism on yourself.
   
 \ Make a buffer for the path:  \ Make a buffer for the path:
 \ create mypath 100 chars ,     \ maximum length (is checked)  \ create mypath 100 path,
 \               0 ,             \ real len  
 \               100 chars allot \ space for path  
 \ use the same functions as above with:  
 \ mypath path+   \ mypath path+ 
 \ mypath path=  \ mypath path=
 \ mypath .path  \ mypath .path
Line 51 Line 48
   
 \ questions to: wilke@jwdt.com  \ questions to: wilke@jwdt.com
   
   : path-allot ( umax -- )
       \G @code{Allot} a path with @i{umax} characters capacity, initially empty.
       chars dup , 0 , allot ;
   
 [IFUNDEF] +place  [IFUNDEF] +place
 : +place ( adr len adr )  : +place ( adr len adr )
         2dup >r >r          2dup >r >r
Line 64 Line 65
 [THEN]  [THEN]
   
 create sourcepath 1024 chars , 0 , 1024 chars allot \ !! make this dynamic  create sourcepath 1024 chars , 0 , 1024 chars allot \ !! make this dynamic
 sourcepath avalue fpath  sourcepath avalue fpath ( -- path-addr ) \ gforth
   \ The path Gforth uses for @code{included} and friends.
   
 : also-path ( adr len path^ -- )  : also-path ( c-addr len path-addr -- ) \ gforth
       \G add the directory @i{c-addr len} to @i{path-addr}.
   >r    >r
   \ len check    \ len check
   r@ cell+ @ over + r@ @ u> ABORT" path buffer too small!"    r@ cell+ @ over + r@ @ u> ABORT" path buffer too small!"
Line 74  sourcepath avalue fpath Line 77  sourcepath avalue fpath
   tuck r@ cell+ dup @ cell+ + swap cmove    tuck r@ cell+ dup @ cell+ + swap cmove
   \ make delimiter    \ make delimiter
   0 r@ cell+ dup @ cell+ + 2 pick + c! 1 + r> cell+ +!    0 r@ cell+ dup @ cell+ + 2 pick + c! 1 + r> cell+ +!
   ;  ;
   
   : clear-path ( path-addr -- ) \ gforth
       \G Set the path @i{path-addr} to empty.
       0 swap cell+ ! ;
   
 : only-path ( adr len path^ -- )  : only-path ( adr len path^ -- )
   dup 0 swap cell+ ! also-path ;      dup clear-path also-path ;
   
 : path+ ( path-addr  "dir" -- ) \ gforth  : path+ ( path-addr  "dir" -- ) \ gforth
     \G Add the directory @var{dir} to the search path @var{path-addr}.      \G Add the directory @var{dir} to the search path @var{path-addr}.
Line 105  sourcepath avalue fpath Line 112  sourcepath avalue fpath
   r> - ;    r> - ;
   
 : previous-path ( path^ -- )  : previous-path ( path^ -- )
       \ !! "fpath previous-path" doesn't work
   dup path>counted    dup path>counted
   BEGIN tuck dup WHILE repeat ;    BEGIN tuck dup WHILE repeat ;
   
Line 187  Create tfile 0 c, 255 chars allot Line 195  Create tfile 0 c, 255 chars allot
   r> r> ofile +place    r> r> ofile +place
   open-ofile ;    open-ofile ;
   
   \ !! allow arbitrary FAMs, not just R/O
 : open-path-file ( addr1 u1 path-addr -- wfileid addr2 u2 0 | ior ) \ gforth  : open-path-file ( addr1 u1 path-addr -- wfileid addr2 u2 0 | ior ) \ gforth
     \G Look in path @var{path-addr} for the file specified by @var{addr1 u1}.      \G Look in path @var{path-addr} for the file specified by @var{addr1 u1}.
     \G If found, the resulting path and an open file descriptor      \G If found, the resulting path and and (read-only) open file descriptor
     \G are returned. If the file is not found, @var{ior} is non-zero.      \G are returned. If the file is not found, @var{ior} is non-zero.
   >r    >r
   2dup absolut-path?    2dup absolut-path?

Removed from v.1.14  
changed lines
  Added in v.1.15


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>