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

1.1       anton       1: \ argument expansion
                      2: 
1.16      anton       3: \ Copyright (C) 1995,1996,1997,1998,2000,2003 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
                      9: \ as published by the Free Software Foundation; either version 2
                     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
                     18: \ along with this program; if not, write to the Free Software
1.9       anton      19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.1       anton      20: 
                     21: : cstring>sstring  ( cstring -- addr n ) \ gforth      cstring-to-sstring
                     22:     -1 0 scan 0 swap 1+ /string ;
1.18    ! anton      23: 
        !            24: : arg ( u -- addr count ) \ gforth
        !            25: \g Return the string for the @i{u}th command-line argument; returns
        !            26: \g @code{0 0} if the access is beyond the last argument.
        !            27:     dup argc @ u< if
        !            28:        cells argv @ + @ cstring>sstring
        !            29:     else
        !            30:        drop 0 0
        !            31:     endif ;
        !            32: 
1.1       anton      33: : #! ( -- ) \ gforth   hash-bang
1.5       crook      34:     \g An alias for @code{\}
1.1       anton      35:     postpone \ ;  immediate
                     36: 
                     37: Create pathstring 2 cells allot \ string
                     38: Create pathdirs   2 cells allot \ dir string array, pointer and count
1.6       crook      39: 
1.1       anton      40: Variable argv ( -- addr ) \ gforth
1.6       crook      41: \g @code{Variable} -- a pointer to a vector of pointers to the command-line
1.1       anton      42: \g arguments (including the command-name). Each argument is
                     43: \g represented as a C-style string.
1.18    ! anton      44:     
1.1       anton      45: Variable argc ( -- addr ) \ gforth
1.6       crook      46: \g @code{Variable} -- the number of command-line arguments (including the command name).
1.17      anton      47:     
1.1       anton      48: 0 Value script? ( -- flag )
1.18    ! anton      49:     
        !            50: : shift-args ( -- ) \ gforth
        !            51: \g @code{1 arg} is deleted, shifting all following OS command line
        !            52: \g parameters to the left by 1, and reducing @code{argc @}.  This word
        !            53: \g can change @code{argv @}.
        !            54:     argc @ 1 > if
        !            55:        argv @ @ ( arg0 )
        !            56:        -1 argc +!
        !            57:        cell argv +!
        !            58:        argv @ !
        !            59:     endif ;
1.1       anton      60: 
1.18    ! anton      61: : process-option ( addr u -- )
        !            62:     \ process option, possibly consuming further arguments
1.12      anton      63:     2dup s" -e"         str= >r
1.18    ! anton      64:     2dup s" --evaluate" str= r> or if
        !            65:        2drop 1 arg shift-args evaluate exit endif
1.12      anton      66:     2dup s" -h"         str= >r
1.18    ! anton      67:     2dup s" --help"     str= r> or if
        !            68:        ." Image Options:" cr
1.3       pazsan     69:        ."   FILE                                   load FILE (with `require')" cr
                     70:        ."   -e STRING, --evaluate STRING      interpret STRING (with `EVALUATE')" cr
1.13      anton      71:        ." Report bugs on <https://savannah.gnu.org/bugs/?func=addbug&group=gforth>" cr
1.3       pazsan     72:        bye
                     73:     THEN
1.18    ! anton      74:     ." Unknown option: " type cr ;
1.1       anton      75: 
1.2       jwilke     76: : (process-args) ( -- )
1.1       anton      77:     true to script?
1.18    ! anton      78:     BEGIN
        !            79:        argc @ 1 > WHILE
        !            80:            1 arg shift-args over c@ [char] - <> IF
        !            81:                required
        !            82:            else
        !            83:                process-option
        !            84:            then
        !            85:     repeat
        !            86:     false to script? ;
1.1       anton      87: 
1.11      pazsan     88: : os-boot ( path n **argv argc -- )
                     89:     stdout TO outfile-id
                     90:     stdin  TO infile-id
                     91:     argc ! argv ! pathstring 2! ;
                     92: 
1.2       jwilke     93: ' (process-args) IS process-args

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