Fix bug to make arch/8086 work.

arch/8086/mach.fs

@@ -29,6 +29,8 @@ false SetValue new-input     \ disables object oriented input
 false SetValue peephole
 true  SetValue f83headerstring
 true  SetValue abranch       \ enables absolute branches
+true  SetValue no-userspace
+true  SetValue OS
 \ true Constant has-rom
 
 cell 2 = [IF] 32 [ELSE] 256 [THEN] KB Constant kernel-size

arch/8086/prim.fs

@@ -80,14 +80,14 @@ end-macros
   Code: :docol
      ': dout,                    \ only for debugging
      frp dec,   frp dec,   fip frp ) mov,        \ save ip
-     4 w d) fip lea,                             \ calc pfa
+     2 w d) fip lea,                             \ calc pfa
      next,
    End-Code
 
   Code: :dovar
     '2 dout,                    \ only for debugging
     tos push,
-    4 w d) tos lea,
+    2 w d) tos lea,
     next,
   End-Code
 
@@ -244,14 +244,14 @@ end-macros
   Code: :docon
     '1 dout,                    \ only for debugging
     tos push,
-    4 w d) tos lea,
+    2 w d) tos lea,
     tos ) tos mov,
     next,
   End-Code
 
   Code: :dodefer
     '4 dout,                    \ only for debugging
-    4 w d) w mov,
+    2 w d) w mov,
     w ) jmp,
   End-Code
 
@@ -440,3 +440,9 @@ end-macros
 
 Code: :doesjump
 end-code
+
+Code save-mem \ TBD
+    next,
+end-code
+
+$0080 constant tib0

cross.fs

@@ -2184,6 +2184,13 @@ variable ResolveFlag
 
 X has? f83headerstring bigendian or [IF] 0 [ELSE] tcell 1- [THEN]
 Constant flag+
+
+X has? f83headerstring [IF]
+: t>f+c    tcell + ;
+: t>flag   t>f+c flag+ + ; \ points to the flag byte
+: t>link   ;
+: cfa,     ( cfa -- ) T A, H ;
+[ELSE]
 X has? new-cfa [IF]
 : t>f+c    tcell 4 * - ;
 : t>flag   t>f+c flag+ + ; \ points to the flag byte
@@ -2196,6 +2203,7 @@ X has? new-cfa [IF]
 : t>link   tcell 2* - ;
 : cfa,     ( cfa -- ) T A, H ;
 [THEN]
+[THEN]
 : t>namehm tcell - ;
 
 Struct
@@ -2444,8 +2452,9 @@ Defer hm-noname
 	hm-noname
     ELSE
 	[ X has? f83headerstring ] [IF]
-	    T align H tlast @ T A, H
+	    T align H tlast @ there >r T A, H
 	    >in @ parse-name T name, H >in !
+        r> tlast !
 	[ELSE]
 	    >in @ parse-name dup T aligned cfalign# name, H >in !
 	    tlast @ T A, H
@@ -2457,8 +2466,8 @@ Defer hm-noname
 	    ELSE
 		0 T , H
 	    THEN
+        there tlast !
 	[THEN]
-	there tlast !
 	1 headers-named +!	\ Statistic
 	hm-named
     THEN
@@ -2678,7 +2687,9 @@ Defer (end-code)
   defempty?
   (THeader ( ghost )
   ['] prim-resolved over >comp !
+  dup >exec2 there swap !
   there resolve-noforwards
+
 
   [ T e? prims H 0= [IF] T e? ITC H [ELSE] true [THEN] ] [IF]
   doprim, 
@@ -2834,8 +2845,7 @@ ghost :noname drop
 : :noname ( -- xt colon-sys )
     switchrom hm, [g'] :noname gwhere,
     [ X has? f83headerstring 0= ] [IF]
-	[ X has? new-cfa ] [IF] T cfalign 0 A, H
-	[ELSE] T 0 cell+ cfalign# H [THEN]
+	[ X has? new-cfa ] [IF] T cfalign 0 A, H [ELSE] T 0 cell+ cfalign# H [THEN]
 	:-ghost >do:ghost @ >exec2 @ execute
     [ELSE]
 	X cfalign
@@ -3230,6 +3240,7 @@ ghost imm>comp
     [G'] imm>comp gset->comp
     ^imm @ @ dup <imm> = IF  drop  EXIT  THEN
     <res> <> ABORT" CROSS: Cannot immediate a unresolved word"
+    immediate-mask flag!
     <imm> ^imm @ ! ;
 
 ghost a>int drop
@@ -3251,7 +3262,7 @@ ghost ?fold-to drop
 : interpret/compile: ( xt1 xt2 "name" -- )
     (THeader <res> over >magic !  there swap >link !
     [G'] :dodefer (doer,)
-    swap T A, A, H [ T has? ec H ] [IF] alias-mask flag! [THEN]
+    swap T A, A, H 
     hm-populate
     [G'] no-to   gset-to
     [G'] no-defer@ gset-defer@

kernel-ec/comp.fs

@@ -173,7 +173,11 @@ Defer char@ ( addr u -- char addr' u' )
 : cfa,     ( code-address -- )  \ gforth	cfa-comma
     here
     dup lastcfa !
-    [ has? rom [IF] ] 2 cells allot [ [ELSE] ] 0 A, 0 , [ [THEN] ]
+    [ has? new-cfa [IF] ]
+        [ has? rom [IF] ] 2 cells allot [ [ELSE] ] 0 A, 0 , [ [THEN] ]
+    [ [ELSE] ]
+        [ has? rom [IF] ] 1 cells allot [ [ELSE] ] 0 A, [ [THEN] ]
+    [ [THEN] ]
     code-address! ;
 
 [IFUNDEF] compile,

kernel-ec/int.fs

@@ -464,16 +464,15 @@ Defer parser1 ( c-addr u -- ... xt)
     \G the input source is the user input device, attempt to receive
     \G input into the terminal input device. If successful, make the
     \G result the input buffer, set @code{>IN} to 0 and return true;
-    \G otherwise return false. When the input source is a block, add 1
-    \G to the value of @code{BLK} to make the next block the input
-    \G source and current input buffer, and set @code{>IN} to 0;
-    \G return true if the new value of @code{BLK} is a valid block
-    \G number, false otherwise. When the input source is a text file,
-    \G attempt to read the next line from the file. If successful,
-    \G make the result the current input buffer, set @code{>IN} to 0
-    \G and return true; otherwise, return false.  A successful result
+    \G otherwise return false. 
     \G includes receipt of a line containing 0 characters.
-    tib /line swap #tib !
+
+    tib /line
+
+	sourceline# 0< IF 2drop false EXIT THEN
+	accept eof @ 0=
+
+    swap #tib !
     input-start-line ;
 
 : query   ( -- ) \ core-ext
@@ -520,15 +519,15 @@ Defer 'quit
 
 : (quit) ( -- )
     \ exits only through THROW etc.
-    BEGIN  cr refill  WHILE  interpret prompt
+    BEGIN cr refill WHILE interpret prompt
     REPEAT  bye ;
 
 ' (quit) IS 'quit
 
 : dec.  base @ >r decimal . r> base ! ;
 : DoError ( throw-code -- )
     cr source drop >in @ type ." <<< "
-    dup -2 =  IF  "error @ type  drop  EXIT  THEN
+    dup -2 =  IF  "error @ count type  drop  EXIT  THEN
     .error ;
 
 : quit ( ?? -- ?? ) \ core
@@ -558,7 +557,7 @@ Defer 'quit
 
 : do-execute ( xt -- ) \ Gforth
     \G C calling us
-    catch dup IF  DoError cr  THEN  (bye) ;
+    catch dup IF DoError cr  THEN  (bye) ;
 
 : do-find ( addr u -- )
     find-name dup IF  name>int  THEN  (bye) ;
@@ -567,7 +566,7 @@ Defer 'quit
 
 : gforth ( -- )
     ." Gforth " version-string type 
-    ." , Authors: Anton Ertl, Bernd Paysan
+    ." , Authors: Anton Ertl, Bernd Paysan"
     ." , Copyright (C) 1995-2012,2013,2014,2015,2019 Free Software Foundation, Inc." cr
     ." Gforth comes with ABSOLUTELY NO WARRANTY; for details type `license'"
 [ has? os [IF] ]
@@ -598,7 +597,11 @@ Defer 'cold ( -- ) \ gforth  tick-cold
 
 has? new-input 0= [IF]
 : clear-tibstack ( -- )
-    sp@ cell+
+    [ has? tib0 [IF] ]
+        tib0
+    [ [ELSE] ]
+        sp@ cell+
+    [ [THEN] ]
     dup >tib ! tibstack ! #tib off
     input-start-line ;
 [THEN]

kernel-ec/io.fs

@@ -47,6 +47,9 @@ require ../compat/strcomp.fs
     \G that due to the way the Forth command line interpreter inserts
     \G newlines, the preferred way to use @code{cr} is at the start
     \G of a piece of text; e.g., @code{cr ." hello, world"}.
+[ has? crlf [IF] ]
+    #cr emit
+[ [THEN] ]
     #lf emit ;
 : bell #bell emit ;
 

kernel-ec/pass.fs

@@ -30,4 +30,4 @@ UNLOCK user-region extent nip LOCK udp !
 \ Set up last and forth-wordlist with the address of the last word's
 \ link field
 UNLOCK tlast @ LOCK
-1 cells - dup forth-wordlist has? ec 0= [IF] wordlist-id [THEN] ! Last !
+has? f83headerstring 0= [IF] 1 cells - [THEN] dup forth-wordlist has? ec 0= [IF] wordlist-id [THEN] ! Last !