[gforth] / gforth / fixpath.fs

gforth: gforth/fixpath.fs

1 :	pazsan	1.1	\ fix path in gforth*.exe
2 :
3 :			." Fixing " 3 arg type ." with " 2 arg type cr
4 :
5 :			$7410 Constant gforth.exe
6 :			$68D0 Constant gforth-fast.exe
7 :			$81E0 Constant gforth-ditc.exe
8 :
9 :			include string.fs
10 :
11 :			Variable path$ 2 arg path$ $!
12 :			Variable pathes$ 2 arg pathes$ $!
13 :			Variable exe$
14 :
15 :			pathes$ 1 1 $del
16 :			s" //" pathes$ 0 $ins
17 :			: fixpathes ( addr u -- )
18 :			bounds ?DO I c@ '\ = IF '/ I c! THEN LOOP ;
19 :			pathes$ $@ fixpathes
20 :			s" .:" pathes$ 0 $ins
21 :
22 :			: fix-exe ( offset addr u -- )
23 :			path$ $@ exe$ $! s" \" exe$ $+! exe$ $+!
24 :			exe$ $@ r/w bin open-file throw >r
25 :			0 r@ reposition-file throw
26 :			pathes$ $@ 2dup + 0 swap c! 1+ r@ write-file throw
27 :			r> close-file throw ;
28 :
29 :			3 arg evaluate 3 arg fix-exe
30 :
31 :			bye