我会像这样从 cli 将 fileA 复制到 fileB
gforth script.fs -- fileA fileB
“--”似乎是强制无效的,试图将其作为附加代码加载
官方文档示例说
0 Value fd-in
0 Value fd-out
: open-input ( addr u -- ) r/o open-file throw to fd-in ;
: open-output ( addr u -- ) w/o create-file throw to fd-out ;
s" foo.in" open-input
s" foo.out" open-output
: copy-file ( -- )
begin
line-buffer max-line fd-in read-line throw
while
line-buffer swap fd-out write-line throw
repeat ;
but I would get filenames from CLI
so I tryied many things around
\ Define buffer size for filenames and IO operations
256 Constant filename-len
4096 Constant io-buffer-len
\ Allocate buffers for filenames
Create source-filename filename-len allot
Create dest-filename filename-len allot
Create io-buffer io-buffer-len allot
\ Variables to store file IDs
Variable source-file-id
Variable dest-file-id
\ Define a word to calculate the length of a string up to a maximum length
: str-len ( c-addr max-len -- n )
0 swap ( n c-addr )
begin dup 1+ ( n c-addr+1 )
over + c@ ( n c-addr+1 c-addr+1[i] )
while 1+ ( n+1 )
repeat drop ;
\ Safely store command-line arguments into buffers
: safe-store ( addr len arg# -- )
arg swap ( c-addr u arg# )
2dup >r str-len r> min ( c-addr u n )
move ;
: store-filenames
\ Store first filename, ensure it doesn't exceed buffer size
source-filename filename-len 1 safe-store
\ Store second filename, ensure it doesn't exceed buffer size
dest-filename filename-len 2 safe-store ;
\ Open the source file for reading
: open-source-file
source-filename filename-len s" r" open-file throw source-file-id ! ;
\ Open the destination file for writing (create if not exists)
: open-dest-file
dest-filename filename-len s" w" open-file throw dest-file-id ! ;
\ Copy content from the source file to the destination file
: copy-file
begin
source-file-id @ io-buffer io-buffer-len read-file throw
while
io-buffer swap dest-file-id @ write-file throw
repeat ;
\ Close the files
: close-files
source-file-id @ close-file throw
dest-file-id @ close-file throw ;
\ Main routine
: main
store-filenames
open-source-file
open-dest-file
copy-file
close-files ;
\ Execute the main routine
main
之前的版本是
4194304 Constant max-line
256 constant filename-size
Create line-buffer max-line 2 + allot
create filename-input filename-size allot
create filename-ouput filename-size allot
\ filename
variable input-file-id
variable output-file-id
\ close files buffers
: cleaning
input-file-id close-file throw
output-file-id close-file throw
cr 0 (bye)
;
\ create buffers for data treatment
: initiating
filename-input count r/o open-file throw input-file-id !
filename-ouput w/o create-file throw output-file-id !
;
\ read filenames from cli arguments
: getparemters
1 arg filename-input swap move
2 arg filename-ouput swap move
;
\ copy file
: copying
begin
line-buffer max-line input-file-id read-line throw
while
line-buffer swap output-file-id write-line throw
repeat
;
\ main code
: main
getparemters
initiating
copying
cleaning
;
main
但我总是无法管理文件名捕获,从而导致内存错误或不同类型的错误
我已经迷失了
终于找到解决办法了
naw 代码是
65535 constant maxline
\ buffer
create linebuffer maxline 2 + allot
\ filenames
2variable filenameinput
2variable filenameouput
\ file ids
0 value inputfileid
0 value outputfileid
\ close files buffers
: COLORIZE 27 EMIT ." [" base @ >R 0 <# #S #> type R> base ! ." m" ; \ ASCII TERMINAL ONLY
: cleaning
inputfileid close-file throw
outputfileid close-file throw
0 (bye)
;
\ create buffers for data treatment
: initiating
filenameinput 2@ r/o open-file throw to inputfileid
filenameouput 2@ r/w create-file throw to outputfileid
;
\ read filenames from cli arguments
: getparemters
argc @ 3 <> if
\ manage bad parameter number
cr cr 91 colorize
0 arg type ." thisprogram.fs filename destinationfilename"
0 colorize cr cr cr
1 (bye)
else
\ get filenames
1 arg filenameinput 2!
2 arg filenameouput 2!
then
;
\ copy file
: copying
begin
\ line buffer read
linebuffer maxline inputfileid read-line throw
while
\ line buffer copy
linebuffer swap outputfileid write-line throw
repeat
;
\ main code
: main
getparemters
initiating
copying
cleaning
;
main
这适用于任何 ascii 文件