File:  [gforth] / gforth / environ.fs
Revision 1.1.1.1 (vendor branch): download - view: text, annotated - select for diffs
Fri Feb 11 16:30:47 1994 UTC (30 years, 2 months ago) by anton
Branches: no-vendor
CVS tags: alpha
The GNU Forth Project

    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>