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

gforth: gforth/kernel/Attic/interp.fs

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

version 1.4, Thu Jul 31 16:17:27 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 605 
Line 561 
     cell% 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.4  
changed lines
  Added in v.1.5

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help