Diff for /gforth/Attic/kernal.fs between versions 1.24 and 1.26

version 1.24, 1994/11/15 15:55:39 version 1.26, 1994/11/17 15:53:14
Line 1385  Variable argc Line 1385  Variable argc
     2drop      2drop
     here r> tuck - 2 cells / ;      here r> tuck - 2 cells / ;
   
 : ">tib  ( addr len -- )  dup #tib ! >in off tib swap move ;  
   
 : do-option ( addr1 len1 addr2 len2 -- n )  2swap  : do-option ( addr1 len1 addr2 len2 -- n )  2swap
   2dup s" -e"        compare  0= >r    2dup s" -e"        compare  0= >r
   2dup s" -evaluate" compare  0= r> or    2dup s" -evaluate" compare  0= r> or
   IF  2drop ">tib interpret  2 EXIT  THEN    IF  2drop dup >r ['] evaluate catch
         ?dup IF  dup >r DoError r> negate (bye)  THEN
         r> >tib +!  2 EXIT  THEN
   ." Unknown option: " type cr 2drop 1 ;    ." Unknown option: " type cr 2drop 1 ;
   
 : process-args ( -- )  : process-args ( -- )  >tib @ >r
     argc @ 1      argc @ 1
     ?DO      ?DO
         I arg over c@ [char] - <>          I arg over c@ [char] - <>
Line 1402  Variable argc Line 1402  Variable argc
         ELSE          ELSE
             I 1+ arg  do-option              I 1+ arg  do-option
         THEN          THEN
     +LOOP ;      +LOOP
       r> >tib ! ;
   
 Defer 'cold ' noop IS 'cold  Defer 'cold ' noop IS 'cold
   
 : cold ( -- )  : cold ( -- )
     'cold  
     pathstring 2@ process-path pathdirs 2!      pathstring 2@ process-path pathdirs 2!
       'cold
     argc @ 1 >      argc @ 1 >
     IF      IF
         ['] process-args catch ?dup          ['] process-args catch ?dup
Line 1420  Defer 'cold ' noop IS 'cold Line 1421  Defer 'cold ' noop IS 'cold
     ." GNU Forth 0.0alpha, Copyright (C) 1994 Free Software Foundation, Inc." cr      ." GNU Forth 0.0alpha, Copyright (C) 1994 Free Software Foundation, Inc." cr
     ." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr      ." GNU Forth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr
     ." Type `bye' to exit"      ." Type `bye' to exit"
     quit ;      loadline off quit ;
   
 : license ( -- ) cr  : license ( -- ) cr
  ." This program is free software; you can redistribute it and/or modify" cr   ." This program is free software; you can redistribute it and/or modify" cr
Line 1439  Defer 'cold ' noop IS 'cold Line 1440  Defer 'cold ' noop IS 'cold
   
 : boot ( path **argv argc -- )  : boot ( path **argv argc -- )
   argc ! argv ! cstring>sstring pathstring 2!  main-task up!    argc ! argv ! cstring>sstring pathstring 2!  main-task up!
   sp@ dup s0 ! $10 + >tib ! rp@ r0 !  fp@ f0 !  cold ;    sp@ dup s0 ! $10 + >tib ! #tib off >in off
     rp@ r0 !  fp@ f0 !  cold ;
   
 : bye  script? 0= IF  cr  THEN  0 (bye) ;  : bye  script? 0= IF  cr  THEN  0 (bye) ;
   

Removed from v.1.24  
changed lines
  Added in v.1.26


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