--- gforth/Attic/kernal.fs	1995/01/30 18:47:52	1.27
+++ gforth/Attic/kernal.fs	1995/02/23 20:17:20	1.31
@@ -66,6 +66,15 @@ DOES> ( n -- )  + c@ ;
       bl c,
   LOOP ;
 
+\ !! this is machine-dependent, but works on all but the strangest machines
+' faligned Alias maxaligned
+' falign Alias maxalign
+
+\ the code field is aligned if its body is maxaligned
+\ !! machine-dependent and won't work if "0 >body" <> "0 >body maxaligned"
+' maxaligned Alias cfaligned
+' maxalign Alias cfalign
+
 : chars ; immediate
 
 : A!    ( addr1 addr2 -- )  dup relon ! ;
@@ -78,9 +87,11 @@ DOES> ( n -- )  + c@ ;
 
 \ name> found                                          17dec92py
 
-: (name>)  ( nfa -- cfa )    count  $1F and  +  aligned ;
-: name>    ( nfa -- cfa )    cell+
-  dup  (name>) swap  c@ $80 and 0= IF  @ THEN ;
+: (name>)  ( nfa -- cfa )
+    count  $1F and  +  cfaligned ;
+: name>    ( nfa -- cfa )
+    cell+
+    dup  (name>) swap  c@ $80 and 0= IF  @ THEN ;
 
 : found ( nfa -- cfa n )  cell+
   dup c@ >r  (name>) r@ $80 and  0= IF  @       THEN
@@ -358,7 +369,7 @@ Defer notfound ( c-addr count -- )
     IF
 	1 and
 	IF \ not restricted to compile state?
-	    nip nip execute  EXIT
+	    nip nip execute EXIT
 	THEN
 	-&14 throw
     THEN
@@ -693,8 +704,9 @@ Avariable leave-sp  leave-stack 3 cells
     cell - dup @ swap
     leave-sp ! ;
 
-: DONE ( orig -- )  drop >r drop
+: DONE ( orig -- )
     \ !! the original done had ( addr -- )
+    drop >r drop
     begin
 	leave>
 	over r@ u>=
@@ -802,10 +814,14 @@ Avariable leave-sp  leave-stack 3 cells
 defer (header)
 defer header     ' (header) IS header
 
+: string, ( c-addr u -- )
+    \ puts down string as cstring
+    dup c, here swap chars dup allot move ;
+
 : name,  ( "name" -- )
     name
     dup $1F u> -&19 and throw ( is name too long? )
-    dup c,  here swap chars  dup allot  move  align ;
+    string, cfalign ;
 : input-stream-header ( "name" -- )
     \ !! this is f83-implementation-dependent
     align here last !  -1 A,
@@ -824,7 +840,7 @@ create nextname-buffer 32 chars allot
     \ !! f83-implementation-dependent
     nextname-buffer count
     align here last ! -1 A,
-    dup c,  here swap chars  dup allot  move  align
+    string, cfalign
     $80 flag!
     input-stream ;
 
@@ -836,7 +852,7 @@ create nextname-buffer 32 chars allot
     ['] nextname-header IS (header) ;
 
 : noname-header ( -- )
-    0 last !
+    0 last ! cfalign
     input-stream ;
 
 : noname ( -- ) \ general
@@ -856,7 +872,7 @@ create nextname-buffer 32 chars allot
 Create ???  0 , 3 c, char ? c, char ? c, char ? c,
 : >name ( cfa -- nfa )
  $21 cell do
-   dup i - count $9F and + aligned over $80 + = if
+   dup i - count $9F and + cfaligned over $80 + = if
      i - cell - unloop exit
    then
  cell +loop
@@ -902,10 +918,10 @@ Create ???  0 , 3 c, char ? c, char ? c,
 : Constant  (Constant) , ;
 : AConstant (Constant) A, ;
 
-: 2CONSTANT
-    create ( w1 w2 "name" -- )
+: 2Constant
+    Create ( w1 w2 "name" -- )
         2,
-    does> ( -- w1 w2 )
+    DOES> ( -- w1 w2 )
         2@ ;
     
 \ IS Defer What's Defers TO                            24feb93py
@@ -965,19 +981,20 @@ AVariable current
 \ object oriented search list                          17mar93py
 
 \ word list structure:
-\ struct
-\   1 cells: field find-method   \ xt: ( c_addr u wid -- name-id )
-\   1 cells: field reveal-method \ xt: ( -- )
-\   1 cells: field rehash-method \ xt: ( wid -- )
+
+struct
+  1 cells: field find-method   \ xt: ( c_addr u wid -- name-id )
+  1 cells: field reveal-method \ xt: ( -- )
+  1 cells: field rehash-method \ xt: ( wid -- )
 \   \ !! what else
-\ end-struct wordlist-map-struct
+end-struct wordlist-map-struct
 
-\ struct
-\   1 cells: field wordlist-id \ not the same as wid; representation depends on implementation
-\   1 cells: field wordlist-map \ pointer to a wordlist-map-struct
-\   1 cells: field wordlist-link \ link field to other wordlists
-\   1 cells: field wordlist-extend \ points to wordlist extensions (eg hash)
-\ end-struct wordlist-struct
+struct
+  1 cells: field wordlist-id \ not the same as wid; representation depends on implementation
+  1 cells: field wordlist-map \ pointer to a wordlist-map-struct
+  1 cells: field wordlist-link \ link field to other wordlists
+  1 cells: field wordlist-extend \ points to wordlist extensions (eg hash)
+end-struct wordlist-struct
 
 : f83find      ( addr len wordlist -- nfa / false )  @ (f83find) ;
 
@@ -989,10 +1006,10 @@ AVariable lookup       G forth-wordlist
 G forth-wordlist current T !
 
 : (search-wordlist)  ( addr count wid -- nfa / false )
-  dup cell+ @ @ execute ;
+  dup wordlist-map @ find-method @ execute ;
 
 : search-wordlist  ( addr count wid -- 0 / xt +-1 )
-  (search-wordlist) dup  IF  found  THEN ;
+    (search-wordlist) dup  IF  found  THEN ;
 
 Variable warnings  G -1 warnings T !
 
@@ -1023,9 +1040,9 @@ Variable warnings  G -1 warnings T !
  last? if
    name>string current @ check-shadow
  then
- current @ cell+ @ cell+ @ execute ;
+ current @ wordlist-map @ reveal-method @ execute ;
 
-: rehash  ( wid -- )  dup cell+ @ cell+ cell+ @ execute ;
+: rehash  ( wid -- )  dup wordlist-map @ rehash-method @ execute ;
 
 : '    ( "name" -- addr )  name sfind 0= if -&13 bounce then ;
 : [']  ( "name" -- addr )  ' postpone ALiteral ; immediate
@@ -1454,6 +1471,7 @@ Defer 'cold ' noop IS 'cold
 
 : cold ( -- )
     pathstring 2@ process-path pathdirs 2!
+    0 0 included-files 2!
     'cold
     argc @ 1 >
     IF