Diff for /gforth/environ.fs between versions 1.1 and 1.3

version 1.1, 1994/02/11 16:30:46 version 1.3, 1994/11/17 15:53:11
Line 1 Line 1
 \ ENVIRON.FS   Answer environmental queries            20may93jaw  \ environmental queries
   
 \ May be cross-compiled  \ wordlist constant environment-wordlist
   
 decimal  Create environment-wordlist  wordlist drop
   
 AVARIABLE EnvLink 0 EnvLink !  : environment? ( c-addr u -- false / ... true )
       environment-wordlist search-wordlist if
           execute true
       else
           false
       endif ;
   
 : (env)  environment-wordlist set-current
        EnvLink linked  get-order environment-wordlist swap 1+ set-order
        dup c, here over chars allot swap move align  
        , ;  \ assumes that chars, cells and doubles use an integral number of aus
   
 : (2env)  \ this should be computed in C as CHAR_BITS/sizeof(char),
        EnvLink linked  \ but I don't know any machine with gcc where an au does not have 8 bits.
        dup $80 or  8 constant ADDRESS-UNIT-BITS
        c, here over chars allot swap move align  1 ADDRESS-UNIT-BITS chars lshift 1- constant MAX-CHAR
        , , ;   MAX-CHAR constant /COUNTED-STRING
   ADDRESS-UNIT-BITS cells 2* 2 + constant /HOLD
 : env" ( n -- )  &84 constant /PAD
        State @  true constant CORE
        IF   postpone S" postpone (env)  \ CORE-EXT?
        ELSE [char] " parse (env) THEN ; immediate  1 -3 mod 0< constant FLOORED
   
 : 2env" ( d -- )  1 ADDRESS-UNIT-BITS cells 1- lshift 1- constant MAX-N
        State @  -1 constant MAX-U
        IF   postpone S" postpone (2env)  
        ELSE [char] " parse (2env) THEN ; immediate  -1 MAX-N 2constant MAX-D
   -1. 2constant MAX-UD
   
 : environment?  EnvLink  0 0 2constant gforth \ minor mayor version
                 BEGIN   @ dup  
                 WHILE   dup cell+ count $1f and  \ !! RETURN-STACK-CELLS
                         4 pick 4 pick compare 0=  \ !! STACK-CELLS
                         IF      nip nip cell+ count dup -rot  
                                 $1f and + aligned  forth definitions
                                 swap $80 and IF 2@ ELSE @ THEN  previous
                                 EXIT  
                         THEN  
                 REPEAT  
                 drop 2drop false ;  
   

Removed from v.1.1  
changed lines
  Added in v.1.3


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