Diff for /gforth/Attic/kernal.fs between versions 1.31 and 1.33

version 1.31, 1995/02/23 20:17:20 version 1.33, 1995/03/14 19:01:43
Line 786  Avariable leave-sp  leave-stack 3 cells Line 786  Avariable leave-sp  leave-stack 3 cells
 : ."       state @  IF    postpone (.") ,"  align  : ."       state @  IF    postpone (.") ,"  align
                     ELSE  [char] " parse type  THEN  ;  immediate                      ELSE  [char] " parse type  THEN  ;  immediate
 : (        [char] ) parse 2drop ;                       immediate  : (        [char] ) parse 2drop ;                       immediate
 : \        blk @ IF  >in @ c/l / 1+ c/l * >in !  EXIT  THEN  : \ ( -- ) \ core-ext backslash
            source >in ! drop ;                          immediate      blk @
       IF
           >in @ c/l / 1+ c/l * >in !
           EXIT
       THEN
       source >in ! drop ; immediate
   
   : \G ( -- ) \ new backslash
       POSTPONE \ ; immediate
   
 \ error handling                                       22feb93py  \ error handling                                       22feb93py
 \ 'abort thrown out!                                   11may93jaw  \ 'abort thrown out!                                   11may93jaw
Line 1447  Variable argc Line 1455  Variable argc
     2drop      2drop
     here r> tuck - 2 cells / ;      here r> tuck - 2 cells / ;
   
 : do-option ( addr1 len1 addr2 len2 -- n )  2swap  : do-option ( addr1 len1 addr2 len2 -- n )
   2dup s" -e"        compare  0= >r      2swap
   2dup s" -evaluate" compare  0= r> or      2dup s" -e"         compare  0= >r
   IF  2drop dup >r ['] evaluate catch      2dup s" --evaluate" compare  0= r> or
       ?dup IF  dup >r DoError r> negate (bye)  THEN      IF  2drop dup >r ['] evaluate catch
       r> >tib +!  2 EXIT  THEN          ?dup IF  dup >r DoError r> negate (bye)  THEN
   ." Unknown option: " type cr 2drop 1 ;          r> >tib +!  2 EXIT  THEN
       ." Unknown option: " type cr 2drop 1 ;
   
 : process-args ( -- )  >tib @ >r  : process-args ( -- )  >tib @ >r
     argc @ 1      argc @ 1

Removed from v.1.31  
changed lines
  Added in v.1.33


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