Menu
▾
▴
win32forth-cvs
|
From: Dirk B. <db...@us...> - 2006-09-30 15:17:39
|
Update of /cvsroot/win32forth/win32forth-stc/src In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv4224/src Modified Files: paths.f primutil.f Log Message: - Made fload, needs, loaded? and friends work correctly with the path search. - The path search stuff is mostly rewritten. Know there are two list's. One for the base-folders and one for the sub-folders to search in. Index: primutil.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/primutil.f,v retrieving revision 1.6 retrieving revision 1.7 diff -C2 -d -r1.6 -r1.7 *** primutil.f 27 Sep 2006 21:38:36 -0000 1.6 --- primutil.f 30 Sep 2006 15:17:33 -0000 1.7 *************** *** 99,109 **** \ ------------------------------------------------------------------------ - ' included alias "fload - ' fload alias include - ' requires alias needs ' dpl alias dp-location - ' postpone alias compile - ' maxbuffer alias max-path --- 99,104 ---- Index: paths.f =================================================================== RCS file: /cvsroot/win32forth/win32forth-stc/src/paths.f,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 *** paths.f 24 Sep 2006 08:32:38 -0000 1.3 --- paths.f 30 Sep 2006 15:17:33 -0000 1.4 *************** *** 174,179 **** INTERNAL - create path-file$ MAX-PATH 1+ allot - : path-source ( path - 2variable_path-source ) \ *G Path-source points to a substring in a path. \n --- 174,177 ---- *************** *** 183,198 **** EXTERNAL ! path: path-ptr deprecated ! \ *G The old functionality had the bad habbit to pass a pointer through a ! \ ** value instead of passing the parameter over the stack. \n ! \ ** Use win32forth\src\Compat\OldPaths.f for the old functionality. \n ! \ ** Words like first-path" and next-path" are now able to handle ! \ ** each path separate without saving and restoring a path-ptr. ! ! path: search-path ! \ *G search-path defines the path buffer for Forth.\n Applications that let Forth ! \ ** compile should not change it in a way that Forth is not able too compile. ! ! : next-path" ( path -- a1 n1 ) \ *G Get the next path from dir list. dup>r path-source 2@ 2dup ';' scan 2dup 1 /string r> path-source 2! --- 181,185 ---- EXTERNAL ! : next-path" ( path -- a1 n1 ) \ w32f path \ *G Get the next path from dir list. dup>r path-source 2@ 2dup ';' scan 2dup 1 /string r> path-source 2! *************** *** 204,216 **** ; ! : reset-path-source ( path -- ) \ *G Points the path-source to the whole path. dup>r count r> path-source 2! ; ! : first-path" ( path -- a1 n1 ) \ *G Get the first forth directory path. dup>r reset-path-source r> next-path" ; ! : "path+ ( a1 n1 path -- ) \ *G Append a directory to a path. >r 2dup upper --- 191,203 ---- ; ! : reset-path-source ( path -- ) \ w32f path \ *G Points the path-source to the whole path. dup>r count r> path-source 2! ; ! : first-path" ( path -- a1 n1 ) \ w32f path \ *G Get the first forth directory path. dup>r reset-path-source r> next-path" ; ! : "path+ ( a1 n1 path -- ) \ w32f path \ *G Append a directory to a path. >r 2dup upper *************** *** 227,347 **** then r>drop ; ! : "fpath+ ( a1 n1 -- ) ! \ *G Append a directory to the Forth path. ! search-path "path+ ; - : fpath+ ( -<directory>- ) - \ *G Append a directory to the Forth path. - /parse-s$ count "fpath+ ; ! : .path ( path -- ) ! \ *G Display a directory search path list. ! count ! begin ?dup ! while 2dup ';' scan 2dup 2>r nip - dup char+ ?cr type ! 2r> 1 /string dup ! if ." ;" ! then ! repeat drop ; ! : .fpath ( -- ) ! \ *G Display the Forth directory search path list. ! search-path .path ; ! INTERNAL ! : volume-indication? ( adr - flag ) ! \ *G True when the counted string at adr starts with x: or \\name ! dup 2 + c@ [char] : <> ! if count drop 2 s" \\" compare 0= ! else drop true ! then ! ; 6 PROC SearchPath - : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } - \ *G Find file a1,n1 in a path and return the full path. \n - \ ** a2,n2 and f1=false, succeeded. - a1 n1 MAX-PATH 1+ localalloc ascii-z to filename$ - MAX-PATH 1+ localalloc: searchpath$ - MAX_PATH 1+ LocalAlloc: current$ - current-dir$ count current$ place current$ +null \ save current dir - search-path first-path" - begin dup>r searchpath$ place searchpath$ +null - searchpath$ volume-indication? \ Test for another volume - if searchpath$ char+ $current-dir! \ 0 fails, then try next - else true - then - if 0 \ file component - path-file$ \ found file name buffer - max-path \ size of buffer - defextz$ \ file extension - filename$ \ file name - searchpath$ char+ \ search path - call SearchPath - 0<> if path-file$ zcount false \ path found - current$ char+ $current-dir! - not abort" $current-dir!" \ restore current dir - r>drop exit \ clear the retun stack and exit - then - then - r> - while searchpath$ off search-path next-path" - repeat a1 n1 path-file$ place path-file$ count true \ return input file and error flag - current$ char+ $current-dir! not abort" $current-dir!" \ restore current dir - ; EXTERNAL ! : program-path-init ( -- ) ! \ *G Initialize the Forth directory search path list. Automatically done at program ! \ ** initialization and when Paths.f is loaded. ! search-path off \ clear path list ! s" %CURRENTDIR%" "fpath+ ! s" %FORTHDIR%" "fpath+ ! s" %APPDIR%" "fpath+ ! s" src" "fpath+ ! s" src\lib" "fpath+ ! \ s" src\tools" "fpath+ \ this is causing problems when compiling the IDE... ! s" src\gdi" "fpath+ \ GDI class library ! s" src\res" "fpath+ ! s" src\console" "fpath+ ! \ s" demos" "fpath+ ! s" doc" "fpath+ \ last ! ; ! program-path-init ! INITIALIZATION-CHAIN CHAIN-ADD PROGRAM-PATH-INIT ! : "path-file { a1 n1 \ current$ -- a2 n2 f1 } ! \ *G Find file a1,n1 in the Forth path and return the full path. \n ! \ ** a2,n2 and f1=false, succeeded. ! \ first try it in the current directory ! a1 n1 search-path full-path ! -if 3drop \ then try it in the forth directory ! a1 n1 search-path full-path ! then ; ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ "open with Multiple directory path search ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! create open-path$ MAXSTRING allot ! : n"open ( a1 n1 -- handle f1 ) ! \ *G Open file a1,n1 with a Forth path search. ! "path-file ! if 2drop 0 -1 ! else 2dup open-path$ place \ save full path ! _"open \ open file ! then ; ! ' n"open is "open \ link multi-path open word into system \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 214,338 ---- then r>drop ; ! in-system + : .path ( path -- ) \ w32f path system + \ *G Display a directory search path list. + \ ** Note: The path source will be resetted for this path. + dup >r first-path" + begin dup + if 2dup cr type + then nip + while r@ next-path" + repeat r> reset-path-source ; + in-application ! INTERNAL ! : volume-indication? ( addr - flag ) ! \ True when the counted string at adr starts with x: or \\name ! dup 2 + c@ [char] : <> ! if count drop 2 s" \\" compare 0= ! else drop true ! then ; + : save-current ( current$ -- ) + \ save current dir + dup current-dir$ count rot place +null ; ! : restore-current ( current$ -- ) ! \ Restore current dir ! char+ $current-dir! not abort" $current-dir!" ; ! create path-file$ MAX-PATH 1+ allot ! ! : search-error ( addr -- ) ! \ return input file and error flag ! count path-file$ place path-file$ count ! true ; 6 PROC SearchPath EXTERNAL ! : full-path { a1 n1 path \ searchpath$ filename$ current$ -- a2 n2 f1 } ! \ *G Find the file \i a1,n1 \d in the path \i path \d and return the full path. ! \ ** \i a2,n2 \d . \i f1 \d = false if succeeded. ! a1 n1 MAX-PATH 1+ LocalAlloc ascii-z to filename$ \ save file name ! MAX_PATH 1+ LocalAlloc: current$ ! current$ save-current \ save current dir ! MAX-PATH 1+ LocalAlloc: searchpath$ ! path first-path" ! begin dup ! if searchpath$ place searchpath$ +null + searchpath$ volume-indication? \ Test for another volume + if searchpath$ char+ $current-dir! \ 0 fails, then try next + else true + then ! if path-file$ off ! 0 \ file component ! path-file$ \ found file name buffer ! max-path \ size of buffer ! defextz$ \ file extension ! filename$ \ file name ! searchpath$ char+ \ search path ! call SearchPath 0<> ! if path-file$ zcount false \ path found ! current$ restore-current \ restore current dir ! exit \ and exit ! else true \ try next path... ! then ! then ! else nip ! then ! while path next-path" ! repeat ! current$ restore-current \ restore current dir ! filename$ search-error ; \ return input file and error flag ! : find-path { a1 n1 basepath path \ filename$ current$ search-current$ -- a2 n2 f1 } ! \ *G Find the file \i a1,n1 \d in the path \i basepath \d by scanning the sub folders ! \ ** defined in \i path \d. Returns the full path of the file if possible. ! \ ** \i a2,n2 \d . \i f1 \d = false if succeeded. ! \ Note: We have to save the file name in a temporay buffer, ! \ because a1 n2 can point to the internal buffer new$ and ! \ this buffer can be changed during the search (by current-dir$ ! \ for example). ! MAX-PATH 1+ LocalAlloc: filename$ ! a1 n1 filename$ place \ save file name ! ! MAX_PATH 1+ LocalAlloc: current$ ! current$ save-current \ save current dir ! ! MAX_PATH 1+ LocalAlloc: search-current$ + basepath first-path" + begin dup + if \ set the next base folder we shall look in + search-current$ place search-current$ +null + search-current$ char+ $current-dir! + + \ and try to find the file in this folder + if filename$ count path full-path 0= + if current$ restore-current + 0 exit \ we found the file !!! + else 2drop true \ try the next folder... + then + then + else nip + then + while basepath next-path" + repeat + + current$ restore-current \ restore current dir + filename$ search-error ; \ return input file and error flag \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 392,403 **** \ ** n2=0 means not in search path. dup>r reset-path-source ! begin r@ path-source 2@ nip 0> ! if r@ next-path" 4dup IsPathRelativeTo? not ! else over 0 false ! then ! while 2drop ! repeat ! 2nip r>drop ! ; : FindRelativeName ( a1 n1 path - a2 n2 f ) --- 383,392 ---- \ ** n2=0 means not in search path. dup>r reset-path-source ! begin r@ path-source 2@ nip 0> ! if r@ next-path" 4dup IsPathRelativeTo? not ! else over 0 false ! then ! while 2drop ! repeat 2nip r>drop ; : FindRelativeName ( a1 n1 path - a2 n2 f ) *************** *** 405,415 **** \ ** n2=0 means not in search path. >r 2dup r> FindRelativePath dup 0> ! if nip dup 3 > ! if 1+ ! then ! /string true ! else 2drop false ! then ! ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ --- 394,473 ---- \ ** n2=0 means not in search path. >r 2dup r> FindRelativePath dup 0> ! if nip dup 3 > ! if 1+ then ! /string true ! else 2drop false ! then ; ! ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! \ FILE-REL>ABS with Multiple directory path search ! \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ ! ! path: search-base-path \ w32f path ! \ *G The path buffer for the base search folders for Forth.\n ! \ ** Applications that let Forth compile should not change it. ! ! path: search-path \ w32f path ! \ *G The path buffer for the sub folders to search in. ! \ ** Applications that let Forth compile should not change it. ! ! in-system ! ! : "fbase-path+ ( a1 n1 -- ) \ w32f path ! \ *G Append a directory to the Forth search base path. ! search-base-path "path+ ; ! ! : fbase-path+ ( -<directory>- -- ) \ w32f path system ! \ *G Append a directory to the Forth search base path. ! /parse-s$ count "fbase-path+ ; ! ! : "fpath+ ( a1 n1 -- ) \ w32f path ! \ *G Append a directory to the Forth search path. ! search-path "path+ ; ! ! : fpath+ ( -<directory>- -- ) \ w32f path system ! \ *G Append a directory to the Forth search path. ! /parse-s$ count "fpath+ ; ! ! : .fpath ( -- ) \ w32f path system ! \ *G Display the Forth directory search path list. ! cr ." Base path: " search-base-path .path ! cr ." Search path: " search-path .path ; ! ! in-application ! ! : program-path-init ( -- ) ! \ *G Initialize the Forth directory search path list. Automatically done at program ! \ ** initialization and when Paths.f is loaded. ! search-base-path off \ clear path list ! s" %CURRENTDIR%" "fbase-path+ ! s" %FORTHDIR%" "fbase-path+ ! s" %APPDIR%" "fbase-path+ ! ! search-path off \ clear path list ! s" ." "fpath+ \ current dir is first ! s" src" "fpath+ ! s" src\lib" "fpath+ ! s" src\gdi" "fpath+ \ GDI class library ! s" src\tools" "fpath+ ! s" src\res" "fpath+ ! s" src\console" "fpath+ ! s" demos" "fpath+ ! s" doc" "fpath+ \ last ! ; ! ! program-path-init ! INITIALIZATION-CHAIN CHAIN-ADD PROGRAM-PATH-INIT ! ! : "path-file ( a1 n1 -- a2 n2 f1 ) ! \ *G Find file a1,n1 in the Forth search path and return the full path. \n ! \ ** a2,n2 and f1=false, succeeded. ! search-base-path search-path find-path ; ! ! :noname ( addr len -- addr1 len1 ) ! \ *G Turn rel file name into abs file name with Forth path search. ! "path-file drop ! 2dup tempfile place \ save full path (for LINKFILE) ! ; is file-rel>abs \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ *************** *** 418,424 **** : Prepend<home>\ ( a1 n1 -- a2 n2 ) &forthdir count MakeAbsolutePath count ; - \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ "LOADED? \LOADED- \LOADED NEEDS --- 476,482 ---- : Prepend<home>\ ( a1 n1 -- a2 n2 ) + \ *G Make the rel file absoulute to the forth directory. &forthdir count MakeAbsolutePath count ; \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ "LOADED? \LOADED- \LOADED NEEDS *************** *** 427,463 **** in-system ! : "LOADED? ( addr len -- flag ) ! \ *G True if a file addr len is loaded. The filename must contain a full path. ! CONTEXT @ >R \ save context ! files \ set context ! CONTEXT @ SEARCH-WORDLIST \ search for word ! IF DROP TRUE ELSE FALSE THEN \ correct the flag ! R> CONTEXT ! ! ; - : LOADED? ( -<name>- -- flag ) { \ current$ } - \ *G True if the following file is loaded. The filename may be relative. MAX_PATH 1+ LocalAlloc: current$ ! current-dir$ count current$ place \ get current dir ! current$ ?+\ \ append '\' ! new$ >r /parse-s$ count r@ place \ store file name ! r@ ?defext r> count \ add default ext if needed ! "path-file drop \ extend to full path ! "loaded? ; ! : \LOADED- ( -<name>- ) \ *G If the following file IS NOT LOADED interpret line. loaded? if postpone \ then ; ! : \LOADED ( -<name>- ) \ *G If the following file IS LOADED interpret line. loaded? 0= if postpone \ then ; ! \ : NEEDS ( -<name>- ) ! \ *G Conditionally load file "name" if not loaded. ! \ >in @ loaded? 0= if >in ! fload else drop then ; ! synonym Require needs ! \ *G Forth 200X name for needs. in-application --- 485,531 ---- in-system ! : ("LOADED?) ( addr len -- flag ) \ w32f path system ! \ *G Returns true if the file addr len is loaded. ! \ ** The filename must contain a full path. ! ['] files >body search-wordlist \ search for file name ! if drop true else false then ; ! ! : "LOADED? ( addr len -- flag ) \ w32f path system ! \ *G Returns true if the file addr len is loaded. ! { \ current$ } MAX_PATH 1+ LocalAlloc: current$ ! current$ place \ store file name ! current$ ?defext \ add default ext if needed ! current$ count "path-file drop \ extend to full path ! ("LOADED?) ; \ search for file name ! ! : LOADED? ( -<name>- -- flag ) \ w32f path system ! \ *G Returns true if the file addr len is loaded. ! /parse-s$ count "loaded? ; ! ! : \LOADED- ( -<name>- ) \ w32f path system \ *G If the following file IS NOT LOADED interpret line. loaded? if postpone \ then ; ! : \LOADED ( -<name>- ) \ w32f path system \ *G If the following file IS LOADED interpret line. loaded? 0= if postpone \ then ; ! : REQUIRED ( addr len -- ) ! \ *G Load the file \i addr len \d only if it's not loaded. ! 2dup "LOADED? \ search for file name ! if 2drop \ no, don't load ! else included \ load the file ! then ; ! : REQUIRES ( -<filename>- ) ! \ *G Load the file \i filename \d only if it's not loaded. ! /parse-s$ count required ; ! ! ' requires alias NEEDS ! ' included alias "FLOAD ! ' fload alias INCLUDE in-application |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X