--- gforth/Attic/kernal.fs	1996/01/25 16:45:53	1.51
+++ gforth/Attic/kernal.fs	1996/05/07 16:15:22	1.57
@@ -453,7 +453,7 @@ hex
 
 : throw ( y1 .. ym error/0 -- y1 .. ym / z1 .. zn error ) \ exception
     ?DUP IF
-	[ here 4 cells ! ]
+	[ here 9 cells ! ]
 	handler @ rp!
 	r> handler !
 	r> lp!
@@ -492,6 +492,11 @@ Defer notfound ( c-addr count -- )
     2drop -&13 bounce ;
 ' no.extensions IS notfound
 
+: compile-only ( ... -- )
+    -&14 throw ;
+Defer interpret-special ( c-addr u xt -- ) \ !! use nfa instead of xt?
+' compile-only IS interpret-special
+
 : interpret ( ?? -- ?? ) \ gforth
     \ interpret/compile the (rest of the) input buffer
     BEGIN
@@ -511,7 +516,7 @@ Defer notfound ( c-addr count -- )
 	IF \ not restricted to compile state?
 	    nip nip execute EXIT
 	THEN
-	-&14 throw
+	interpret-special exit
     THEN
     drop
     2dup 2>r snumber?
@@ -723,10 +728,11 @@ variable backedge-locals
 
 : ?DUP-IF ( compilation -- orig ; run-time n -- n| ) \ gforth	question-dupe-if
 \ This is the preferred alternative to the idiom "?DUP IF", since it can be
-\ better handled by tools like stack checkers
-    POSTPONE ?dup POSTPONE if ;       immediate restrict
+\ better handled by tools like stack checkers. Besides, it's faster.
+    POSTPONE ?dup-?branch >mark ;       immediate restrict
+
 : ?DUP-0=-IF ( compilation -- orig ; run-time n -- n| ) \ gforth	question-dupe-zero-equals-if
-    POSTPONE ?dup POSTPONE 0= POSTPONE if ; immediate restrict
+    POSTPONE ?dup-0=-?branch >mark ;       immediate restrict
 
 : THEN ( compilation orig -- ; run-time -- ) \ core
     dup orig?
@@ -960,7 +966,13 @@ create s"-buffer /line chars allot
     state @  IF    postpone (.") ,"  align
                     ELSE  [char] " parse type  THEN  ;  immediate
 : ( ( compilation 'ccc<close-paren>' -- ; run-time -- ) \ core,file	paren
-    [char] ) parse 2drop ;                       immediate
+    BEGIN
+	>in @ [char] ) parse nip >in @ rot - =
+    WHILE
+	loadfile @ IF
+	    refill 0= abort" missing ')' in paren comment"
+	THEN
+    REPEAT ;                       immediate
 : \ ( -- ) \ core-ext backslash
     blk @
     IF
@@ -1130,7 +1142,7 @@ Create ???  0 , 3 c, char ? c, char ? c,
 \     Create ( -- ) 
 \ 	['] noop A,
 \     DOES> ( ??? )
-\ 	@ execute ;
+\ 	perform ;
 
 : IS ( addr "name" -- ) \ gforth
     ' >body
@@ -1211,7 +1223,7 @@ AVariable lookup       G forth-wordlist
 G forth-wordlist current T !
 
 : (search-wordlist)  ( addr count wid -- nfa / false )
-  dup wordlist-map @ find-method @ execute ;
+  dup wordlist-map @ find-method perform ;
 
 : search-wordlist  ( addr count wid -- 0 / xt +-1 ) \ search
     (search-wordlist) dup  IF  found  THEN ;
@@ -1246,10 +1258,10 @@ G -1 warnings T !
  last? if
    name>string current @ check-shadow
  then
- current @ wordlist-map @ reveal-method @ execute ;
+ current @ wordlist-map @ reveal-method perform ;
 
 : rehash  ( wid -- )
-    dup wordlist-map @ rehash-method @ execute ;
+    dup wordlist-map @ rehash-method perform ;
 
 : '    ( "name" -- addr ) \ core	tick
     name sfind 0= if -&13 bounce then ;
@@ -1272,6 +1284,9 @@ G -1 warnings T !
     #lf ( sic! ) emit ;
 
 \ : backspaces  0 ?DO  #bs emit  LOOP ;
+
+Variable ^d-mode  -1 ^d-mode ! \ ^d is "EOF" if at beginning of the line
+
 : >string  ( span addr pos1 -- span addr pos1 addr2 len )
   over 3 pick 2 pick chars /string ;
 : type-rest ( span addr pos1 -- span addr pos1 back )
@@ -1287,7 +1302,11 @@ G -1 warnings T !
 : (ret)  type-rest drop true space ;
 : back  dup  IF  1- #bs emit  ELSE  #bell emit  THEN 0 ;
 : forw 2 pick over <> IF  2dup + c@ emit 1+  ELSE  #bell emit  THEN 0 ;
-: eof  2 pick 0=  IF  bye  ELSE  (ret)  THEN ;
+: eof  ^d-mode @  IF
+        bye
+    ELSE  2 pick over <>
+	IF  forw drop (del)  ELSE  #bell emit  THEN  0
+    THEN ;
 
 Create ctrlkeys
   ] false false back  false  eof   false forw  false
@@ -1301,31 +1320,33 @@ defer everychar
 : decode ( max span addr pos1 key -- max span addr pos2 flag )
   everychar
   dup #del = IF  drop #bs  THEN  \ del is rubout
-  dup bl <   IF  cells ctrlkeys + @ execute  EXIT  THEN
+  dup bl <   IF  cells ctrlkeys + perform  EXIT  THEN
   >r 2over = IF  rdrop bell 0 EXIT  THEN
   r> (ins) 0 ;
 
-\ decode should better use a table for control key actions
-\ to define keyboard bindings later
-
 : accept   ( addr len -- len ) \ core
   dup 0< IF    abs over dup 1 chars - c@ tuck type 
 \ this allows to edit given strings
          ELSE  0  THEN rot over
-  BEGIN  key decode  UNTIL
+  BEGIN  key decode dup ^d-mode !  UNTIL
   2drop nip ;
 
 \ Output                                               13feb93py
 
+: (type) ( c-addr u -- ) \ gforth
+    outfile-id write-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ?
+;
+
 Defer type ( c-addr u -- ) \ core
 \ defer type for a output buffer or fast
 \ screen write
 
-\ : (type) ( addr len -- )
-\   bounds ?DO  I c@ emit  LOOP ;
-
 ' (type) IS Type
 
+: (emit) ( c -- ) \ gforth
+    outfile-id emit-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ?
+;
+
 Defer emit ( c -- ) \ core
 ' (Emit) IS Emit
 
@@ -1749,6 +1770,7 @@ Variable argc
 Defer 'cold ' noop IS 'cold
 
 : cold ( -- ) \ gforth
+    stdout TO outfile-id
     pathstring 2@ process-path pathdirs 2!
     init-included-files
     'cold