Annotation of gforth/kernel-ec/args.fs, revision 1.2

1.1       pazsan      1: \ argument expansion
                      2: 
1.2     ! anton       3: \ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2006,2007,2012 Free Software Foundation, Inc.
1.1       pazsan      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 3
                     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, see http://www.gnu.org/licenses/.
                     19: 
                     20: : cstring>sstring  ( cstring -- addr n ) \ gforth      cstring-to-sstring
                     21:     -1 0 scan 0 swap 1+ /string ;
                     22: 
                     23: : arg ( u -- addr count ) \ gforth
                     24: \g Return the string for the @i{u}th command-line argument; returns
                     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}.
                     31:     dup argc @ u< if
                     32:        cells argv @ + @ cstring>sstring
                     33:     else
                     34:        drop 0 0
                     35:     endif ;
                     36: 
                     37: : #! ( -- ) \ gforth   hash-bang
                     38:     \g An alias for @code{\}
                     39:     postpone \ ;  immediate
                     40: 
                     41: Create pathstring 2 cells allot \ string
                     42: Create pathdirs   2 cells allot \ dir string array, pointer and count
                     43: 
                     44: Variable argv ( -- addr ) \ gforth
                     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}.
                     49:     
                     50: Variable argc ( -- addr ) \ gforth
                     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: 
                     54:     
                     55: 0 Value script? ( -- flag )
                     56:     
                     57: : shift-args ( -- ) \ gforth
                     58: \g @code{1 arg} is deleted, shifting all following OS command line
                     59: \g parameters to the left by 1, and reducing @code{argc @@}.  This word
                     60: \g can change @code{argv @@}.
                     61:     argc @ 1 > if
                     62:        argv @ @ ( arg0 )
                     63:        -1 argc +!
                     64:        cell argv +!
                     65:        argv @ !
                     66:     endif ;
                     67: 
                     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: 
                     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 -- )
                     80:     2dup input-lexeme! required ;
                     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: 
                     90: : process-option ( addr u -- )
                     91:     \ process option, possibly consuming further arguments
                     92:     2dup s" -e"         str= >r
                     93:     2dup s" --evaluate" str= r> or if
                     94:        2drop next-arg args-evaluate exit endif
                     95:     2dup s" -h"         str= >r
                     96:     2dup s" --help"     str= r> or if
                     97:        ." Image Options:" cr
                     98:        ."   FILE                                   load FILE (with `require')" cr
                     99:        ."   -e STRING, --evaluate STRING      interpret STRING (with `EVALUATE')" cr
                    100:        ." Report bugs on <https://savannah.gnu.org/bugs/?func=addbug&group=gforth>" cr
                    101:        bye
                    102:     THEN
                    103:     ." Unknown option: " type cr ;
                    104: 
                    105: : (process-args) ( -- )
                    106:     true to script?
                    107:     BEGIN
                    108:        argc @ 1 > WHILE
                    109:            next-arg over c@ [char] - <> IF
                    110:                 args-required
                    111:            else
                    112:                process-option
                    113:            then
                    114:     repeat
                    115:     false to script? ;
                    116: 
                    117: : os-boot ( path n **argv argc -- )
                    118:     stdin  TO infile-id
                    119:     stdout TO outfile-id
                    120:     stderr TO debug-fid
                    121:     argc ! argv ! pathstring 2! ;
                    122: 
                    123: ' (process-args) IS process-args

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