[Win32forth-cvs] win32forth/src/Compat KernelFiles42.f, NONE, 1.1 OldPaths.f, NONE, 1.1

[George H. <geo...@us...>]

Update of /cvsroot/win32forth/win32forth/src/Compat
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv21968/win32forth/src/Compat

Added Files:
	KernelFiles42.f OldPaths.f 
Log Message:
gah:Added files which can optionally be loaded for compatibility with older versions of W32F

--- NEW FILE: KernelFiles42.f ---
\ $Id: KernelFiles42.f,v 1.1 2006/08/17 12:00:29 georgeahubert Exp $

\ G.Hubert Thursday, August 12 2004
\ Public Domain

\ These implementations of the original file words from the V4.2 Kernel
\ are provided for use in testing legacy code. The words are rarely
\ used, even in older applications (since the ANSI words are available).

: FOPEN-FILE    ( addr len fam -- fileid ior )
                  if r/w else r/o then open-file ;

: FMAKE-FILE    ( addr len -- fileid ior )
                  r/w create-file ;

' close-file alias Fclose-file

' read-line alias Fread-line


: FREAD-FILE    ( addr len fileid -- len )
                  read-file drop ;

: FSEEK-FILE    ( offset origin fileid -- ior )
                  2>R s>d r> r> case
                  0 of reposition-file endof
                  1 of advance-file    endof
                  2 of dup file-append >r advance-file r> or endof
                  3drop -1 swap endcase ;

' reposition-file alias FREPOSITION-FILE

\ this function only returns a single precision position, so high part is
\ always zero, and it can't fail, so error is always zero

' file-position alias FFILE-POSITION

--- NEW FILE: OldPaths.f ---
\ Id:$ $

\ G.Hubert Thursday, August 10 2006

\ This file should be included in legacy programs which make use of the earlier (and more
\ limited) functionality provided prior to V6.11.10

warning @ warning off checkstack

create &fpath MAX-PATH 1+ allot     \ a static forth path buffer

&fpath off

&fpath value path-ptr

internal

path: temp-path-ptr

: set-temp-path-ptr ( -- addr )
              path-ptr temp-path-ptr tuck max-path 1+ move ;

: ("path-file) ( addr1 len1 -- addr2 len2 f ) \ might not be needed?
              set-temp-path-ptr full-path ;
external

: Path-source ( -- addr )
              temp-path-ptr path-source ;

: First-path" ( -- addr len )
              set-temp-path-ptr first-path" ;

: Next-path"  ( -- addr len )
              set-temp-path-ptr next-path" ;

module

warning !