Commit bddb2551 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Fixed compact..

parent 6adb19d8

cross.fs

+11 −21
Original line number Diff line number Diff line
@@ -475,26 +475,16 @@ Create tfile 0 c, 255 chars allot 


: compact.. ( adr len -- adr2 len2 )

    \ deletes phrases like "xy/.." out of our directory name 2dec97jaw

  over >r -1 >r

    over swap

    BEGIN  dup  WHILE

	over c@ pathsep? 

	IF 	r@ -1 =

		IF	r> drop dup >r

		ELSE	2dup 1 /string 

			3 min s" ../" compare

			0=

			IF	r@ over - ( diff )

				2 pick swap - ( dest-adr )

				>r 3 /string r> swap 2dup >r >r

				move r> r>

			ELSE	r> drop dup >r

			THEN

		THEN

        dup >r '/ scan 2dup 4 min s" /../" compare 0=

        IF

            dup r> - >r 4 /string over r> + 4 -

            swap 2dup + >r move dup r> over -

        ELSE

            rdrop dup 1 min /string

        THEN

	1 /string

  REPEAT 

  r> drop 

  drop r> tuck - ;

    REPEAT  drop over - ;



: reworkdir ( -- )

  remove~+

kernel/paths.fs

+11 −21
Original line number Diff line number Diff line
@@ -161,26 +161,16 @@ Create tfile 0 c, 255 chars allot 


: compact.. ( adr len -- adr2 len2 )

    \ deletes phrases like "xy/.." out of our directory name 2dec97jaw

  over >r -1 >r

    over swap

    BEGIN  dup  WHILE

	over c@ pathsep? 

	IF 	r@ -1 =

		IF	r> drop dup >r

		ELSE	2dup 1 /string 

			3 min s" ../" compare

			0=

			IF	r@ over - ( diff )

				2 pick swap - ( dest-adr )

				>r 3 /string r> swap 2dup >r >r

				move r> r>

			ELSE	r> drop dup >r

			THEN

		THEN

        dup >r '/ scan 2dup 4 min s" /../" compare 0=

        IF

            dup r> - >r 4 /string over r> + 4 -

            swap 2dup + >r move dup r> over -

        ELSE

            rdrop dup 1 min /string

        THEN

	1 /string

  REPEAT 

  r> drop 

  drop r> tuck - ;

    REPEAT  drop over - ;



: reworkdir ( -- )

  remove~+