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 |