[gforth] / gforth / kernel / int.fs  

gforth: gforth/kernel/int.fs

Diff for /gforth/kernel/int.fs between version 1.6 and 1.136

version 1.6, Sat Oct 10 10:28:36 1998 UTC version 1.136, Sun Feb 19 17:27:13 2006 UTC
Line 1 
Line 1 
 \ definitions needed for interpreter only  \ definitions needed for interpreter only
   
   \ Copyright (C) 1995-2000,2004,2005 Free Software Foundation, Inc.
   
   \ This file is part of Gforth.
   
   \ 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
 \ \ Revision-Log  \ \ Revision-Log
   
 \       put in seperate file                            14sep97jaw  \       put in seperate file                            14sep97jaw
   
 \ \ input stream primitives                             23feb93py  \ \ input stream primitives                             23feb93py
   
 : tib ( -- c-addr ) \ core-ext  require ./basics.fs     \ bounds decimal hex ...
     \ obsolescent  require ./io.fs         \ type ...
   require ./nio.fs        \ . <# ...
   require ./errore.fs     \ .error ...
   require kernel/version.fs       \ version-string
   require ./../chains.fs
   
   has? new-input 0= [IF]
   : tib ( -- c-addr ) \ core-ext t-i-b
       \G @i{c-addr} is the address of the Terminal Input Buffer.
       \G OBSOLESCENT: @code{source} superceeds the function of this word.
     >tib @ ;      >tib @ ;
   
 Defer source ( -- addr count ) \ core  Defer source ( -- c-addr u ) \ core
 \ used by dodefer:, must be defer  \ used by dodefer:, must be defer
   \G @i{c-addr} is the address of the input buffer and @i{u} is the
   \G number of characters in it.
   
 : (source) ( -- addr count )  : (source) ( -- c-addr u )
     tib #tib @ ;      tib #tib @ ;
 ' (source) IS source  ' (source) IS source
   [THEN]
   
 : (word) ( addr1 n1 char -- addr2 n2 )  : (word) ( addr1 n1 char -- addr2 n2 )
   dup >r skip 2dup r> scan  nip - ;    dup >r skip 2dup r> scan  nip - ;
Line 25 
Line 55 
   
 \ word parse                                           23feb93py  \ word parse                                           23feb93py
   
 : sword  ( char -- addr len ) \ gforth  : sword  ( char -- addr len ) \ gforth-obsolete s-word
   \G parses like @code{word}, but the output is like @code{parse} output  \G Parses like @code{word}, but the output is like @code{parse} output.
   \G @xref{core-idef}.
   \ this word was called PARSE-WORD until 0.3.0, but Open Firmware and    \ this word was called PARSE-WORD until 0.3.0, but Open Firmware and
   \ dpANS6 A.6.2.2008 have a word with that name that behaves    \ dpANS6 A.6.2.2008 have a word with that name that behaves
   \ differently (like NAME).    \ differently (like NAME).
   source 2dup >r >r >in @ over min /string    source 2dup >r >r >in @ over min /string
   rot dup bl = IF  drop (parse-white)  ELSE  (word)  THEN      rot dup bl = IF
           drop (parse-white)
       ELSE
           (word)
       THEN
       2dup input-lexeme!
   2dup + r> - 1+ r> min >in ! ;    2dup + r> - 1+ r> min >in ! ;
   
 : word   ( char -- addr ) \ core  : word   ( char "<chars>ccc<char>-- c-addr ) \ core
       \G Skip leading delimiters. Parse @i{ccc}, delimited by
       \G @i{char}, in the parse area. @i{c-addr} is the address of a
       \G transient region containing the parsed string in
       \G counted-string format. If the parse area was empty or
       \G contained no characters other than delimiters, the resulting
       \G string has zero length. A program may replace characters within
       \G the counted string. OBSOLESCENT: the counted string has a
       \G trailing space that is not included in its length.
   sword here place  bl here count + c!  here ;    sword here place  bl here count + c!  here ;
   
 : parse    ( char -- addr len ) \ core-ext  : parse    ( char "ccc<char>" -- c-addr u ) \ core-ext
   >r  source  >in @ over min /string  over  swap r>  scan >r  \G Parse @i{ccc}, delimited by @i{char}, in the parse
   over - dup r> IF 1+ THEN  >in +! ;  \G area. @i{c-addr u} specifies the parsed string within the
   \G parse area. If the parse area was empty, @i{u} is 0.
       >r  source  >in @ over min /string ( c-addr1 u1 )
       over  swap r>  scan >r
       over - dup r> IF 1+ THEN  >in +!
       2dup input-lexeme! ;
   
 \ name                                                 13feb93py  \ name                                                 13feb93py
   
 [IFUNDEF] (name) \ name might be a primitive  [IFUNDEF] (name) \ name might be a primitive
   
 : (name) ( -- c-addr count )  : (name) ( -- c-addr count ) \ gforth
     source 2dup >r >r >in @ /string (parse-white)      source 2dup >r >r >in @ /string (parse-white)
       2dup input-lexeme!
     2dup + r> - 1+ r> min >in ! ;      2dup + r> - 1+ r> min >in ! ;
 \    name count ;  \    name count ;
 [THEN]  [THEN]
Line 55 
Line 105 
     dup 0= -&16 and throw ;      dup 0= -&16 and throw ;
   
 : name-too-long? ( c-addr u -- c-addr u )  : name-too-long? ( c-addr u -- c-addr u )
     dup $1F u> -&19 and throw ;      dup lcount-mask u> -&19 and throw ;
   
 \ \ Number parsing                                      23feb93py  \ \ Number parsing                                      23feb93py
   
 \ number? number                                       23feb93py  \ number? number                                       23feb93py
   
 hex  hex
 const Create bases   10 ,   2 ,   A , 100 ,  const Create bases   0A , 10 ,   2 ,   0A ,
 \                     16     2    10   character  \                    10   16     2     10
 \ !! this saving and restoring base is an abomination! - anton  
   
   \ !! protect BASE saving wrapper against exceptions
 : getbase ( addr u -- addr' u' )  : getbase ( addr u -- addr' u' )
     over c@ [char] $ - dup 4 u<      2dup s" 0x" string-prefix? >r
       2dup s" 0X" string-prefix? r> or
       base @ &34 < and if
           hex 2 /string
       endif
       over c@ [char] # - dup 4 u<
     IF      IF
         cells bases + @ base ! 1 /string          cells bases + @ base ! 1 /string
     ELSE      ELSE
         drop          drop
     THEN ;      THEN ;
   
 : s>number ( addr len -- d )  : sign? ( addr u -- addr1 u1 flag )
     base @ >r  dpl on      over c@ [char] - =  dup >r
     over c@ '- =  dup >r  
     IF      IF
         1 /string          1 /string
     THEN      THEN
     getbase  dpl on  0 0 2swap      r> ;
     BEGIN  
   : s'>unumber? ( addr u -- ud flag )
       \ convert string "C" or "C'" to character code
       dup 0= if
           false exit
       endif
       x@+/string 0 s" '" 2rot string-prefix? ;
   
   : s>unumber? ( addr u -- ud flag ) \ gforth
       \G converts string addr u into ud, flag indicates success
       dpl on
       over c@ '' = if
           1 /string s'>unumber? exit
       endif
       base @ >r  getbase
       0. 2swap
       BEGIN ( d addr len )
         dup >r >number dup          dup >r >number dup
     WHILE      WHILE \ there are characters left
         dup r> -          dup r> -
     WHILE      WHILE \ the last >number parsed something
         dup dpl ! over c@ [char] . =          dup 1- dpl ! over c@ [char] . =
     WHILE      WHILE \ the current char is '.'
         1 /string          1 /string
     REPEAT  THEN      REPEAT  THEN \ there are unparseable characters left
         2drop rdrop dpl off          2drop false
     ELSE      ELSE
         2drop rdrop r>          rdrop 2drop true
       THEN
       r> base ! ;
   
   \ ouch, this is complicated; there must be a simpler way - anton
   : s>number? ( addr u -- d f ) \ gforth
       \G converts string addr u into d, flag indicates success
       sign? >r
       s>unumber?
       0= IF
           rdrop false
       ELSE \ no characters left, all ok
           r>
         IF          IF
             dnegate              dnegate
         THEN          THEN
     THEN          true
     r> base ! ;      THEN ;
   
   : s>number ( addr len -- d )
       \ don't use this, there is no way to tell success
       s>number? drop ;
   
 : snumber? ( c-addr u -- 0 / n -1 / d 0> )  : snumber? ( c-addr u -- 0 / n -1 / d 0> )
     s>number dpl @ 0=      s>number? 0=
     IF      IF
         2drop false  EXIT          2drop false  EXIT
     THEN      THEN
     dpl @ dup 0> 0= IF      dpl @ dup 0< IF
         nip          nip
       ELSE
           1+
     THEN ;      THEN ;
   
 : number? ( string -- string 0 / n -1 / d 0> )  : number? ( string -- string 0 / n -1 / d 0> )
Line 123 
Line 211 
   
 \ \ Comments ( \ \G  \ \ Comments ( \ \G
   
 : ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file     paren  : ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ thisone- core,file    paren
       \G ** this will not get annotated. The alias in glocals.fs will instead **
       \G It does not work to use "wordset-" prefix since this file is glossed
       \G by cross.fs which doesn't have the same functionalty as makedoc.fs
     [char] ) parse 2drop ; immediate      [char] ) parse 2drop ; immediate
   
 : \ ( -- ) \ core-ext backslash  : \ ( compilation 'ccc<newline>' -- ; run-time -- ) \ thisone- core-ext,block-ext backslash
       \G ** this will not get annotated. The alias in glocals.fs will instead **
       \G It does not work to use "wordset-" prefix since this file is glossed
       \G by cross.fs which doesn't have the same functionalty as makedoc.fs
       [ has? file [IF] ]
     blk @      blk @
     IF      IF
         >in @ c/l / 1+ c/l * >in !          >in @ c/l / 1+ c/l * >in !
         EXIT          EXIT
     THEN      THEN
       [ [THEN] ]
     source >in ! drop ; immediate      source >in ! drop ; immediate
   
 : \G ( -- ) \ gforth backslash  : \G ( compilation 'ccc<newline>' -- ; run-time -- ) \ gforth backslash-gee
       \G Equivalent to @code{\} but used as a tag to annotate definition
       \G comments into documentation.
     POSTPONE \ ; immediate      POSTPONE \ ; immediate
   
 \ \ object oriented search list                         17mar93py  \ \ object oriented search list                         17mar93py
Line 151 
Line 249 
   
 struct  struct
   cell% field wordlist-map \ pointer to a wordlist-map-struct    cell% field wordlist-map \ pointer to a wordlist-map-struct
   cell% field wordlist-id \ not the same as wid; representation depends on implementation    cell% field wordlist-id \ linked list of words (for WORDS etc.)
   cell% field wordlist-link \ link field to other wordlists    cell% field wordlist-link \ link field to other wordlists
   cell% field wordlist-extend \ points to wordlist extensions (eg hashtables)    cell% field wordlist-extend \ wordlist extensions (eg bucket offset)
 end-struct wordlist-struct  end-struct wordlist-struct
   
   has? f83headerstring [IF]
 : f83find      ( addr len wordlist -- nt / false )  : f83find      ( addr len wordlist -- nt / false )
     wordlist-id @ (f83find) ;      wordlist-id @ (f83find) ;
   [ELSE]
   : f83find      ( addr len wordlist -- nt / false )
       wordlist-id @ (listlfind) ;
   [THEN]
   
 : initvoc               ( wid -- )  : initvoc               ( wid -- )
   dup wordlist-map @ hash-method perform ;    dup wordlist-map @ hash-method perform ;
Line 172 
Line 275 
 AVariable lookup        forth-wordlist lookup !  AVariable lookup        forth-wordlist lookup !
 \ !! last is user and lookup?! jaw  \ !! last is user and lookup?! jaw
 AVariable current ( -- addr ) \ gforth  AVariable current ( -- addr ) \ gforth
   \G @code{Variable} -- holds the @i{wid} of the compilation word list.
 AVariable voclink       forth-wordlist wordlist-link voclink !  AVariable voclink       forth-wordlist wordlist-link voclink !
 lookup AValue context  \ lookup AValue context ( -- addr ) \ gforth
   Defer context ( -- addr ) \ gforth
   \G @code{context} @code{@@} is the @i{wid} of the word list at the
   \G top of the search order.
   
   ' lookup is context
 forth-wordlist current !  forth-wordlist current !
   
 \ \ header, finding, ticks                              17dec92py  \ \ header, finding, ticks                              17dec92py
   
 $80 constant alias-mask \ set when the word is not an alias!  \ The constants are defined as 32 bits, but then erased
   \ and overwritten by the right ones
   
   has? f83headerstring [IF]
       \ to save space, Gforth EC limits words to 31 characters
       $80 constant alias-mask
 $40 constant immediate-mask  $40 constant immediate-mask
 $20 constant restrict-mask  $20 constant restrict-mask
       $1f constant lcount-mask
   [ELSE]
   $80000000 constant alias-mask
   1 bits/char 1 - lshift
   -1 cells allot  bigendian [IF]   c, 0 1 cells 1- times
                             [ELSE] 0 1 cells 1- times c, [THEN]
   $40000000 constant immediate-mask
   1 bits/char 2 - lshift
   -1 cells allot  bigendian [IF]   c, 0 1 cells 1- times
                             [ELSE] 0 1 cells 1- times c, [THEN]
   $20000000 constant restrict-mask
   1 bits/char 3 - lshift
   -1 cells allot  bigendian [IF]   c, 0 1 cells 1- times
                             [ELSE] 0 1 cells 1- times c, [THEN]
   $1fffffff constant lcount-mask
   1 bits/char 3 - lshift 1 -
   -1 cells allot  bigendian [IF]   c, -1 1 cells 1- times
                             [ELSE] -1 1 cells 1- times c, [THEN]
   [THEN]
   
 \ higher level parts of find  \ higher level parts of find
   
Line 189 
Line 321 
     \ true becomes 1, false -1      \ true becomes 1, false -1
     0= 2* 1+ ;      0= 2* 1+ ;
   
   : ticking-compile-only-error ( ... -- )
       -&2048 throw ;
   
 : compile-only-error ( ... -- )  : compile-only-error ( ... -- )
     -&14 throw ;      -&14 throw ;
   
Line 200 
Line 335 
     then      then
 [ [THEN] ] ;  [ [THEN] ] ;
   
 : (x>int) ( cfa b -- xt )  : (x>int) ( cfa w -- xt )
     \ get interpretation semantics of name      \ get interpretation semantics of name
     restrict-mask and      restrict-mask and
     if      if
Line 209 
Line 344 
         (cfa>int)          (cfa>int)
     then ;      then ;
   
   has? f83headerstring [IF]
 : name>string ( nt -- addr count ) \ gforth     head-to-string  : name>string ( nt -- addr count ) \ gforth     head-to-string
     \g @var{addr count} is the name of the word represented by @var{nt}.      \g @i{addr count} is the name of the word represented by @i{nt}.
     cell+ count $1F and ;      cell+ count lcount-mask and ;
   
 : ((name>))  ( nfa -- cfa )  : ((name>))  ( nfa -- cfa )
     name>string + cfaligned ;      name>string + cfaligned ;
   
 : (name>x) ( nfa -- cfa b )  : (name>x) ( nfa -- cfa w )
     \ cfa is an intermediate cfa and b is the flags byte of nfa      \ cfa is an intermediate cfa and w is the flags cell of nfa
     dup ((name>))      dup ((name>))
     swap cell+ c@ dup alias-mask and 0=      swap cell+ c@ dup alias-mask and 0=
     IF      IF
         swap @ swap          swap @ swap
     THEN ;      THEN ;
   [ELSE]
   : name>string ( nt -- addr count ) \ gforth     head-to-string
       \g @i{addr count} is the name of the word represented by @i{nt}.
       cell+ dup cell+ swap @ lcount-mask and ;
   
   : ((name>))  ( nfa -- cfa )
       name>string + cfaligned ;
   
   : (name>x) ( nfa -- cfa w )
       \ cfa is an intermediate cfa and w is the flags cell of nfa
       dup ((name>))
       swap cell+ @ dup alias-mask and 0=
       IF
           swap @ swap
       THEN ;
   [THEN]
   
 : name>int ( nt -- xt ) \ gforth  : name>int ( nt -- xt ) \ gforth
     \G @var{xt} represents the interpretation semantics of the word      \G @i{xt} represents the interpretation semantics of the word
     \G @var{nt}. Produces @code{' compile-only-error} if      \G @i{nt}. If @i{nt} has no interpretation semantics (i.e. is
     \G @var{nt} is compile-only.      \G @code{compile-only}), @i{xt} is the execution token for
       \G @code{ticking-compile-only-error}, which performs @code{-2048 throw}.
     (name>x) (x>int) ;      (name>x) (x>int) ;
   
 : name?int ( nt -- xt ) \ gforth  : name?int ( nt -- xt ) \ gforth
     \G Like name>int, but throws an error if compile-only.      \G Like @code{name>int}, but perform @code{-2048 throw} if @i{nt}
       \G has no interpretation semantics.
     (name>x) restrict-mask and      (name>x) restrict-mask and
     if      if
         compile-only-error \ does not return          ticking-compile-only-error \ does not return
     then      then
     (cfa>int) ;      (cfa>int) ;
   
 : (name>comp) ( nt -- w +-1 ) \ gforth  : (name>comp) ( nt -- w +-1 ) \ gforth
     \G @var{w xt} is the compilation token for the word @var{nt}.      \G @i{w xt} is the compilation token for the word @i{nt}.
     (name>x) >r      (name>x) >r
 [ has? compiler [IF] ]  [ has? compiler [IF] ]
     dup interpret/compile?      dup interpret/compile?
Line 251 
Line 405 
     ;      ;
   
 : (name>intn) ( nfa -- xt +-1 )  : (name>intn) ( nfa -- xt +-1 )
     (name>x) tuck (x>int) ( b xt )      (name>x) tuck (x>int) ( w xt )
     swap immediate-mask and flag-sign ;      swap immediate-mask and flag-sign ;
   
 const Create ???  0 , 3 c, char ? c, char ? c, char ? c,  const Create ???  0 , 3 , char ? c, char ? c, char ? c,
 \ ??? is used by dovar:, must be created/:dovar  \ ??? is used by dovar:, must be created/:dovar
   
 : >head ( cfa -- nt ) \ gforth  to-name  [IFDEF] forthstart
  $21 cell do  \ if we have a forthstart we can define head? with it
    dup i - count $9F and + cfaligned over alias-mask + = if  \ otherwise leave out the head? check
      i - cell - unloop exit  
   : head? ( addr -- f )
   \G heuristic check whether addr is a name token; may deliver false
   \G positives; addr must be a valid address; returns 1 for
   \G particularly unsafe positives
       \ we follow the link fields and check for plausibility; two
       \ iterations should catch most false addresses: on the first
       \ iteration, we may get an xt, on the second a code address (or
       \ some code), which is typically not in the dictionary.
       \ we added a third iteration for working with code and ;code words.
       3 0 do
           dup dup aligned <> if \ protect @ against unaligned accesses
               drop false unloop exit
           then
           dup @ dup
           if ( addr addr1 )
               dup rot forthstart within
               if \ addr1 is outside forthstart..addr, not a head
                   drop false unloop exit
               then ( addr1 )
           else \ 0 in the link field, no further checks
               2drop 1 unloop exit \ this is very unsure, so return 1
           then
       loop
       \ in dubio pro:
       drop true ;
   
   : >head-noprim ( cfa -- nt ) \ gforth  to-head-noprim
       \ also heuristic
       dup forthstart - max-name-length @ float+ cell+ min cell max cell ?do ( cfa )
           dup i - dup @ [ alias-mask lcount-mask or ] literal
           [ 1 bits/char 3 - lshift 1 - 1 bits/char 1 - lshift or
           -1 cells allot bigendian [IF]   c, -1 1 cells 1- times
           [ELSE] -1 1 cells 1- times c, [THEN] ]
           and ( cfa len|alias )
           swap + cell+ cfaligned over alias-mask + =
           if ( cfa )
               dup i - cell - dup head?
               if
                   nip unloop exit
               then
               drop
    then     then
  cell +loop   cell +loop
  drop ??? ( wouldn't 0 be better? ) ;   drop ??? ( wouldn't 0 be better? ) ;
   
 ' >head ALIAS >name  [ELSE]
   
   : >head-noprim ( cfa -- nt ) \ gforth  to-head-noprim
       $25 cell do ( cfa )
           dup i - dup @ [ alias-mask lcount-mask or ] literal
           [ 1 bits/char 3 - lshift 1 - 1 bits/char 1 - lshift or
           -1 cells allot bigendian [IF]   c, -1 1 cells 1- times
           [ELSE] -1 1 cells 1- times c, [THEN] ]
           and ( cfa len|alias )
           swap + cell + cfaligned over alias-mask + =
           if ( cfa ) i - cell - unloop exit
           then
           cell +loop
       drop ??? ( wouldn't 0 be better? ) ;
   
   [THEN]
   
   cell% 2* 0 0 field >body ( xt -- a_addr ) \ core
   \G Get the address of the body of the word represented by @i{xt} (the
   \G address of the word's data field).
   drop drop
   
   cell% -2 * 0 0 field body> ( xt -- a_addr )
       drop drop
   
   has? standardthreading has? compiler and [IF]
   
   ' @ alias >code-address ( xt -- c_addr ) \ gforth
   \G @i{c-addr} is the code address of the word @i{xt}.
   
   : >does-code ( xt -- a_addr ) \ gforth
   \G If @i{xt} is the execution token of a child of a @code{DOES>} word,
   \G @i{a-addr} is the start of the Forth code after the @code{DOES>};
   \G Otherwise @i{a-addr} is 0.
       dup @ dodoes: = if
           cell+ @
       else
           drop 0
       endif ;
   
   ' ! alias code-address! ( c_addr xt -- ) \ gforth
   \G Create a code field with code address @i{c-addr} at @i{xt}.
   
   : does-code! ( a_addr xt -- ) \ gforth
   \G Create a code field at @i{xt} for a child of a @code{DOES>}-word;
   \G @i{a-addr} is the start of the Forth code after @code{DOES>}.
       dodoes: over ! cell+ ! ;
   
   ' drop alias does-handler! ( a_addr -- ) \ gforth
   \G Create a @code{DOES>}-handler at address @i{a-addr}. Normally,
   \G @i{a-addr} points just behind a @code{DOES>}.
   
   2 cells constant /does-handler ( -- n ) \ gforth
   \G The size of a @code{DOES>}-handler (includes possible padding).
   
 : body> 0 >body - ;  [THEN]
   
 : (search-wordlist)  ( addr count wid -- nt / false )  : (search-wordlist)  ( addr count wid -- nt | false )
     dup wordlist-map @ find-method perform ;      dup wordlist-map @ find-method perform ;
   
 : search-wordlist ( addr count wid -- 0 / xt +-1 ) \ search  : search-wordlist ( c-addr count wid -- 0 | xt +-1 ) \ search
     \ xt is the interpretation semantics      \G Search the word list identified by @i{wid} for the definition
       \G named by the string at @i{c-addr count}.  If the definition is
       \G not found, return 0. If the definition is found return 1 (if
       \G the definition is immediate) or -1 (if the definition is not
       \G immediate) together with the @i{xt}.  In Gforth, the @i{xt}
       \G returned represents the interpretation semantics.  ANS Forth
       \G does not specify clearly what @i{xt} represents.
     (search-wordlist) dup if      (search-wordlist) dup if
         (name>intn)          (name>intn)
     then ;      then ;
   
 : find-name ( c-addr u -- nt/0 ) \ gforth  : find-name ( c-addr u -- nt | 0 ) \ gforth
     \g Find the name @var{c-addr u} in the current search      \g Find the name @i{c-addr u} in the current search
     \g order. Return its nt, if found, otherwise 0.      \g order. Return its @i{nt}, if found, otherwise 0.
     lookup @ (search-wordlist) ;      lookup @ (search-wordlist) ;
   
 : sfind ( c-addr u -- 0 / xt +-1  ) \ gforth-obsolete  : sfind ( c-addr u -- 0 / xt +-1  ) \ gforth-obsolete
Line 294 
Line 548 
         then          then
    then ;     then ;
   
 : find ( c-addr -- xt +-1 / c-addr 0 ) \ core,search  : find ( c-addr -- xt +-1 | c-addr 0 ) \ core,search
       \G Search all word lists in the current search order for the
       \G definition named by the counted string at @i{c-addr}.  If the
       \G definition is not found, return 0. If the definition is found
       \G return 1 (if the definition has non-default compilation
       \G semantics) or -1 (if the definition has default compilation
       \G semantics).  The @i{xt} returned in interpret state represents
       \G the interpretation semantics.  The @i{xt} returned in compile
       \G state represented either the compilation semantics (for
       \G non-default compilation semantics) or the run-time semantics
       \G that the compilation semantics would @code{compile,} (for
       \G default compilation semantics).  The ANS Forth standard does
       \G not specify clearly what the returned @i{xt} represents (and
       \G also talks about immediacy instead of non-default compilation
       \G semantics), so this word is questionable in portable programs.
       \G If non-portability is ok, @code{find-name} and friends are
       \G better (@pxref{Name token}).
     dup count sfind dup      dup count sfind dup
     if      if
         rot drop          rot drop
     then ;      then ;
   
 \ ticks  \ ticks in interpreter
   
 : (') ( "name" -- nt ) \ gforth  : (') ( "name" -- nt ) \ gforth
     name find-name dup 0=      name name-too-short?
       find-name dup 0=
     IF      IF
         drop -&13 bounce          drop -&13 throw
     THEN  ;      THEN  ;
   
 : '    ( "name" -- xt ) \ core  tick  : '    ( "name" -- xt ) \ core  tick
     \g @var{xt} represents @var{name}'s interpretation      \g @i{xt} represents @i{name}'s interpretation
     \g semantics. Performs @code{-14 throw} if the word has no      \g semantics. Perform @code{-14 throw} if the word has no
     \g interpretation semantics.      \g interpretation semantics.
     (') name?int ;      (') name?int ;
   
   has? compiler 0= [IF]   \ interpreter only version of IS and TO
   
   : IS ' >body ! ;
   ' IS Alias TO
   
   [THEN]
   
 \ \ the interpreter loop                                  mar92py  \ \ the interpreter loop                                  mar92py
   
 \ interpret                                            10mar92py  \ interpret                                            10mar92py
   
 Defer parser  Defer parser1 ( c-addr u -- ... xt)
 Defer name ( -- c-addr count ) \ gforth  \ "... xt" is the action to be performed by the text-interpretation of c-addr u
 \ get the next word from the input buffer  
 ' (name) IS name  
 Defer compiler-notfound ( c-addr count -- )  
 Defer interpreter-notfound ( c-addr count -- )  
   
 : no.extensions  ( addr u -- )  : parser ( c-addr u -- ... )
     2drop -&13 bounce ;  \ text-interpret the word/number c-addr u, possibly producing a number
 ' no.extensions IS compiler-notfound      parser1 execute ;
 ' no.extensions IS interpreter-notfound  
   
 : interpret ( ?? -- ?? ) \ gforth  Defer parse-name ( "name" -- c-addr u ) \ gforth
     \ interpret/compile the (rest of the) input buffer  \G Get the next word from the input buffer
   ' (name) IS parse-name
   
   ' parse-name alias parse-word ( -- c-addr u ) \ gforth-obsolete
   \G old name for @code{parse-name}
   
   ' parse-name alias name ( -- c-addr u ) \ gforth-obsolete
   \G old name for @code{parse-name}
   
   Defer compiler-notfound1 ( c-addr count -- ... xt )
   Defer interpreter-notfound1 ( c-addr count -- ... xt )
   
   : no.extensions  ( addr u -- )
       2drop -&13 throw ;
   ' no.extensions IS compiler-notfound1
   ' no.extensions IS interpreter-notfound1
   
   Defer before-word ( -- ) \ gforth
   \ called before the text interpreter parses the next word
   ' noop IS before-word
   
   : interpret1 ( ... -- ... )
   [ has? backtrace [IF] ]
       rp@ backtrace-rp0 !
   [ [THEN] ]
     BEGIN      BEGIN
         ?stack name dup          ?stack before-word name dup
     WHILE      WHILE
         parser          parser1 execute
     REPEAT      REPEAT
     2drop ;      2drop ;
   
   : interpret ( ?? -- ?? ) \ gforth
       \ interpret/compile the (rest of the) input buffer
   [ has? backtrace [IF] ]
       backtrace-rp0 @ >r
   [ [THEN] ]
       ['] interpret1 catch
   [ has? backtrace [IF] ]
       r> backtrace-rp0 !
       [ [THEN] ]
       throw ;
   
 \ interpreter                                   30apr92py  \ interpreter                                   30apr92py
   
 \ not the most efficient implementations of interpreter and compiler  \ not the most efficient implementations of interpreter and compiler
 : interpreter ( c-addr u -- )  : interpreter1 ( c-addr u -- ... xt )
     2dup find-name dup      2dup find-name dup
     if      if
         nip nip name>int execute          nip nip name>int
     else      else
         drop          drop
         2dup 2>r snumber?          2dup 2>r snumber?
         IF          IF
             2rdrop              2rdrop ['] noop
         ELSE          ELSE
             2r> interpreter-notfound              2r> interpreter-notfound1
         THEN          THEN
     then ;      then ;
   
 ' interpreter  IS  parser  ' interpreter1  IS  parser1
   
 \ \ Query Evaluate                                      07apr93py  \ \ Query Evaluate                                      07apr93py
   
 has? file 0= [IF]  has? file 0= [IF]
 : sourceline# ( -- n )  loadline @ ;  : sourceline# ( -- n )  1 ;
   [ELSE]
   has? new-input 0= [IF]
   Variable #fill-bytes
   \G number of bytes read via (read-line) by the last refill
   [THEN]
 [THEN]  [THEN]
   
   has? new-input 0= [IF]
   : input-start-line ( -- ) >in off ;
   : input-lexeme! ( c-addr n -- ) 2drop ;
 : refill ( -- flag ) \ core-ext,block-ext,file-ext  : refill ( -- flag ) \ core-ext,block-ext,file-ext
   blk @  IF  1 blk +!  true  0 >in !  EXIT  THEN      \G Attempt to fill the input buffer from the input source.  When
       \G the input source is the user input device, attempt to receive
       \G input into the terminal input device. If successful, make the
       \G result the input buffer, set @code{>IN} to 0 and return true;
       \G otherwise return false. When the input source is a block, add 1
       \G to the value of @code{BLK} to make the next block the input
       \G source and current input buffer, and set @code{>IN} to 0;
       \G return true if the new value of @code{BLK} is a valid block
       \G number, false otherwise. When the input source is a text file,
       \G attempt to read the next line from the file. If successful,
       \G make the result the current input buffer, set @code{>IN} to 0
       \G and return true; otherwise, return false.  A successful result
       \G includes receipt of a line containing 0 characters.
       [ has? file [IF] ]
           blk @  IF  1 blk +!  true  input-start-line  EXIT  THEN
           [ [THEN] ]
   tib /line    tib /line
 [ has? file [IF] ]  [ has? file [IF] ]
   loadfile @ ?dup    loadfile @ ?dup
   IF    read-line throw          IF    (read-line) throw #fill-bytes !
   ELSE    ELSE
 [ [THEN] ]  [ [THEN] ]
       sourceline# 0< IF 2drop false EXIT THEN        sourceline# 0< IF 2drop false EXIT THEN
       accept true        accept true
 [ has? file [IF] ]  [ has? file [IF] ]
   THEN    THEN
 [ [THEN] ]  
   1 loadline +!    1 loadline +!
   swap #tib ! 0 >in ! ;          [ [THEN] ]
       swap #tib ! input-start-line ;
   
 : query   ( -- ) \ core-ext  : query   ( -- ) \ core-ext
     \G obsolescent      \G Make the user input device the input source. Receive input into
       \G the Terminal Input Buffer. Set @code{>IN} to zero. OBSOLESCENT:
       \G superceeded by @code{accept}.
       [ has? file [IF] ]
     blk off loadfile off      blk off loadfile off
     tib /line accept #tib ! 0 >in ! ;          [ [THEN] ]
       refill drop ;
   [THEN]
   
 \ save-mem extend-mem  \ save-mem extend-mem
   
Line 394 
Line 730 
     dup allocate throw      dup allocate throw
     swap 2dup r> -rot move ;      swap 2dup r> -rot move ;
   
   : free-mem-var ( addr -- )
       \ addr is the address of a 2variable containing address and size
       \ of a memory range; frees memory and clears the 2variable.
       dup 2@ drop dup
       if ( addr mem-start )
           free throw
           0 0 rot 2!
       else
           2drop
       then ;
   
 : extend-mem    ( addr1 u1 u -- addr addr2 u2 )  : extend-mem    ( addr1 u1 u -- addr addr2 u2 )
     \ extend memory block allocated from the heap by u aus      \ extend memory block allocated from the heap by u aus
     \ the (possibly reallocated piece is addr2 u2, the extension is at addr      \ the (possibly reallocated) piece is addr2 u2, the extension is at addr
     over >r + dup >r resize throw      over >r + dup >r resize throw
     r> over r> + -rot ;      r> over r> + -rot ;
 [THEN]  [THEN]
   
 \ EVALUATE                                              17may93jaw  \ EVALUATE                                              17may93jaw
   
 has? file 0= [IF]  has? file 0= has? new-input 0= and [IF]
 : push-file  ( -- )  r>  : push-file  ( -- )  r>
   sourceline# >r  tibstack @ >r  >tib @ >r  #tib @ >r    tibstack @ >r  >tib @ >r  #tib @ >r
   >tib @ tibstack @ = IF  r@ tibstack +!  THEN    >tib @ tibstack @ = IF  r@ tibstack +!  THEN
   tibstack @ >tib ! >in @ >r  >r ;    tibstack @ >tib ! >in @ >r  >r ;
   
 : pop-file   ( throw-code -- throw-code )  : pop-file   ( throw-code -- throw-code )
   r>    r>
   r> >in !  r> #tib !  r> >tib !  r> tibstack !  r> loadline !  >r ;    r> >in !  r> #tib !  r> >tib !  r> tibstack !  >r ;
 [THEN]  [THEN]
   
 : evaluate ( c-addr len -- ) \ core,block  has? new-input 0= [IF]
   : evaluate ( c-addr u -- ) \ core,block
       \G Save the current input source specification. Store @code{-1} in
       \G @code{source-id} and @code{0} in @code{blk}. Set @code{>IN} to
       \G @code{0} and make the string @i{c-addr u} the input source
       \G and input buffer. Interpret. When the parse area is empty,
       \G restore the input source specification.
   [ has? file [IF] ]
       s" *evaluated string*" loadfilename>r
   [ [THEN] ]
   push-file  #tib ! >tib !    push-file  #tib ! >tib !
   >in off blk off loadfile off -1 loadline !      input-start-line
       [ has? file [IF] ]
           blk off loadfile off -1 loadline !
           [ [THEN] ]
   ['] interpret catch    ['] interpret catch
   pop-file throw ;      pop-file
   [ has? file [IF] ]
       r>loadfilename
   [ [THEN] ]
       throw ;
   [THEN]
   
 \ \ Quit                                                13feb93py  \ \ Quit                                                13feb93py
   
Line 428 
Line 792 
   
 : prompt        state @ IF ."  compiled" EXIT THEN ."  ok" ;  : prompt        state @ IF ."  compiled" EXIT THEN ."  ok" ;
   
 : (Query)  ( -- )  : (quit) ( -- )
     loadfile off  blk off loadline off refill drop ;      \ exits only through THROW etc.
       BEGIN
 : (quit)  BEGIN  .status cr (query) interpret prompt  AGAIN ;          .status
           ['] cr catch if
               >stderr cr ." Can't print to stdout, leaving" cr
               \ if stderr does not work either, already DoError causes a hang
               2 (bye)
           endif
           refill WHILE
               interpret prompt
       REPEAT
       bye ;
   
 ' (quit) IS 'quit  ' (quit) IS 'quit
   
 \ \ DOERROR (DOERROR)                                   13jun93jaw  \ \ DOERROR (DOERROR)                                   13jun93jaw
   
   has? ec 0= [IF]
 8 Constant max-errors  8 Constant max-errors
   5 has? file 2 and + Constant /error
 Variable error-stack  0 error-stack !  Variable error-stack  0 error-stack !
 max-errors 6 * cells allot  max-errors /error * cells allot
 \ format of one cell:  \ format of one cell:
 \ source ( addr u )  \ source ( c-addr u )
 \ >in  \ last parsed lexeme ( c-addr u )
 \ line-number  \ line-number
 \ Loadfilename ( addr u )  \ Loadfilename ( addr u )
   
   : error> ( --  c-addr1 u1 c-addr2 u2 line# [addr u] )
       -1 error-stack +!
       error-stack dup @
       /error * cells + cell+
       /error cells bounds DO
           I @
       cell +LOOP ;
   
   : >error ( c-addr1 u1 c-addr2 u2 line# [addr u] -- )
       error-stack dup @ dup 1+
       max-errors 1- min error-stack !
       /error * cells + cell+
       /error 1- cells bounds swap DO
           I !
       -1 cells +LOOP ;
   
   : input-error-data ( -- c-addr1 u1 c-addr2 u2 line# [addr u] )
       \ error data for the current input, to be used by >error or .error-frame
       source input-lexeme 2@ sourceline#
       [ has? file [IF] ] sourcefilename [ [THEN] ] ;
   
 : dec. ( n -- ) \ gforth  : dec. ( n -- ) \ gforth
     \ print value in decimal representation      \G Display @i{n} as a signed decimal number, followed by a space.
       \ !! not used...
     base @ decimal swap . base ! ;      base @ decimal swap . base ! ;
   
   : dec.r ( u n -- ) \ gforth
       \G Display @i{u} as a unsigned decimal number in a field @i{n}
       \G characters wide.
       base @ >r decimal .r r> base ! ;
   
 : hex. ( u -- ) \ gforth  : hex. ( u -- ) \ gforth
     \ print value as unsigned hex number      \G Display @i{u} as an unsigned hex number, prefixed with a "$" and
     '$ emit base @ swap hex u. base ! ;      \G followed by a space.
       \ !! not used...
       [char] $ emit base @ swap hex u. base ! ;
   
   : -trailing  ( c_addr u1 -- c_addr u2 ) \ string dash-trailing
   \G Adjust the string specified by @i{c-addr, u1} to remove all
   \G trailing spaces. @i{u2} is the length of the modified string.
       BEGIN
           dup
       WHILE
           1- 2dup + c@ bl <>
       UNTIL  1+  THEN ;
   
 : typewhite ( addr u -- ) \ gforth  DEFER DOERROR
     \ like type, but white space is printed instead of the characters  
     bounds ?do  has? backtrace [IF]
         i c@ #tab = if \ check for tab  Defer dobacktrace ( -- )
             #tab  ' noop IS dobacktrace
         else  [THEN]
             bl  
   : .error-string ( throw-code -- )
     dup -2 =
     IF    "error @ ?dup IF count type  THEN drop
     ELSE  .error
     THEN ;
   
   : umin ( u1 u2 -- u )
       2dup u>
       if
           swap
         then          then
         emit      drop ;
     loop ;  
   
 DEFER DOERROR  Defer mark-start
   Defer mark-end
   
 : .error-frame ( addr1 u1 n1 n2 addr2 u2 -- )  :noname ." >>>" ; IS mark-start
   cr error-stack @  :noname ." <<<" ; IS mark-end
   IF  
      ." in file included from "  : part-type ( addr1 u1 u -- addr2 u2 )
      type ." :" dec.  drop 2drop      \ print first u characters of addr1 u1, addr2 u2 is the rest
       over umin 2 pick over type /string ;
   
   : .error-line ( c-addr1 u1 c-addr2 u2 -- )
       \ print error in line c-addr1 u1, where the error-causing lexeme
       \ is c-addr2 u2
       >r 2 pick - part-type ( c-addr3 u3 R: u2 )
       mark-start r> part-type mark-end ( c-addr4 u4 )
       type ;
   
   : .error-frame ( throwcode addr1 u1 addr2 u2 n2 [addr3 u3] -- throwcode )
       \ addr3 u3: filename of included file - optional
       \ n2:       line number
       \ addr2 u2: parsed lexeme (should be marked as causing the error)
       \ addr1 u1: input line
       error-stack @
       IF ( throwcode addr1 u1 n0 n1 n2 [addr2 u2] )
           [ has? file [IF] ] \ !! unbalanced stack effect
             over IF
                 cr ." in file included from "
                 type ." :"
                 0 dec.r  2drop 2drop
   ELSE    ELSE
      type ." :" dec.                2drop 2drop 2drop drop
      cr dup 2over type cr drop  
      nip -trailing 1- ( line-start index2 )  
      0 >r  BEGIN  
                   2dup + c@ bl >  WHILE  
                   r> 1+ >r  1- dup 0<  UNTIL  THEN  1+  
      ( line-start index1 )  
      typewhite  
      r> 1 max 0 ?do \ we want at least one "^", even if the length is 0  
                   [char] ^ emit  
      loop  
   THEN    THEN
 ;            [ [THEN] ] ( throwcode addr1 u1 n0 n1 n2 )
       ELSE ( throwcode addr1 u1 n0 n1 n2 [addr2 u2] )
           [ has? file [IF] ]
               cr type ." :"
               [ [THEN] ] ( throwcode addr1 u1 n0 n1 n2 )
           dup 0 dec.r ." : " 5 pick .error-string
           IF \ if line# non-zero, there is a line
               cr .error-line
           ELSE
               2drop 2drop
           THEN
       THEN ;
   
 : (DoError) ( throw-code -- )  : (DoError) ( throw-code -- )
   [ has? os [IF] ]    [ has? os [IF] ]
       outfile-id dup flush-file drop >r        >stderr
       stderr to outfile-id  
   [ [THEN] ]    [ [THEN] ]
   sourceline# IF    input-error-data .error-frame
                source >in @ sourceline# 0 0 .error-frame  
   THEN  
   error-stack @ 0 ?DO    error-stack @ 0 ?DO
     -1 error-stack +!      error>
     error-stack dup @ 6 * cells + cell+  
     6 cells bounds DO  
       I @  
     cell +LOOP  
     .error-frame      .error-frame
   LOOP    LOOP
   dup -2 =  
   IF  
      "error @ ?dup  
      IF  
         cr count type  
      THEN  
      drop       drop
   ELSE  [ has? backtrace [IF] ]
      .error    dobacktrace
   THEN  [ [THEN] ]
   normal-dp dpp !    normal-dp dpp ! ;
   [ has? os [IF] ] r> to outfile-id [ [THEN] ]  
   ;  
   
 ' (DoError) IS DoError  ' (DoError) IS DoError
   
   [ELSE]
       : dec.  base @ >r decimal . r> base ! ;
       : DoError ( throw-code -- ) ." Error# " dec. cr ;
   [THEN]
   
 : quit ( ?? -- ?? ) \ core  : quit ( ?? -- ?? ) \ core
     rp0 @ rp! handler off clear-tibstack >tib @ >r      \G Empty the return stack, make the user input device
       \G the input source, enter interpret state and start
       \G the text interpreter.
       rp0 @ rp! handler off clear-tibstack
       [ has? new-input 0= [IF] ] >tib @ >r [ [THEN] ]
     BEGIN      BEGIN
         [ has? compiler [IF] ]          [ has? compiler [IF] ]
         postpone [              [compile] [
         [ [THEN] ]          [ [THEN] ]
           \ stack depths may be arbitrary here
         ['] 'quit CATCH dup          ['] 'quit CATCH dup
     WHILE      WHILE
         DoError r@ >tib ! r@ tibstack !              <# \ reset hold area, or we may get another error
               DoError
               \ stack depths may be arbitrary still (or again), so clear them
               clearstacks
               [ has? new-input [IF] ] clear-tibstack
               [ [ELSE] ] r@ >tib ! r@ tibstack !
               [ [THEN] ]
     REPEAT      REPEAT
     drop r> >tib ! ;      drop [ has? new-input [IF] ] clear-tibstack
       [ [ELSE] ] r> >tib !
       [ [THEN] ] ;
   
 \ \ Cold Boot                                           13feb93py  \ \ Cold Boot                                           13feb93py
   
 : (bootmessage)  : (bootmessage)
     ." GForth " version-string type      ." Gforth " version-string type
     ." , Copyright (C) 1994-1998 Free Software Foundation, Inc." cr      ." , Copyright (C) 1995-2006 Free Software Foundation, Inc." cr
     ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'"      ." Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'"
 [ has? os [IF] ]  [ has? os [IF] ]
      cr ." Type `bye' to exit"       cr ." Type `bye' to exit"
 [ [THEN] ] ;  [ [THEN] ] ;
   
 defer bootmessage  defer bootmessage
   has? file [IF]
 defer process-args  defer process-args
   [THEN]
   
 ' (bootmessage) IS bootmessage  ' (bootmessage) IS bootmessage
   
 Defer 'cold  has? ec 0= [IF]
   Defer 'cold ( -- ) \ gforth  tick-cold
 \ hook (deferred word) for things to do right before interpreting the  \ hook (deferred word) for things to do right before interpreting the
 \ command-line arguments  \ command-line arguments
 ' noop IS 'cold  ' noop IS 'cold
   [THEN]
   
 include ../chains.fs  AVariable init8 NIL init8 !
   
 Variable init8  
   
 : cold ( -- ) \ gforth  : cold ( -- ) \ gforth
       [ has? backtrace [IF] ]
       rp@ backtrace-rp0 !
   [ [THEN] ]
 [ has? file [IF] ]  [ has? file [IF] ]
     pathstring 2@ fpath only-path      os-cold
     init-included-files  
 [ [THEN] ]  [ [THEN] ]
   [ has? ec 0= [IF] ]
       set-encoding-fixed-width
     'cold      'cold
   [ [THEN] ]
     init8 chainperform      init8 chainperform
 [ has? file [IF] ]  [ has? file [IF] ]
     ['] process-args catch ?dup      process-args
     IF      loadline off
       dup >r DoError cr r> negate (bye)  
     THEN  
     argc @ 1 >  
     IF  \ there may be some unfinished line, so let's finish it  
         cr  
     THEN  
 [ [THEN] ]  [ [THEN] ]
     bootmessage      bootmessage
     loadline off quit ;      quit ;
   
   has? new-input 0= [IF]
 : clear-tibstack ( -- )  : clear-tibstack ( -- )
 [ has? glocals [IF] ]  [ has? glocals [IF] ]
     lp@ forthstart 7 cells + @ -      lp@ forthstart 7 cells + @ -
 [ [ELSE] ]  [ [ELSE] ]
     [ has? os [IF] ]      [ has? os [IF] ]
     sp@ $1040 +      r0 @ forthstart 6 cells + @ -
     [ [ELSE] ]      [ [ELSE] ]
     sp@ $40 +      sp@ $10 cells +
     [ [THEN] ]      [ [THEN] ]
 [ [THEN] ]  [ [THEN] ]
     dup >tib ! tibstack ! #tib off >in off ;      dup >tib ! tibstack ! #tib off input-start-line ;
   [THEN]
   
 : boot ( path **argv argc -- )  : boot ( path n **argv argc -- )
   [ has? no-userspace 0= [IF] ]
     main-task up!      main-task up!
   [ [THEN] ]
 [ has? os [IF] ]  [ has? os [IF] ]
     stdout TO outfile-id      os-boot
 \ !! [ [THEN] ]  [ [THEN] ]
 \ !! [ has? file [IF] ]  [ has? rom [IF] ]
     argc ! argv ! pathstring 2!      ram-mirror ram-start ram-size move
 [ [THEN] ]  [ [THEN] ]
     sp@ sp0 !      sp@ sp0 !
   [ has? peephole [IF] ]
       \ only needed for greedy static superinstruction selection
       \ primtable prepare-peephole-table TO peeptable
   [ [THEN] ]
   [ has? new-input [IF] ]
       current-input off
   [ [THEN] ]
     clear-tibstack      clear-tibstack
       0 0 includefilename 2!
     rp@ rp0 !      rp@ rp0 !
 [ has? floating [IF] ]  [ has? floating [IF] ]
     fp@ fp0 !      fp@ fp0 !
 [ [THEN] ]  [ [THEN] ]
     ['] cold catch DoError      handler off
       ['] cold catch dup -&2049 <> if \ broken pipe?
           DoError cr
       endif
 [ has? os [IF] ]  [ has? os [IF] ]
     bye      1 (bye) \ !! determin exit code from throw code?
 [ [THEN] ]  [ [THEN] ]
 ;  ;
   

Generate output suitable for use with a patch program
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.136
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help