Diff for /gforth/Attic/kernal.fs between versions 1.49 and 1.50

version 1.49, 1995/11/30 18:01:48 version 1.50, 1996/01/07 17:22:12
Line 142  DOES> ( n -- )  + c@ ; Line 142  DOES> ( n -- )  + c@ ;
   
 \ name> found                                          17dec92py  \ name> found                                          17dec92py
   
 : (name>)  ( nfa -- cfa )  : (name>)  ( nfa+cell -- cfa )
     count  $1F and  +  cfaligned ;      1 cells - name>string +  cfaligned ;
 : name>    ( nfa -- cfa ) \ gforth  : name>    ( nfa -- cfa ) \ gforth
     cell+      cell+
     dup  (name>) swap  c@ $80 and 0= IF  @ THEN ;      dup  (name>) swap  c@ $80 and 0= IF  @ THEN ;
Line 158  DOES> ( n -- )  + c@ ; Line 158  DOES> ( n -- )  + c@ ;
   
 \ : (find) ( addr count nfa1 -- nfa2 / false )  \ : (find) ( addr count nfa1 -- nfa2 / false )
 \   BEGIN  dup  WHILE  dup >r  \   BEGIN  dup  WHILE  dup >r
 \          cell+ count $1F and dup >r 2over r> =  \          name>string dup >r 2over r> =
 \          IF  -text  0= IF  2drop r> EXIT  THEN  \          IF  -text  0= IF  2drop r> EXIT  THEN
 \          ELSE  2drop drop  THEN  r> @  \          ELSE  2drop drop  THEN  r> @
 \   REPEAT nip nip ;  \   REPEAT nip nip ;
Line 1264  G -1 warnings T ! Line 1264  G -1 warnings T !
 0A constant #lf ( -- c ) \ gforth  0A constant #lf ( -- c ) \ gforth
   
 : bell  #bell emit ;  : bell  #bell emit ;
   : cr ( -- ) \ core
       \ emit a newline
       #lf ( sic! ) emit ;
   
 \ : backspaces  0 ?DO  #bs emit  LOOP ;  \ : backspaces  0 ?DO  #bs emit  LOOP ;
 : >string  ( span addr pos1 -- span addr pos1 addr2 len )  : >string  ( span addr pos1 -- span addr pos1 addr2 len )
Line 1326  Defer emit ( c -- ) \ core Line 1329  Defer emit ( c -- ) \ core
 Defer key ( -- c ) \ core  Defer key ( -- c ) \ core
 ' (key) IS key  ' (key) IS key
   
 \ : form  ( -- rows cols )  &24 &80 ;  
 \ form should be implemented using TERMCAPS or CURSES  
 \ : rows  form drop ;  
 \ : cols  form nip  ;  
   
 \ Query                                                07apr93py  \ Query                                                07apr93py
   
 : refill ( -- flag ) \ core-ext,block-ext,file-ext  : refill ( -- flag ) \ core-ext,block-ext,file-ext
Line 1681  DEFER DOERROR Line 1679  DEFER DOERROR
   
 \ Cold                                                 13feb93py  \ Cold                                                 13feb93py
   
 \ : .name ( name -- ) cell+ count $1F and type space ;  \ : .name ( name -- ) name>string type space ;
 \ : words  listwords @  \ : words  listwords @
 \          BEGIN  @ dup  WHILE  dup .name  REPEAT drop ;  \          BEGIN  @ dup  WHILE  dup .name  REPEAT drop ;
   
Line 1761  Defer 'cold ' noop IS 'cold Line 1759  Defer 'cold ' noop IS 'cold
         cr          cr
     THEN      THEN
     false to script?      false to script?
     ." GForth " version-string type ." , Copyright (C) 1994 Free Software Foundation, Inc." cr      ." GForth " version-string type ." , Copyright (C) 1994-1996 Free Software Foundation, Inc." cr
     ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr      ." GForth comes with ABSOLUTELY NO WARRANTY; for details type `license'" cr
     ." Type `bye' to exit"      ." Type `bye' to exit"
     loadline off quit ;      loadline off quit ;

Removed from v.1.49  
changed lines
  Added in v.1.50


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