Return to args.fs CVS log

Up to [gforth] / gforth / kernel

Annotation of gforth/kernel/args.fs, revision 1.27

1.1       anton       1: \ argument expansion
                      2: 
1.27    ! anton       3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2006,2007 Free Software Foundation, Inc.
1.1       anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.26      anton       9: \ as published by the Free Software Foundation, either version 3
1.1       anton      10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.26      anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1       anton      19: 
                     20: : cstring>sstring  ( cstring -- addr n ) \ gforth      cstring-to-sstring
                     21:     -1 0 scan 0 swap 1+ /string ;
1.18      anton      22: 
                     23: : arg ( u -- addr count ) \ gforth
                     24: \g Return the string for the @i{u}th command-line argument; returns
1.19      anton      25: \g @code{0 0} if the access is beyond the last argument.  @code{0 arg}
                     26: \g is the program name with which you started Gforth.  The next
                     27: \g unprocessed argument is always @code{1 arg}, the one after that is
                     28: \g @code{2 arg} etc.  All arguments already processed by the system
                     29: \g are deleted.  After you have processed an argument, you can delete
                     30: \g it with @code{shift-args}.
1.18      anton      31:     dup argc @ u< if
                     32:        cells argv @ + @ cstring>sstring
                     33:     else
                     34:        drop 0 0
                     35:     endif ;
                     36: 
1.1       anton      37: : #! ( -- ) \ gforth   hash-bang
1.5       crook      38:     \g An alias for @code{\}
1.1       anton      39:     postpone \ ;  immediate
                     40: 
                     41: Create pathstring 2 cells allot \ string
                     42: Create pathdirs   2 cells allot \ dir string array, pointer and count
1.6       crook      43: 
1.1       anton      44: Variable argv ( -- addr ) \ gforth
1.19      anton      45: \g @code{Variable} -- a pointer to a vector of pointers to the
                     46: \g command-line arguments (including the command-name). Each argument
                     47: \g is represented as a C-style zero-terminated string.  Changed by
                     48: \g @code{next-arg} and @code{shift-args}.
1.18      anton      49:     
1.1       anton      50: Variable argc ( -- addr ) \ gforth
1.19      anton      51: \g @code{Variable} -- the number of command-line arguments (including
                     52: \g the command name).  Changed by @code{next-arg} and @code{shift-args}.
                     53: 
1.17      anton      54:     
1.1       anton      55: 0 Value script? ( -- flag )
1.18      anton      56:     
                     57: : shift-args ( -- ) \ gforth
                     58: \g @code{1 arg} is deleted, shifting all following OS command line
1.20      pazsan     59: \g parameters to the left by 1, and reducing @code{argc @@}.  This word
                     60: \g can change @code{argv @@}.
1.18      anton      61:     argc @ 1 > if
                     62:        argv @ @ ( arg0 )
                     63:        -1 argc +!
                     64:        cell argv +!
                     65:        argv @ !
                     66:     endif ;
1.1       anton      67: 
1.19      anton      68: : next-arg ( -- addr u ) \ gforth
                     69: \g get the next argument from the OS command line, consuming it; if
                     70: \g there is no argument left, return @code{0 0}.
                     71:     1 arg shift-args ;
                     72: 
1.23      anton      73: \ processing args on Gforth startup
                     74: \ helper words
                     75: 
                     76: : os-execute-parsing ( ... addr u xt -- ... )
                     77:     s" *OS command line*" execute-parsing-wrapper ;
                     78: 
                     79: : args-required1 ( addr u -- )
1.24      anton      80:     2dup input-lexeme! required ;
1.23      anton      81: 
                     82: : args-required ( i*x addr u -- i*x ) \ gforth
                     83:     2dup ['] args-required1 os-execute-parsing ;
                     84: 
                     85: : args-evaluate ( i*x addr u -- j*x ) \ gforth
                     86:     ['] interpret os-execute-parsing ;
                     87: 
                     88: \ main words
                     89: 
1.18      anton      90: : process-option ( addr u -- )
                     91:     \ process option, possibly consuming further arguments
1.12      anton      92:     2dup s" -e"         str= >r
1.18      anton      93:     2dup s" --evaluate" str= r> or if
1.23      anton      94:        2drop next-arg args-evaluate exit endif
1.12      anton      95:     2dup s" -h"         str= >r
1.18      anton      96:     2dup s" --help"     str= r> or if
                     97:        ." Image Options:" cr
1.3       pazsan     98:        ."   FILE                                   load FILE (with `require')" cr
                     99:        ."   -e STRING, --evaluate STRING      interpret STRING (with `EVALUATE')" cr
1.13      anton     100:        ." Report bugs on <https://savannah.gnu.org/bugs/?func=addbug&group=gforth>" cr
1.3       pazsan    101:        bye
                    102:     THEN
1.18      anton     103:     ." Unknown option: " type cr ;
1.1       anton     104: 
1.2       jwilke    105: : (process-args) ( -- )
1.1       anton     106:     true to script?
1.18      anton     107:     BEGIN
                    108:        argc @ 1 > WHILE
1.19      anton     109:            next-arg over c@ [char] - <> IF
1.23      anton     110:                 args-required
1.18      anton     111:            else
                    112:                process-option
                    113:            then
                    114:     repeat
                    115:     false to script? ;
1.1       anton     116: 
1.11      pazsan    117: : os-boot ( path n **argv argc -- )
                    118:     stdout TO outfile-id
                    119:     stdin  TO infile-id
                    120:     argc ! argv ! pathstring 2! ;
                    121: 
1.2       jwilke    122: ' (process-args) IS process-args