--- gforth/Attic/kernal.fs	1995/02/23 20:17:20	1.31
+++ gforth/Attic/kernal.fs	1995/04/20 09:42:55	1.35
@@ -153,14 +153,14 @@ Defer source
 \ word parse                                           23feb93py
 
 : parse-word  ( char -- addr len )
-  source 2dup >r >r >in @ /string
+  source 2dup >r >r >in @ over min /string
   rot dup bl = IF  drop (parse-white)  ELSE  (word)  THEN
   2dup + r> - 1+ r> min >in ! ;
 : word   ( char -- addr )
   parse-word here place  bl here count + c!  here ;
 
 : parse    ( char -- addr len )
-  >r  source  >in @ /string  over  swap r>  scan >r
+  >r  source  >in @ over min /string  over  swap r>  scan >r
   over - dup r> IF 1+ THEN  >in +! ;
 
 \ name                                                 13feb93py
@@ -173,6 +173,12 @@ Defer source
     2dup + r> - 1+ r> min >in ! ;
 \    name count ;
 
+: name-too-short? ( c-addr u -- c-addr u )
+    dup 0= -&16 and throw ;
+
+: name-too-long? ( c-addr u -- c-addr u )
+    dup $1F u> -&19 and throw ;
+
 \ Literal                                              17dec92py
 
 : Literal  ( n -- )  state @ IF postpone lit  , THEN ;
@@ -781,13 +787,30 @@ Avariable leave-sp  leave-stack 3 cells
 : (S")     "lit count ;                                restrict
 : SLiteral postpone (S") here over char+ allot  place align ;
                                              immediate restrict
-: S"       [char] " parse  state @ IF  postpone SLiteral  THEN ;
+create s"-buffer /line chars allot
+: S" ( run-time: -- c-addr u )
+    [char] " parse
+    state @
+    IF
+	postpone SLiteral
+    ELSE
+	/line min >r s"-buffer r@ cmove
+	s"-buffer r>
+    THEN ;
                                              immediate
 : ."       state @  IF    postpone (.") ,"  align
                     ELSE  [char] " parse type  THEN  ;  immediate
 : (        [char] ) parse 2drop ;                       immediate
-: \        blk @ IF  >in @ c/l / 1+ c/l * >in !  EXIT  THEN
-           source >in ! drop ;                          immediate
+: \ ( -- ) \ core-ext backslash
+    blk @
+    IF
+	>in @ c/l / 1+ c/l * >in !
+	EXIT
+    THEN
+    source >in ! drop ; immediate
+
+: \G ( -- ) \ new backslash
+    POSTPONE \ ; immediate
 
 \ error handling                                       22feb93py
 \ 'abort thrown out!                                   11may93jaw
@@ -819,8 +842,7 @@ defer header     ' (header) IS header
     dup c, here swap chars dup allot move ;
 
 : name,  ( "name" -- )
-    name
-    dup $1F u> -&19 and throw ( is name too long? )
+    name name-too-short? name-too-long?
     string, cfalign ;
 : input-stream-header ( "name" -- )
     \ !! this is f83-implementation-dependent
@@ -846,7 +868,7 @@ create nextname-buffer 32 chars allot
 
 \ the next name is given in the string
 : nextname ( c-addr u -- ) \ general
-    dup $1F u> -&19 and throw ( is name too long? )
+    name-too-long?
     nextname-buffer c! ( c-addr )
     nextname-buffer count move
     ['] nextname-header IS (header) ;
@@ -1153,7 +1175,7 @@ Defer key
 \ : bin           dup 1 chars - c@
 \                 r/o 4 chars + over - dup >r swap move r> ;
 
-: bin  1+ ;
+: bin  1 or ;
 
 create nl$ 1 c, A c, 0 c, \ gnu includes usually a cr in dos
                            \ or not unix environments if
@@ -1447,24 +1469,28 @@ Variable argc
     2drop
     here r> tuck - 2 cells / ;
 
-: do-option ( addr1 len1 addr2 len2 -- n )  2swap
-  2dup s" -e"        compare  0= >r
-  2dup s" -evaluate" compare  0= r> or
-  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 ;
-
-: process-args ( -- )  >tib @ >r
+: do-option ( addr1 len1 addr2 len2 -- n )
+    2swap
+    2dup s" -e"         compare  0= >r
+    2dup s" --evaluate" compare  0= r> or
+    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 ;
+
+: process-args ( -- )
+    >tib @ >r
+    true to script?
     argc @ 1
     ?DO
 	I arg over c@ [char] - <>
 	IF
-	    true to script? included  false to script? 1
+	    required 1
 	ELSE
 	    I 1+ arg  do-option
 	THEN
     +LOOP
+    false to script?
     r> >tib ! ;
 
 Defer 'cold ' noop IS 'cold