从 CLI 上给出的文件名复制 gforth 中的文件

问题描述 投票:0回答:1

我会像这样从 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 

但我总是无法管理文件名捕获,从而导致内存错误或不同类型的错误

我已经迷失了

file gforth
1个回答
0
投票

终于找到解决办法了

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 文件

© www.soinside.com 2019 - 2024. All rights reserved.