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

1.1       anton       1: \ argument expansion
                      2: 
1.21      anton       3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004 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
1.19      anton      26: \g @code{0 0} if the access is beyond the last argument.  @code{0 arg}
                     27: \g is the program name with which you started Gforth.  The next
                     28: \g unprocessed argument is always @code{1 arg}, the one after that is
                     29: \g @code{2 arg} etc.  All arguments already processed by the system
                     30: \g are deleted.  After you have processed an argument, you can delete
                     31: \g it with @code{shift-args}.
1.18      anton      32:     dup argc @ u< if
                     33:        cells argv @ + @ cstring>sstring
                     34:     else
                     35:        drop 0 0
                     36:     endif ;
                     37: 
1.1       anton      38: : #! ( -- ) \ gforth   hash-bang
1.5       crook      39:     \g An alias for @code{\}
1.1       anton      40:     postpone \ ;  immediate
                     41: 
                     42: Create pathstring 2 cells allot \ string
                     43: Create pathdirs   2 cells allot \ dir string array, pointer and count
1.6       crook      44: 
1.1       anton      45: Variable argv ( -- addr ) \ gforth
1.19      anton      46: \g @code{Variable} -- a pointer to a vector of pointers to the
                     47: \g command-line arguments (including the command-name). Each argument
                     48: \g is represented as a C-style zero-terminated string.  Changed by
                     49: \g @code{next-arg} and @code{shift-args}.
1.18      anton      50:     
1.1       anton      51: Variable argc ( -- addr ) \ gforth
1.19      anton      52: \g @code{Variable} -- the number of command-line arguments (including
                     53: \g the command name).  Changed by @code{next-arg} and @code{shift-args}.
                     54: 
1.17      anton      55:     
1.1       anton      56: 0 Value script? ( -- flag )
1.18      anton      57:     
                     58: : shift-args ( -- ) \ gforth
                     59: \g @code{1 arg} is deleted, shifting all following OS command line
1.20      pazsan     60: \g parameters to the left by 1, and reducing @code{argc @@}.  This word
                     61: \g can change @code{argv @@}.
1.18      anton      62:     argc @ 1 > if
                     63:        argv @ @ ( arg0 )
                     64:        -1 argc +!
                     65:        cell argv +!
                     66:        argv @ !
                     67:     endif ;
1.1       anton      68: 
1.19      anton      69: : next-arg ( -- addr u ) \ gforth
                     70: \g get the next argument from the OS command line, consuming it; if
                     71: \g there is no argument left, return @code{0 0}.
                     72:     1 arg shift-args ;
                     73: 
1.23    ! anton      74: \ processing args on Gforth startup
        !            75: \ helper words
        !            76: 
        !            77: : os-execute-parsing ( ... addr u xt -- ... )
        !            78:     s" *OS command line*" execute-parsing-wrapper ;
        !            79: 
        !            80: : args-required1 ( addr u -- )
        !            81:     dup >in ! required ;
        !            82: 
        !            83: : args-required ( i*x addr u -- i*x ) \ gforth
        !            84:     2dup ['] args-required1 os-execute-parsing ;
        !            85: 
        !            86: : args-evaluate ( i*x addr u -- j*x ) \ gforth
        !            87:     ['] interpret os-execute-parsing ;
        !            88: 
        !            89: \ main words
        !            90: 
1.18      anton      91: : process-option ( addr u -- )
                     92:     \ process option, possibly consuming further arguments
1.12      anton      93:     2dup s" -e"         str= >r
1.18      anton      94:     2dup s" --evaluate" str= r> or if
1.23    ! anton      95:        2drop next-arg args-evaluate exit endif
1.12      anton      96:     2dup s" -h"         str= >r
1.18      anton      97:     2dup s" --help"     str= r> or if
                     98:        ." Image Options:" cr
1.3       pazsan     99:        ."   FILE                                   load FILE (with `require')" cr
                    100:        ."   -e STRING, --evaluate STRING      interpret STRING (with `EVALUATE')" cr
1.13      anton     101:        ." Report bugs on <https://savannah.gnu.org/bugs/?func=addbug&group=gforth>" cr
1.3       pazsan    102:        bye
                    103:     THEN
1.18      anton     104:     ." Unknown option: " type cr ;
1.1       anton     105: 
1.2       jwilke    106: : (process-args) ( -- )
1.1       anton     107:     true to script?
1.18      anton     108:     BEGIN
                    109:        argc @ 1 > WHILE
1.19      anton     110:            next-arg over c@ [char] - <> IF
1.23    ! anton     111:                 args-required
1.18      anton     112:            else
                    113:                process-option
                    114:            then
                    115:     repeat
                    116:     false to script? ;
1.1       anton     117: 
1.11      pazsan    118: : os-boot ( path n **argv argc -- )
                    119:     stdout TO outfile-id
                    120:     stdin  TO infile-id
                    121:     argc ! argv ! pathstring 2! ;
                    122: 
1.2       jwilke    123: ' (process-args) IS process-args

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