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

Diff for /gforth/kernel/int.fs between versions 1.138 and 1.139

version 1.138, 2006/02/25 18:28:12 version 1.139, 2006/02/26 17:23:47
Line 241  const Create bases   0A , 10 ,   2 ,   0 Line 241  const Create bases   0A , 10 ,   2 ,   0
     \G comments into documentation.      \G comments into documentation.
     POSTPONE \ ; immediate      POSTPONE \ ; immediate
   
   has? ec [IF]
       AVariable forth-wordlist
       AVariable context  forth-wordlist context !
       AVariable current  forth-wordlist context !
       | ' (f83find) alias (search-wordlist) ( addr len wid -- nt / false )
       : find-name ( c-addr u -- nt | 0 ) \ gforth
           \g Find the name @i{c-addr u} in the current search
           \g order. Return its @i{nt}, if found, otherwise 0.
           context @ (search-wordlist) ;
   [ELSE]
 \ \ object oriented search list                         17mar93py  \ \ object oriented search list                         17mar93py
   
 \ word list structure:  \ word list structure:
Line 291  Defer context ( -- addr ) \ gforth Line 301  Defer context ( -- addr ) \ gforth
 ' lookup is context  ' lookup is context
 forth-wordlist current !  forth-wordlist current !
   
   : (search-wordlist)  ( addr count wid -- nt | false )
       dup wordlist-map @ find-method perform ;
   
   : search-wordlist ( c-addr count wid -- 0 | xt +-1 ) \ search
       \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
           (name>intn)
       then ;
   
   : find-name ( c-addr u -- nt | 0 ) \ gforth
       \g Find the name @i{c-addr u} in the current search
       \g order. Return its @i{nt}, if found, otherwise 0.
       lookup @ (search-wordlist) ;
   [THEN]
   
 \ \ header, finding, ticks                              17dec92py  \ \ header, finding, ticks                              17dec92py
   
 \ The constants are defined as 32 bits, but then erased  \ The constants are defined as 32 bits, but then erased
Line 523  has? standardthreading has? compiler and Line 554  has? standardthreading has? compiler and
   
 [THEN]    [THEN]  
   
 : (search-wordlist)  ( addr count wid -- nt | false )  
     dup wordlist-map @ find-method perform ;  
   
 : search-wordlist ( c-addr count wid -- 0 | xt +-1 ) \ search  
     \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  
         (name>intn)  
     then ;  
   
 : find-name ( c-addr u -- nt | 0 ) \ gforth  
     \g Find the name @i{c-addr u} in the current search  
     \g order. Return its @i{nt}, if found, otherwise 0.  
     lookup @ (search-wordlist) ;  
   
 : sfind ( c-addr u -- 0 / xt +-1  ) \ gforth-obsolete  : sfind ( c-addr u -- 0 / xt +-1  ) \ gforth-obsolete
     find-name dup      find-name dup
     if ( nt )      if ( nt )
Line 579  has? standardthreading has? compiler and Line 590  has? standardthreading has? compiler and
 \ ticks in interpreter  \ ticks in interpreter
   
 : (') ( "name" -- nt ) \ gforth  : (') ( "name" -- nt ) \ gforth
     name name-too-short?      parse-name name-too-short?
     find-name dup 0=      find-name dup 0=
     IF      IF
         drop -&13 throw          drop -&13 throw
Line 609  Defer parser1 ( c-addr u -- ... xt) Line 620  Defer parser1 ( c-addr u -- ... xt)
 \ text-interpret the word/number c-addr u, possibly producing a number  \ text-interpret the word/number c-addr u, possibly producing a number
     parser1 execute ;      parser1 execute ;
   
   has? ec [IF]
       ' (name) Alias parse-name
       : no.extensions  2drop -13 throw ;
       ' no.extensions Alias compiler-notfound1
       ' no.extensions Alias interpreter-notfound1
   [ELSE]    
 Defer parse-name ( "name" -- c-addr u ) \ gforth  Defer parse-name ( "name" -- c-addr u ) \ gforth
 \G Get the next word from the input buffer  \G Get the next word from the input buffer
 ' (name) IS parse-name  ' (name) IS parse-name
Line 630  Defer interpreter-notfound1 ( c-addr cou Line 647  Defer interpreter-notfound1 ( c-addr cou
 Defer before-word ( -- ) \ gforth  Defer before-word ( -- ) \ gforth
 \ called before the text interpreter parses the next word  \ called before the text interpreter parses the next word
 ' noop IS before-word  ' noop IS before-word
   [THEN]
   
 : interpret1 ( ... -- ... )  : interpret1 ( ... -- ... )
 [ has? backtrace [IF] ]  [ has? backtrace [IF] ]
     rp@ backtrace-rp0 !      rp@ backtrace-rp0 !
 [ [THEN] ]  [ [THEN] ]
     BEGIN      BEGIN
         ?stack before-word name dup          ?stack [ has? EC 0= [IF] ] before-word [ [THEN] ] parse-name dup
     WHILE      WHILE
         parser1 execute          parser1 execute
     REPEAT      REPEAT
Line 1038  has? new-input 0= [IF] Line 1056  has? new-input 0= [IF]
     [ has? os [IF] ]      [ has? os [IF] ]
     r0 @ forthstart 6 cells + @ -      r0 @ forthstart 6 cells + @ -
     [ [ELSE] ]      [ [ELSE] ]
     sp@ $10 cells +      sp@ cell+
     [ [THEN] ]      [ [THEN] ]
 [ [THEN] ]  [ [THEN] ]
     dup >tib ! tibstack ! #tib off      dup >tib ! tibstack ! #tib off
Removed from v.1.138  
changed lines
  Added in v.1.139

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