[BACK]Return to int.fs CVS log [TXT] [DIR] Up to [gforth] / gforth / kernel

Diff for /gforth/kernel/int.fs between versions 1.189 and 1.195

version 1.189, 2012/05/26 10:20:01 version 1.195, 2012/12/31 15:25:19
Line 1 Line 1
 \ definitions needed for interpreter only  \ definitions needed for interpreter only
   
 \ Copyright (C) 1995-2000,2004,2005,2007,2009,2010 Free Software Foundation, Inc.  \ Copyright (C) 1995-2000,2004,2005,2007,2009,2010,2012 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 650  Defer parser1 ( c-addr u -- ... xt) Line 650  Defer parser1 ( c-addr u -- ... xt)
 : parser ( c-addr u -- ... )  : parser ( c-addr u -- ... )
 \ text-interpret the word/number c-addr u, possibly producing a number  \ text-interpret the word/number c-addr u, possibly producing a number
     parser1 execute ;      parser1 execute ;
   
 has? ec [IF]  has? ec [IF]
     ' (name) Alias parse-name      ' (name) Alias parse-name
     : no.extensions  2drop -&13 throw ;      : no.extensions  2drop -&13 throw ;
Line 681  Defer interpreter-notfound1 ( c-addr cou Line 680  Defer interpreter-notfound1 ( c-addr cou
 Defer before-word ( -- ) \ gforth  Defer before-word ( -- ) \ gforth
 \ called before the text interpreter parses the next word  \ called before the text interpreter parses the next word
 ' noop IS before-word  ' noop IS before-word
   
   Defer before-line ( -- ) \ gforth
   \ called before the text interpreter parses the next line
   ' noop IS before-line
   
 [THEN]  [THEN]
   
 has? backtrace [IF]  has? backtrace [IF]
 : interpret1 ( ... -- ... )  : interpret1 ( ... -- ... )
     rp@ backtrace-rp0 !      rp@ backtrace-rp0 !
       [ has? EC 0= [IF] ] before-line [ [THEN] ]
     BEGIN      BEGIN
         ?stack [ has? EC 0= [IF] ] before-word [ [THEN] ] parse-name dup          ?stack [ has? EC 0= [IF] ] before-word [ [THEN] ] parse-name dup
     WHILE      WHILE
Line 882  has? os [IF] Line 887  has? os [IF]
             [ has? OS [IF] ] >stderr [ [THEN] ]              [ has? OS [IF] ] >stderr [ [THEN] ]
             cr ." Can't print to stdout, leaving" cr              cr ." Can't print to stdout, leaving" cr
             \ if stderr does not work either, already DoError causes a hang              \ if stderr does not work either, already DoError causes a hang
             2 (bye)              -2 (bye)
         endif [ [THEN] ]          endif [ [THEN] ]
         refill  WHILE          refill  WHILE
             interpret prompt              interpret prompt
Line 1068  Defer mark-end Line 1073  Defer mark-end
     [ [ELSE] ] r> >tib !      [ [ELSE] ] r> >tib !
     [ [THEN] ] ;      [ [THEN] ] ;
   
   : do-execute ( xt -- ) \ Gforth
       \G C calling us
       catch dup IF  DoError cr  THEN  (bye) ;
   
   : do-find ( addr u -- )
       find-name dup IF  name>int  THEN  (bye) ;
   
 \ \ Cold Boot                                           13feb93py  \ \ Cold Boot                                           13feb93py
   
 : gforth ( -- )  : gforth ( -- )
     ." Gforth " version-string type       ." Gforth " version-string type 
     ." , Copyright (C) 1995-2011 Free Software Foundation, Inc." cr      ." , Copyright (C) 1995-2012 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"
Line 1112  Defer 'cold ( -- ) \ gforth  tick-cold Line 1124  Defer 'cold ( -- ) \ gforth  tick-cold
     process-args      process-args
     loadline off      loadline off
 [ [THEN] ]  [ [THEN] ]
     bootmessage      1 (bye) ;
     quit ;  
   
 has? new-input 0= [IF]  has? new-input 0= [IF]
 : clear-tibstack ( -- )  : clear-tibstack ( -- )
Line 1132  has? new-input 0= [IF] Line 1143  has? new-input 0= [IF]
   
 : boot ( path n **argv argc -- )  : boot ( path n **argv argc -- )
 [ has? no-userspace 0= [IF] ]  [ has? no-userspace 0= [IF] ]
     main-task up!      next-task 0= IF  main-task up!
       ELSE
           next-task @ 0= IF
               throw-entry main-task udp @ throw-entry next-task -
               /string >r swap r> move
               next-task dup next-task 2!  normal-dp dpp !
           THEN
       THEN
 [ [THEN] ]  [ [THEN] ]
 [ has? os [IF] ]  [ has? os [IF] ]
     os-boot      os-boot
Line 1165  has? new-input 0= [IF] Line 1183  has? new-input 0= [IF]
     cold      cold
 [ [THEN] ]  [ [THEN] ]
 [ has? os [IF] ]  [ has? os [IF] ]
     1 (bye) \ !! determin exit code from throw code?      -1 (bye) \ !! determin exit code from throw code?
 [ [THEN] ]  [ [THEN] ]
 ;  ;
   
Removed from v.1.189  
changed lines
  Added in v.1.195

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