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

Diff for /gforth/kernel/int.fs between versions 1.66 and 1.67

version 1.66, 2001/01/23 14:41:54 version 1.67, 2001/01/28 16:54:56
Line 97  Defer source ( -- c-addr u ) \ core Line 97  Defer source ( -- c-addr u ) \ core
     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
   
Line 230  struct Line 230  struct
 end-struct wordlist-struct  end-struct wordlist-struct
   
 : f83find      ( addr len wordlist -- nt / false )  : f83find      ( addr len wordlist -- nt / false )
     wordlist-id @ (f83find) ;      wordlist-id @ (listlfind) ;
   
 : initvoc               ( wid -- )  : initvoc               ( wid -- )
   dup wordlist-map @ hash-method perform ;    dup wordlist-map @ hash-method perform ;
Line 257  forth-wordlist current ! Line 257  forth-wordlist current !
   
 \ \ header, finding, ticks                              17dec92py  \ \ header, finding, ticks                              17dec92py
   
 hex  
 80 constant alias-mask \ set when the word is not an alias!  \ !! these should be done using the target's operations and cell size
 40 constant immediate-mask  \ 0 invert 1 rshift invert ( u ) \ top bit set
 20 constant restrict-mask  \ constant alias-mask \ set when the word is not an alias!
   \ alias-mask 1 rshift constant immediate-mask
   \ alias-mask 2 rshift constant restrict-mask
   \ 0 invert 3 rshift   constant lcount-mask
   
   \ as an intermediate step, I define them correctly for 32-bit machines:
   
   $80000000 constant alias-mask
   $40000000 constant immediate-mask
   $20000000 constant restrict-mask
   $1fffffff constant lcount-mask
   
 \ higher level parts of find  \ higher level parts of find
   
Line 279  hex Line 289  hex
     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 290  hex Line 300  hex
   
 : name>string ( nt -- addr count ) \ gforth     head-to-string  : name>string ( nt -- addr count ) \ gforth     head-to-string
     \g @i{addr count} is the name of the word represented by @i{nt}.      \g @i{addr count} is the name of the word represented by @i{nt}.
     cell+ count $1F and ;      cell+ dup cell+ swap @ 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+ @ dup alias-mask and 0=
     IF      IF
         swap @ swap          swap @ swap
     THEN ;      THEN ;
Line 332  hex Line 342  hex
     ;      ;
   
 : (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 c, char ? c, char ? c, char ? c,
Line 367  const Create ???  0 , 3 c, char ? c, cha Line 377  const Create ???  0 , 3 c, char ? c, cha
     drop true ;      drop true ;
   
 : >head-noprim ( cfa -- nt ) \ gforth  to-head-noprim  : >head-noprim ( cfa -- nt ) \ gforth  to-head-noprim
       \ also heuristic; finds only names with up to 32 chars
     $25 cell do ( cfa )      $25 cell do ( cfa )
         dup i - count $9F and + cfaligned over alias-mask + =          dup i - dup @ [ alias-mask lcount-mask or ] literal and ( cfa len|alias )
           swap + cell + cfaligned over alias-mask + =
         if ( cfa )          if ( cfa )
             dup i - cell - dup head?              dup i - cell - dup head?
             if              if
Line 383  const Create ???  0 , 3 c, char ? c, cha Line 395  const Create ???  0 , 3 c, char ? c, cha
   
 : >head-noprim ( cfa -- nt ) \ gforth  to-head-noprim  : >head-noprim ( cfa -- nt ) \ gforth  to-head-noprim
     $25 cell do ( cfa )      $25 cell do ( cfa )
         dup i - count $9F and + cfaligned over alias-mask + =          dup i - dup @ [ alias-mask lcount-mask or ] literal and ( cfa len|alias )
           swap + cell + cfaligned over alias-mask + =
         if ( cfa ) i - cell - unloop exit          if ( cfa ) i - cell - unloop exit
         then          then
         cell +loop          cell +loop
Removed from v.1.66  
changed lines
  Added in v.1.67

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