[gforth] / gforth / kernel / Attic / interp.fs  

gforth: gforth/kernel/Attic/interp.fs

Diff for /gforth/kernel/Attic/interp.fs between version 1.3 and 1.5

version 1.3, Sun Jul 6 15:56:16 1997 UTC version 1.5, Sun Aug 31 19:32:30 1997 UTC
Line 1 
Line 1 
 \ definitions needed for interpreter / compiler only  \ definitions needed for interpreter / compiler only
   
 doer? :docon [IF]  
 : docon: ( -- addr )    \ gforth  
     \G the code address of a @code{CONSTANT}  
     ['] bl >code-address ;  
 [THEN]  
   
 : docol: ( -- addr )    \ gforth  
     \G the code address of a colon definition  
     ['] docol: >code-address ;  
   
 doer? :dovar [IF]  
 : dovar: ( -- addr )    \ gforth  
     \G the code address of a @code{CREATE}d word  
     \ in rom-applications variable might be implemented with constant  
     \ use really a created word!  
     ['] ??? >code-address ;  
 [THEN]  
   
 doer? :douser [IF]  
 : douser: ( -- addr )   \ gforth  
     \G the code address of a @code{USER} variable  
     ['] sp0 >code-address ;  
 [THEN]  
   
 doer? :dodefer [IF]  
 : dodefer: ( -- addr )  \ gforth  
     \G the code address of a @code{defer}ed word  
     ['] source >code-address ;  
 [THEN]  
   
 doer? :dofield [IF]  
 : dofield: ( -- addr )  \ gforth  
     \G the code address of a @code{field}  
     ['] reveal-method >code-address ;  
 [THEN]  
   
 .( test1 )  
 has-prims 0= [IF]  
 : dodoes: ( -- addr )   \ gforth  
     \G the code address of a @code{field}  
     ['] spaces >code-address ;  
 .( test2 )  
 [THEN]  
   
 \ here allot , c, A,                                   17dec92py  \ here allot , c, A,                                   17dec92py
   
 : allot ( n -- ) \ core  : allot ( n -- ) \ core
Line 161 
Line 117 
 : [char] ( compilation 'char' -- ; run-time -- n )  : [char] ( compilation 'char' -- ; run-time -- n )
     char postpone Literal ; immediate restrict      char postpone Literal ; immediate restrict
   
   \ threading                                   17mar93py
   
   : cfa,     ( code-address -- )  \ gforth        cfa-comma
       here
       dup lastcfa !
       0 A, 0 ,  code-address! ;
   : compile, ( xt -- )    \ core-ext      compile-comma
       A, ;
   : !does    ( addr -- ) \ gforth store-does
       lastxt does-code! ;
   : (does>)  ( R: addr -- )
       r> cfaligned /does-handler + !does ;
   : dodoes,  ( -- )
     cfalign here /does-handler allot does-handler! ;
   
 : (compile) ( -- ) \ gforth  : (compile) ( -- ) \ gforth
     r> dup cell+ >r @ compile, ;      r> dup cell+ >r @ compile, ;
   
Line 448 
Line 419 
   
 : body> 0 >body - ;  : body> 0 >body - ;
   
 \ threading                                   17mar93py  
   
 : cfa,     ( code-address -- )  \ gforth        cfa-comma  
     here  
     dup lastcfa !  
     0 A, 0 ,  code-address! ;  
 : compile, ( xt -- )    \ core-ext      compile-comma  
     A, ;  
 : !does    ( addr -- ) \ gforth store-does  
     lastxt does-code! ;  
 : (does>)  ( R: addr -- )  
     r> cfaligned /does-handler + !does ;  
 : dodoes,  ( -- )  
   cfalign here /does-handler allot does-handler! ;  
   
 doer? :dovar [IF]  doer? :dovar [IF]
 : Create ( "name" -- ) \ core  : Create ( "name" -- ) \ core
     Header reveal dovar: cfa, ;      Header reveal dovar: cfa, ;
Line 562 
Line 518 
 \ word list structure:  \ word list structure:
   
 struct  struct
   1 cells: field find-method   \ xt: ( c_addr u wid -- nt )    cell% field find-method   \ xt: ( c_addr u wid -- nt )
   1 cells: field reveal-method \ xt: ( nt wid -- ) \ used by dofield:, must be field    cell% field reveal-method \ xt: ( nt wid -- ) \ used by dofield:, must be field
   1 cells: field rehash-method \ xt: ( wid -- )    \ re-initializes a "search-data" (hashtables)    cell% field rehash-method \ xt: ( wid -- )       \ re-initializes a "search-data" (hashtables)
   1 cells: field hash-method   \ xt: ( wid -- )    \ initializes ""    cell% field hash-method   \ xt: ( wid -- )    \ initializes ""
 \   \ !! 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    cell% field wordlist-id \ not the same as wid; representation depends on implementation
   1 cells: field wordlist-map \ pointer to a wordlist-map-struct    cell% field wordlist-map \ pointer to a wordlist-map-struct
   1 cells: field wordlist-link \ link field to other wordlists    cell% field wordlist-link \ link field to other wordlists
   1 cells: field wordlist-extend \ points to wordlist extensions (eg hashtables)    cell% field wordlist-extend \ points to wordlist extensions (eg hashtables)
 end-struct wordlist-struct  end-struct wordlist-struct
   
 : f83find      ( addr len wordlist -- nt / false )  : f83find      ( addr len wordlist -- nt / false )
Line 599 
Line 555 
   
 \ higher level parts of find  \ higher level parts of find
   
 ( struct )  struct
 0 >body cell      >body
   1 cells: field interpret/compile-int      cell% field interpret/compile-int
   1 cells: field interpret/compile-comp      cell% field interpret/compile-comp
 end-struct interpret/compile-struct  end-struct interpret/compile-struct
   
 : interpret/compile? ( xt -- flag )  
     >does-code ['] S" >does-code = ;  
   
 : (cfa>int) ( cfa -- xt )  : (cfa>int) ( cfa -- xt )
     dup interpret/compile?      dup interpret/compile?
     if      if
Line 944 
Line 897 
 [ [THEN] ] ;  [ [THEN] ] ;
   
 defer bootmessage  defer bootmessage
   defer process-args
   
 ' (bootmessage) IS bootmessage  ' (bootmessage) IS bootmessage
   

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help