Annotation of gforth/args.fs, revision 1.1
1.1 ! pazsan 1: \ argument expansion
! 2:
! 3: : cstring>sstring ( cstring -- addr n ) \ gforth cstring-to-sstring
! 4: -1 0 scan 0 swap 1+ /string ;
! 5: : arg ( n -- addr count ) \ gforth
! 6: cells argv @ + @ cstring>sstring ;
! 7: : #! postpone \ ; immediate
! 8:
! 9: Create pathstring 2 cells allot \ string
! 10: Create pathdirs 2 cells allot \ dir string array, pointer and count
! 11: Variable argv
! 12: Variable argc
! 13:
! 14: 0 Value script? ( -- flag )
! 15:
! 16: : process-path ( addr1 u1 -- addr2 u2 )
! 17: \ addr1 u1 is a path string, addr2 u2 is an array of dir strings
! 18: align here >r
! 19: BEGIN
! 20: over >r 0 scan
! 21: over r> tuck - ( rest-str this-str )
! 22: dup
! 23: IF
! 24: 2dup 1- chars + c@ [char] / <>
! 25: IF
! 26: 2dup chars + [char] / swap c!
! 27: 1+
! 28: THEN
! 29: 2,
! 30: ELSE
! 31: 2drop
! 32: THEN
! 33: dup
! 34: WHILE
! 35: 1 /string
! 36: REPEAT
! 37: 2drop
! 38: here r> tuck - 2 cells / ;
! 39:
! 40: : do-option ( addr1 len1 addr2 len2 -- n )
! 41: 2swap
! 42: 2dup s" -e" compare 0= >r
! 43: 2dup s" --evaluate" compare 0= r> or
! 44: IF 2drop dup >r ['] evaluate catch
! 45: ?dup IF dup >r DoError r> negate (bye) THEN
! 46: r> >tib +! 2 EXIT THEN
! 47: ." Unknown option: " type cr 2drop 1 ;
! 48:
! 49: : process-args ( -- )
! 50: true to script?
! 51: >tib @ >r
! 52: argc @ 1
! 53: ?DO
! 54: I arg over c@ [char] - <>
! 55: IF
! 56: required 1
! 57: ELSE
! 58: I 1+ argc @ = IF s" " ELSE I 1+ arg THEN
! 59: do-option
! 60: THEN
! 61: +LOOP
! 62: r> >tib !
! 63: false to script?
! 64: ;
! 65:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>