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

version 1.1, 1994/02/11 16:30:46 version 1.7, 1995/10/16 18:33:06
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 ;
   
   environment-wordlist set-current
   get-order environment-wordlist swap 1+ set-order
   
   \ assumes that chars, cells and doubles use an integral number of aus
   
   \ this should be computed in C as CHAR_BITS/sizeof(char),
   \ but I don't know any machine with gcc where an au does not have 8 bits.
   8 constant ADDRESS-UNIT-BITS ( -- n ) \ environment
   1 ADDRESS-UNIT-BITS chars lshift 1- constant MAX-CHAR
   MAX-CHAR constant /COUNTED-STRING
   ADDRESS-UNIT-BITS cells 2* 2 + constant /HOLD
   &84 constant /PAD
   true constant CORE
   true constant CORE-EXT?
   1 -3 mod 0< constant FLOORED
   
   1 ADDRESS-UNIT-BITS cells 1- lshift 1- constant MAX-N
   -1 constant MAX-U
   
   -1 MAX-N 2constant MAX-D
   -1. 2constant MAX-UD
   
   0 1 2constant gforth \ minor major version
   
   \ !! RETURN-STACK-CELLS
   \ !! STACK-CELLS
   \ !! floating-stack
   \ !! max-float
   15 constant #locals \ 1000 64 /
       \ One local can take up to 64 bytes, the size of locals-buffer is 1000
   maxvp constant wordlists
   
 : (env)  forth definitions
        EnvLink linked  previous
        dup c, here over chars allot swap move align  
        , ;  
   
 : (2env)  
        EnvLink linked  
        dup $80 or  
        c, here over chars allot swap move align  
        , , ;   
   
 : env" ( n -- )  
        State @  
        IF   postpone S" postpone (env)  
        ELSE [char] " parse (env) THEN ; immediate  
   
 : 2env" ( d -- )  
        State @  
        IF   postpone S" postpone (2env)  
        ELSE [char] " parse (2env) THEN ; immediate  
   
   
 : environment?  EnvLink  
                 BEGIN   @ dup  
                 WHILE   dup cell+ count $1f and  
                         4 pick 4 pick compare 0=  
                         IF      nip nip cell+ count dup -rot  
                                 $1f and + aligned  
                                 swap $80 and IF 2@ ELSE @ THEN  
                                 EXIT  
                         THEN  
                 REPEAT  
                 drop 2drop false ;  
   

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


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