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

gforth: gforth/kernel/Attic/interp.fs

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

version 1.5, Sun Aug 31 19:32:30 1997 UTC version 1.6, Sat Sep 13 12:05:52 1997 UTC
Line 3 
Line 3 
 \ here allot , c, A,                                   17dec92py  \ here allot , c, A,                                   17dec92py
   
 : allot ( n -- ) \ core  : allot ( n -- ) \ core
     dup unused > -8 and throw      dup unused u> -8 and throw
     dp +! ;      dp +! ;
 : c,    ( c -- ) \ core  : c,    ( c -- ) \ core
     here 1 chars allot c! ;      here 1 chars allot c! ;
Line 702 
Line 702 
   
 \ Query                                                07apr93py  \ Query                                                07apr93py
   
 has-files 0= [IF]  has? file 0= [IF]
 : sourceline# ( -- n )  loadline @ ;  : sourceline# ( -- n )  loadline @ ;
 [THEN]  [THEN]
   
 : refill ( -- flag ) \ core-ext,block-ext,file-ext  : refill ( -- flag ) \ core-ext,block-ext,file-ext
   blk @  IF  1 blk +!  true  0 >in !  EXIT  THEN    blk @  IF  1 blk +!  true  0 >in !  EXIT  THEN
   tib /line    tib /line
 [ has-files [IF] ]  [ has? file [IF] ]
   loadfile @ ?dup    loadfile @ ?dup
   IF    read-line throw    IF    read-line throw
   ELSE    ELSE
 [ [THEN] ]  [ [THEN] ]
       sourceline# 0< IF 2drop false EXIT THEN        sourceline# 0< IF 2drop false EXIT THEN
       accept true        accept true
 [ has-files [IF] ]  [ has? file [IF] ]
   THEN    THEN
 [ [THEN] ]  [ [THEN] ]
   1 loadline +!    1 loadline +!
Line 729 
Line 729 
   
 \ save-mem extend-mem  \ save-mem extend-mem
   
 has-os [IF]  has? os [IF]
 : save-mem      ( addr1 u -- addr2 u ) \ gforth  : save-mem      ( addr1 u -- addr2 u ) \ gforth
     \g copy a memory block into a newly allocated region in the heap      \g copy a memory block into a newly allocated region in the heap
     swap >r      swap >r
Line 755 
Line 755 
   
 \ EVALUATE                                              17may93jaw  \ EVALUATE                                              17may93jaw
   
 has-files 0= [IF]  has? file 0= [IF]
 : push-file  ( -- )  r>  : push-file  ( -- )  r>
   sourceline# >r  tibstack @ >r  >tib @ >r  #tib @ >r    sourceline# >r  tibstack @ >r  >tib @ >r  #tib @ >r
   >tib @ tibstack @ = IF  r@ tibstack +!  THEN    >tib @ tibstack @ = IF  r@ tibstack +!  THEN
Line 841 
Line 841 
 ;  ;
   
 : (DoError) ( throw-code -- )  : (DoError) ( throw-code -- )
   [ has-os [IF] ]    [ has? os [IF] ]
       outfile-id dup flush-file drop >r        outfile-id dup flush-file drop >r
       stderr to outfile-id        stderr to outfile-id
   [ [THEN] ]    [ [THEN] ]
Line 867 
Line 867 
      .error       .error
   THEN    THEN
   normal-dp dpp !    normal-dp dpp !
   [ has-os [IF] ] r> to outfile-id [ [THEN] ]    [ has? os [IF] ] r> to outfile-id [ [THEN] ]
   ;    ;
   
 ' (DoError) IS DoError  ' (DoError) IS DoError
Line 892 
Line 892 
     ." GForth " version-string type      ." GForth " version-string type
     ." , Copyright (C) 1994-1997 Free Software Foundation, Inc." cr      ." , Copyright (C) 1994-1997 Free Software Foundation, Inc." cr
     ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'"      ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'"
 [ has-os [IF] ]  [ has? os [IF] ]
      cr ." Type `bye' to exit"       cr ." Type `bye' to exit"
 [ [THEN] ] ;  [ [THEN] ] ;
   
Line 911 
Line 911 
 Variable init8  Variable init8
   
 : cold ( -- ) \ gforth  : cold ( -- ) \ gforth
 [ has-files [IF] ]  [ has? file [IF] ]
     pathstring 2@ fpath only-path      pathstring 2@ fpath only-path
     init-included-files      init-included-files
 [ [THEN] ]  [ [THEN] ]
     'cold      'cold
     init8 chainperform      init8 chainperform
 [ has-files [IF] ]  [ has? file [IF] ]
     ['] process-args catch ?dup      ['] process-args catch ?dup
     IF      IF
       dup >r DoError cr r> negate (bye)        dup >r DoError cr r> negate (bye)
Line 932 
Line 932 
   
 : boot ( path **argv argc -- )  : boot ( path **argv argc -- )
     main-task up!      main-task up!
 [ has-os [IF] ]  [ has? os [IF] ]
     stdout TO outfile-id      stdout TO outfile-id
 [ [THEN] ]  [ [THEN] ]
 [ has-files [IF] ]  [ has? file [IF] ]
     argc ! argv ! pathstring 2!      argc ! argv ! pathstring 2!
 [ [THEN] ]  [ [THEN] ]
     sp@ sp0 !      sp@ sp0 !
 [ has-locals [IF] ]  [ has? glocals [IF] ]
     lp@ forthstart 7 cells + @ -      lp@ forthstart 7 cells + @ -
 [ [ELSE] ]  [ [ELSE] ]
     [ has-os [IF] ]      [ has? os [IF] ]
     sp@ $1040 +      sp@ $1040 +
     [ [ELSE] ]      [ [ELSE] ]
     sp@ $40 +      sp@ $40 +
Line 950 
Line 950 
 [ [THEN] ]  [ [THEN] ]
     dup >tib ! tibstack ! #tib off >in off      dup >tib ! tibstack ! #tib off >in off
     rp@ rp0 !      rp@ rp0 !
 [ has-floats [IF] ]  [ has? floating [IF] ]
     fp@ fp0 !      fp@ fp0 !
 [ [THEN] ]  [ [THEN] ]
     ['] cold catch DoError      ['] cold catch DoError
 [ has-os [IF] ]  [ has? os [IF] ]
     bye      bye
 [ [THEN] ]  [ [THEN] ]
 ;  ;
   
 has-os [IF]  has? os [IF]
 : bye ( -- ) \ tools-ext  : bye ( -- ) \ tools-ext
 [ has-files [IF] ]  [ has? file [IF] ]
     script? 0= IF  cr  THEN      script? 0= IF  cr  THEN
 [ [ELSE] ]  [ [ELSE] ]
     cr      cr

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

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help