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 !
|
