[gforth] / gforth / kernel / int.fs  

gforth: gforth/kernel/int.fs

Diff for /gforth/kernel/int.fs between version 1.11 and 1.12

version 1.11, Tue Dec 8 22:03:10 1998 UTC version 1.12, Fri Dec 11 22:54:31 1998 UTC
Line 145 
Line 145 
     [char] ) parse 2drop ; immediate      [char] ) parse 2drop ; immediate
   
 : \ ( -- ) \ core-ext backslash  : \ ( -- ) \ core-ext backslash
       [ has? file [IF] ]
     blk @      blk @
     IF      IF
         >in @ c/l / 1+ c/l * >in !          >in @ c/l / 1+ c/l * >in !
         EXIT          EXIT
     THEN      THEN
       [ [THEN] ]
     source >in ! drop ; immediate      source >in ! drop ; immediate
   
 : \G ( -- ) \ gforth backslash  : \G ( -- ) \ gforth backslash
Line 360 
Line 362 
 \ interpreter                                   30apr92py  \ interpreter                                   30apr92py
   
 \ not the most efficient implementations of interpreter and compiler  \ not the most efficient implementations of interpreter and compiler
 : interpreter ( c-addr u -- )  | : interpreter ( c-addr u -- )
     2dup find-name dup      2dup find-name dup
     if      if
         nip nip name>int execute          nip nip name>int execute
Line 379 
Line 381 
 \ \ Query Evaluate                                      07apr93py  \ \ Query Evaluate                                      07apr93py
   
 has? file 0= [IF]  has? file 0= [IF]
 : sourceline# ( -- n )  loadline @ ;  : sourceline# ( -- n )  1 ;
 [THEN]  [THEN]
   
 : refill ( -- flag ) \ core-ext,block-ext,file-ext  : refill ( -- flag ) \ core-ext,block-ext,file-ext
       [ has? file [IF] ]
   blk @  IF  1 blk +!  true  0 >in !  EXIT  THEN    blk @  IF  1 blk +!  true  0 >in !  EXIT  THEN
           [ [THEN] ]
   tib /line    tib /line
 [ has? file [IF] ]  [ has? file [IF] ]
   loadfile @ ?dup    loadfile @ ?dup
Line 394 
Line 398 
       accept true        accept true
 [ has? file [IF] ]  [ has? file [IF] ]
   THEN    THEN
 [ [THEN] ]  
   1 loadline +!    1 loadline +!
           [ [THEN] ]
   swap #tib ! 0 >in ! ;    swap #tib ! 0 >in ! ;
   
 : query   ( -- ) \ core-ext  : query   ( -- ) \ core-ext
     \G obsolescent      \G obsolescent
       [ has? file [IF] ]
     blk off loadfile off      blk off loadfile off
           [ [THEN] ]
     tib /line accept #tib ! 0 >in ! ;      tib /line accept #tib ! 0 >in ! ;
   
 \ save-mem extend-mem  \ save-mem extend-mem
Line 423 
Line 429 
   
 has? file 0= [IF]  has? file 0= [IF]
 : push-file  ( -- )  r>  : push-file  ( -- )  r>
   sourceline# >r  tibstack @ >r  >tib @ >r  #tib @ >r    tibstack @ >r  >tib @ >r  #tib @ >r
   >tib @ tibstack @ = IF  r@ tibstack +!  THEN    >tib @ tibstack @ = IF  r@ tibstack +!  THEN
   tibstack @ >tib ! >in @ >r  >r ;    tibstack @ >tib ! >in @ >r  >r ;
   
 : pop-file   ( throw-code -- throw-code )  : pop-file   ( throw-code -- throw-code )
   r>    r>
   r> >in !  r> #tib !  r> >tib !  r> tibstack !  r> loadline !  >r ;    r> >in !  r> #tib !  r> >tib !  r> tibstack !  >r ;
 [THEN]  [THEN]
   
 : evaluate ( c-addr len -- ) \ core,block  : evaluate ( c-addr len -- ) \ core,block
   push-file  #tib ! >tib !    push-file  #tib ! >tib !
   >in off blk off loadfile off -1 loadline !    >in off
     [ has? file [IF] ]
         blk off loadfile off -1 loadline !
         [ [THEN] ]
   ['] interpret catch    ['] interpret catch
   pop-file throw ;    pop-file throw ;
   
Line 447 
Line 456 
 : prompt        state @ IF ."  compiled" EXIT THEN ."  ok" ;  : prompt        state @ IF ."  compiled" EXIT THEN ."  ok" ;
   
 : (Query)  ( -- )  : (Query)  ( -- )
     loadfile off  blk off loadline off refill drop ;      [ has? file [IF] ]
           loadfile off  blk off loadline off
           [ [THEN] ]
       refill drop ;
   
 : (quit)  BEGIN  .status cr (query) interpret prompt  AGAIN ;  : (quit)  BEGIN  .status cr (query) interpret prompt  AGAIN ;
   
Line 579 
Line 591 
     init8 chainperform      init8 chainperform
 [ has? file [IF] ]  [ has? file [IF] ]
     process-args      process-args
       loadline off
 [ [THEN] ]  [ [THEN] ]
     bootmessage      bootmessage
     loadline off quit ;      quit ;
   
 : clear-tibstack ( -- )  : clear-tibstack ( -- )
 [ has? glocals [IF] ]  [ has? glocals [IF] ]

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help