Annotation of gforth/environ.fs, revision 1.1

1.1     ! anton       1: \ ENVIRON.FS   Answer environmental queries            20may93jaw
        !             2: 
        !             3: \ May be cross-compiled
        !             4: 
        !             5: decimal
        !             6: 
        !             7: AVARIABLE EnvLink 0 EnvLink !
        !             8: 
        !             9: : (env)
        !            10:        EnvLink linked
        !            11:        dup c, here over chars allot swap move align
        !            12:        , ;
        !            13: 
        !            14: : (2env)
        !            15:        EnvLink linked
        !            16:        dup $80 or
        !            17:        c, here over chars allot swap move align
        !            18:        , , ; 
        !            19: 
        !            20: : env" ( n -- )
        !            21:        State @
        !            22:        IF   postpone S" postpone (env)
        !            23:        ELSE [char] " parse (env) THEN ; immediate
        !            24: 
        !            25: : 2env" ( d -- )
        !            26:        State @
        !            27:        IF   postpone S" postpone (2env)
        !            28:        ELSE [char] " parse (2env) THEN ; immediate
        !            29: 
        !            30: 
        !            31: : environment?  EnvLink
        !            32:                 BEGIN   @ dup
        !            33:                 WHILE   dup cell+ count $1f and
        !            34:                         4 pick 4 pick compare 0=
        !            35:                         IF      nip nip cell+ count dup -rot
        !            36:                                 $1f and + aligned
        !            37:                                 swap $80 and IF 2@ ELSE @ THEN
        !            38:                                 EXIT
        !            39:                         THEN
        !            40:                 REPEAT
        !            41:                 drop 2drop false ;
        !            42: 

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