Diff for /gforth/Attic/kernal.fs between versions 1.6 and 1.7

version 1.6, 1994/05/18 17:29:55 version 1.7, 1994/06/01 10:05:18
Line 131  Defer source Line 131  Defer source
   dup count chars bounds    dup count chars bounds
   ?DO  I c@ toupper I c! 1 chars +LOOP ;    ?DO  I c@ toupper I c! 1 chars +LOOP ;
 : (name)  ( -- addr )  bl word ;  : (name)  ( -- addr )  bl word ;
   : (cname) ( -- addr )  bl word capitalize ;
   
 \ Literal                                              17dec92py  \ Literal                                              17dec92py
   
Line 594  AVariable current Line 595  AVariable current
   
 \ word list structure:  \ word list structure:
 \ struct  \ struct
 \   1 cells: field find-method \ xt: ( c_addr u w1 -- name-id ) w1 is a method-\ specific wordlist-id (not the same as wid)  \   1 cells: field find-method   \ xt: ( c_addr u wid -- name-id )
 \   1 cells: field reveal-method \ xt: ( -- )  \   1 cells: field reveal-method \ xt: ( -- )
   \   1 cells: field rehash-method \ xt: ( wid -- )
 \   \ !! what else  \   \ !! what else
 \ end-struct wordlist-map-struct  \ end-struct wordlist-map-struct
   
 \ struct  \ struct
 \   1 cells: field wordlist-id \ not the same as wid; representation depends on implementation  \   1 cells: field wordlist-id \ not the same as wid; representation depends on implementation
 \   1 cells: field wordlist-map \ pointer to a wordlist-map-struct  \   1 cells: field wordlist-map \ pointer to a wordlist-map-struct
 \   1 cells: field ????  \   1 cells: field wordlist-link \ link field to other wordlists
 \   1 cells: field ????  \   1 cells: field wordlist-extend \ points to wordlist extensions (eg hash)
 \ end-struct wordlist-struct  \ end-struct wordlist-struct
   
   : f83find      ( addr len wordlist -- nfa / false )  @ (f83find) ;
   : f83casefind  ( addr len wordlist -- nfa / false )  @ (f83casefind) ;
   
 \ Search list table: find reveal  \ Search list table: find reveal
 Create f83search    ' (f83find) A,  ' (reveal) A,  Create f83search       ' f83casefind A,  ' (reveal) A,  ' drop A,
   
   : caps-name       ['] (cname) IS name  ['] f83find     f83search ! ;
   : case-name       ['] (name)  IS name  ['] f83casefind f83search ! ;
   : case-sensitive  ['] (name)  IS name  ['] f83find     f83search ! ;
   
 Create forth-wordlist  NIL A, G f83search T A, NIL A, NIL A,  Create forth-wordlist  NIL A, G f83search T A, NIL A, NIL A,
 AVariable search       G forth-wordlist search T !  AVariable search       G forth-wordlist search T !
 G forth-wordlist current T !  G forth-wordlist current T !
   
 : (search-wordlist)  ( addr count wid -- nfa / false )  : (search-wordlist)  ( addr count wid -- nfa / false )
   dup @ swap cell+ @ @ execute ;    dup ( @ swap ) cell+ @ @ execute ;
   
 : search-wordlist  ( addr count wid -- 0 / xt +-1 )  : search-wordlist  ( addr count wid -- 0 / xt +-1 )
   (search-wordlist) dup  IF  found  THEN ;    (search-wordlist) dup  IF  found  THEN ;
Line 644  Variable warnings  G -1 warnings T ! Line 653  Variable warnings  G -1 warnings T !
  then   then
  current @ cell+ @ cell+ @ execute ;   current @ cell+ @ cell+ @ execute ;
   
   : rehash  ( wid -- )  dup cell+ @ cell+ cell+ @ execute ;
   
 : '    ( "name" -- addr )  name find 0= no.extensions ;  : '    ( "name" -- addr )  name find 0= no.extensions ;
 : [']  ( "name" -- addr )  ' postpone ALiteral ; immediate  : [']  ( "name" -- addr )  ' postpone ALiteral ; immediate
 \ Input                                                13feb93py  \ Input                                                13feb93py

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


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