[BACK]Return to environ.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

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

version 1.1, 1994/02/11 16:30:46 version 1.9, 1996/10/25 17:09:43
Line 1 Line 1
 \ ENVIRON.FS   Answer environmental queries            20may93jaw  \ environmental queries
   
 \ May be cross-compiled  \ Copyright (C) 1995 Free Software Foundation, Inc.
   
 decimal  \ This file is part of Gforth.
   
 AVARIABLE EnvLink 0 EnvLink !  \ Gforth is free software; you can redistribute it and/or
   \ modify it under the terms of the GNU General Public License
   \ as published by the Free Software Foundation; either version 2
   \ of the License, or (at your option) any later version.
   
   \ This program is distributed in the hope that it will be useful,
   \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   \ GNU General Public License for more details.
   
   \ You should have received a copy of the GNU General Public License
   \ along with this program; if not, write to the Free Software
   \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   
   \ wordlist constant environment-wordlist
   
   Create environment-wordlist  wordlist drop
   
   : 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.9

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