Diff for /gforth/Attic/kernal.fs between versions 1.28 and 1.31

version 1.28, 1995/02/06 18:14:34 version 1.31, 1995/02/23 20:17:20
Line 704  Avariable leave-sp  leave-stack 3 cells Line 704  Avariable leave-sp  leave-stack 3 cells
cell - dup @ swap      cell - dup @ swap
leave-sp ! ;      leave-sp ! ;

: DONE ( orig -- )  drop >r drop  : DONE ( orig -- )
drop >r drop
begin      begin
leave>          leave>
over r@ u>=          over r@ u>=
Line 917  Create ???  0 , 3 c, char ? c, char ? c, Line 918  Create ???  0 , 3 c, char ? c, char ? c,
: Constant  (Constant) , ;  : Constant  (Constant) , ;
: AConstant (Constant) A, ;  : AConstant (Constant) A, ;

: 2CONSTANT  : 2Constant
create ( w1 w2 "name" -- )      Create ( w1 w2 "name" -- )
2,          2,
does> ( -- w1 w2 )      DOES> ( -- w1 w2 )
2@ ;          2@ ;

\ IS Defer What's Defers TO                            24feb93py  \ IS Defer What's Defers TO                            24feb93py
Line 980  AVariable current Line 981  AVariable current
\ object oriented search list                          17mar93py  \ object oriented search list                          17mar93py

\ word list structure:  \ word list structure:
\ struct
\   1 cells: field find-method   \ xt: ( c_addr u wid -- name-id )  struct
\   1 cells: field reveal-method \ xt: ( -- )    1 cells: field find-method   \ xt: ( c_addr u wid -- name-id )
\   1 cells: field rehash-method \ xt: ( wid -- )    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 wordlist-extend \ points to wordlist extensions (eg hash)    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) ;  : f83find      ( addr len wordlist -- nfa / false )  @ (f83find) ;

Line 1004  AVariable lookup       G forth-wordlist Line 1006  AVariable lookup       G forth-wordlist
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 cell+ @ @ execute ;    dup wordlist-map @ find-method @ 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 1038  Variable warnings  G -1 warnings T ! Line 1040  Variable warnings  G -1 warnings T !
last? if   last? if
then   then
current @ cell+ @ cell+ @ execute ;   current @ wordlist-map @ reveal-method @ execute ;

: rehash  ( wid -- )  dup cell+ @ cell+ cell+ @ execute ;  : rehash  ( wid -- )  dup wordlist-map @ rehash-method @ execute ;

: '    ( "name" -- addr )  name sfind 0= if -&13 bounce then ;  : '    ( "name" -- addr )  name sfind 0= if -&13 bounce then ;
: [']  ( "name" -- addr )  ' postpone ALiteral ; immediate  : [']  ( "name" -- addr )  ' postpone ALiteral ; immediate
Line 1469  Defer 'cold ' noop IS 'cold Line 1471  Defer 'cold ' noop IS 'cold

: cold ( -- )  : cold ( -- )
pathstring 2@ process-path pathdirs 2!      pathstring 2@ process-path pathdirs 2!
0 0 included-files 2!
'cold      'cold
argc @ 1 >      argc @ 1 >
IF      IF

 Removed from v.1.28 changed lines Added in v.1.31

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