Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.5 | \ fix path in gforth*.exe |
| 2 : | |||
| 3 : | anton | 1.13 | \ Copyright (C) 2000,2003,2006,2007,2008 Free Software Foundation, Inc. |
| 4 : | pazsan | 1.5 | |
| 5 : | \ This file is part of Gforth. | ||
| 6 : | |||
| 7 : | \ Gforth is free software; you can redistribute it and/or | ||
| 8 : | \ modify it under the terms of the GNU General Public License | ||
| 9 : | anton | 1.10 | \ as published by the Free Software Foundation, either version 3 |
| 10 : | pazsan | 1.5 | \ of the License, or (at your option) any later version. |
| 11 : | |||
| 12 : | \ This program is distributed in the hope that it will be useful, | ||
| 13 : | \ but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 : | \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 : | \ GNU General Public License for more details. | ||
| 16 : | |||
| 17 : | \ You should have received a copy of the GNU General Public License | ||
| 18 : | anton | 1.10 | \ along with this program. If not, see http://www.gnu.org/licenses/. |
| 19 : | pazsan | 1.5 | |
| 20 : | pazsan | 1.12 | ." Fixing " 1 arg type ." with " pad $1000 get-dir type cr |
| 21 : | pazsan | 1.5 | |
| 22 : | pazsan | 1.8 | : "search s" .:/usr/local" ; |
| 23 : | pazsan | 1.5 | |
| 24 : | include string.fs | ||
| 25 : | |||
| 26 : | pazsan | 1.12 | Variable path$ pad $1000 get-dir path$ $! |
| 27 : | Variable pathes$ pad $1000 get-dir pathes$ $! | ||
| 28 : | pazsan | 1.5 | Variable exe$ |
| 29 : | |||
| 30 : | pazsan | 1.12 | \ pathes$ 1 1 $del s" /cygdrive/" pathes$ 0 $ins |
| 31 : | \ : fixpathes ( addr u -- ) | ||
| 32 : | \ bounds ?DO I c@ '\ = IF '/ I c! THEN LOOP ; | ||
| 33 : | \ pathes$ $@ fixpathes | ||
| 34 : | pazsan | 1.8 | s" .:" pathes$ 0 $ins |
| 35 : | |||
| 36 : | 0 Value #size | ||
| 37 : | 0 Value #file | ||
| 38 : | : fix-exe ( addr u -- ) | ||
| 39 : | path$ $@ exe$ $! s" /" exe$ $+! exe$ $+! | ||
| 40 : | pazsan | 1.5 | exe$ $@ r/w bin open-file throw >r |
| 41 : | pazsan | 1.8 | r@ file-size throw drop to #size |
| 42 : | #size allocate throw to #file | ||
| 43 : | #file #size r@ read-file throw drop | ||
| 44 : | #file #size "search search 2drop #file - | ||
| 45 : | pazsan | 1.5 | 0 r@ reposition-file throw |
| 46 : | pathes$ $@ 2dup + 0 swap c! 1+ r@ write-file throw | ||
| 47 : | r> close-file throw ; | ||
| 48 : | |||
| 49 : | pazsan | 1.12 | 1 arg fix-exe |
| 50 : | pazsan | 1.5 | |
| 51 : | bye |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |