Diff for /gforth/Attic/kernel.fs between versions 1.15 and 1.19

version 1.15, 1997/02/09 21:51:39 version 1.19, 1997/03/20 14:39:51
Line 68  NIL AConstant NIL \ gforth Line 68  NIL AConstant NIL \ gforth
   
 \ Aliases  \ Aliases
   
 ' i Alias r@  ' i Alias r@ ( -- w ; R: w -- w ) \ core r-fetch
   \ copy w from the return stack to the data stack
   
 \ Bit string manipulation                              06oct92py  \ Bit string manipulation                              06oct92py
   
Line 264  Defer source ( -- addr count ) \ core Line 265  Defer source ( -- addr count ) \ core
 : (compile) ( -- ) \ gforth  : (compile) ( -- ) \ gforth
     r> dup cell+ >r @ compile, ;      r> dup cell+ >r @ compile, ;
   
 : postpone, ( w xt -- )  : postpone, ( w xt -- ) \ gforth postpone-comma
     \g Compiles the compilation semantics represented by @var{w xt}.      \g Compiles the compilation semantics represented by @var{w xt}.
     dup ['] execute =      dup ['] execute =
     if      if
Line 489  Defer 'throw Line 490  Defer 'throw
   
 : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception  : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
     ?DUP IF      ?DUP IF
         [ here 9 cells ! ] \ entry point for signal handler          [ has-header [IF] here 9 cells ! [THEN] ] \ entry point for signal handler
         handler @ dup 0= IF          handler @ dup 0= IF
 [ has-os [IF] ]  [ has-os [IF] ]
             2 (bye)              2 (bye)
Line 747  Create ???  0 , 3 c, char ? c, char ? c, Line 748  Create ???  0 , 3 c, char ? c, char ? c,
 : !does    ( addr -- ) \ gforth store-does  : !does    ( addr -- ) \ gforth store-does
     lastxt does-code! ;      lastxt does-code! ;
 : (does>)  ( R: addr -- )  : (does>)  ( R: addr -- )
     r> /does-handler + !does ;      r> cfaligned /does-handler + !does ;
 : dodoes,  ( -- )  : dodoes,  ( -- )
   here /does-handler allot does-handler! ;    cfalign here /does-handler allot does-handler! ;
   
 doer? :dovar [IF]  doer? :dovar [IF]
 : Create ( "name" -- ) \ core  : Create ( "name" -- ) \ core
Line 961  end-struct interpret/compile-struct Line 962  end-struct interpret/compile-struct
         then          then
     then ;      then ;
   
 : find ( c-addr -- xt +-1 / c-addr 0 ) \ core  : find ( c-addr -- xt +-1 / c-addr 0 ) \ core,search
     dup count sfind dup      dup count sfind dup
     if      if
         rot drop          rot drop
Line 1037  G -1 warnings T ! Line 1038  G -1 warnings T !
 0C constant #ff ( -- c ) \ gforth  0C constant #ff ( -- c ) \ gforth
 0A constant #lf ( -- c ) \ gforth  0A constant #lf ( -- c ) \ gforth
   
 : bell  #bell emit ;  : bell ( -- ) \ gforth
       \g makes a beep and flushes the output buffer
       #bell emit
       outfile-id flush-file drop ;
 : cr ( -- ) \ core  : cr ( -- ) \ core
     \ emit a newline      \ emit a newline
     #lf ( sic! ) emit ;      #lf ( sic! ) emit ;
Line 1301  DEFER DOERROR Line 1305  DEFER DOERROR
 \ : .name ( name -- ) name>string 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 ;
 Defer 'cold ' noop IS 'cold  Defer 'cold ( -- ) \ gforth tick-cold
   \ hook (deferred word) for things to do right before interpreting the
   \ command-line arguments
   ' noop IS 'cold
   
 : cold ( -- ) \ gforth  : cold ( -- ) \ gforth
 [ has-files [IF] ]  [ has-files [IF] ]

Removed from v.1.15  
changed lines
  Added in v.1.19


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