gforth/archive.fs - diff

Return to archive.fs CVS log

Up to [gforth] / gforth

Diff for /gforth/archive.fs between versions 1.1 and 1.2

version 1.1, 2012/07/30 01:10:41	version 1.2, 2012/07/30 21:09:11
Line 31	Line 31
\ type is:	\ type is:
\ 'f' for file,	\ 'f' for file,
\ 'd' for directory,	\ 'd' for directory,
\ 's' for symlink,	\ 's' for symlink (can't create now),
\ 'h' for hardlink	\ 'h' for hardlink (can't create now)
\ rules for directories are: Specify each before first use	\ rules for directories are: Specify each before first use

4 buffer: fsize	4 buffer: fsize

: >align ( n -- ) dup sfaligned swap - spaces ;
: .len ( n -- ) fsize le-l! fsize 4 type ;	: .len ( n -- ) fsize le-l! fsize 4 type ;
: .z ( -- ) 0 .len ;	: .z ( -- ) 0 .len ;
: .entry ( addr u char -- addr u )	: .entry ( addr u char -- addr u )
>r dup 2 + .len r> emit 2dup type 0 emit dup 2 + >align ;	>r dup 2 + .len r> emit 2dup type 0 emit ;

: -scan ( addr u char -- addr' u' )	: -scan ( addr u char -- addr' u' )
>r BEGIN dup WHILE 1- 2dup + c@ r@ = UNTIL THEN	>r BEGIN dup WHILE 1- 2dup + c@ r@ = UNTIL THEN
Line 52 wordlist constant dirs	Line 51 wordlist constant dirs
: :dir ( addr u -- )	: :dir ( addr u -- )
get-current >r dirs set-current nextname create r> set-current ;	get-current >r dirs set-current nextname create r> set-current ;

"." :dir	"." :dir \ no need to create .

: ?dir ( addr u -- )	: ?dir ( addr u -- )
'/' -scan dup 0= IF 2drop EXIT THEN	'/' -scan dup 0= IF 2drop EXIT THEN
Line 64 wordlist constant dirs	Line 63 wordlist constant dirs
THEN ;	THEN ;

: dump-a-file ( addr u -- )	: dump-a-file ( addr u -- )
2dup ?dir	2dup ?dir 'f' .entry
'f' .entry	slurp-file dup .len 2dup type drop free throw ;
slurp-file dup .len 2dup type dup >align
drop free throw ;

: dump-files ( -- )	: dump-files ( -- )
BEGIN argc @ 1 > WHILE	BEGIN argc @ 1 > WHILE

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.1
changed lines
	Added in v.1.2