Return to environ.fs CVS log

Up to [gforth] / gforth

Annotation of gforth/environ.fs, revision 1.1.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: