The bodies of words are now maxaligned

BUGS

@@ -2,7 +2,7 @@ name> does not take the same argument as e.g. .name. Remedy: add cell+
 before name>, but adapt all uses.  anton 23apr94 Solved?
 
 revealing the same name several times (e.g., by using recursive)
-results in redefined messages.  anton 28jul94
+results in "redefined ..." messages.  anton 28jul94
 
 if blocks.fb does not exist, 1 block creates the file, but cannot
 read-file from it. Only if the file-id has been created with
@@ -10,15 +10,6 @@ open-file, not create-file, read-file works. - anton 6aug94
 
 etags.fs crashes one of my applications (gs.fs). anton 12jan95
 
-f. suppresses all digits when it prints 0:
-0e0 f. .  ok
-There's also one other problem with f.:
-1e-20			 f. 0.00000000000000000001000000000000001  ok
--20e0 falog		 f. 0.00000000000000000001000000000000001  ok
-0.00000000000000000001e0 f. 0.00000000000000000001000000000000001  ok
-All this happens under Slackware Linux. On the DecStation I get a
-similar error in the other direction.  anton 17jan95
-
 not all aliases are in the etags file. Bug in etags.fs? anton 24jan95
 
 emacs often finds the wrong tag. anton 24jan95

cross.fs

 \ CROSS.FS     The Cross-Compiler                      06oct92py
-\ $Id: cross.fs,v 1.21 1995-02-02 18:13:02 pazsan Exp $
+\ $Id: cross.fs,v 1.22 1995-02-06 18:14:30 anton Exp $
 \ Idea and implementation: Bernd Paysan (py)
 \ Copyright 1992-94 by the GNU Forth Development Group
 
@@ -39,10 +39,10 @@ decimal
 VARIABLE GhostNames
 0 GhostNames !
 : GhostName ( -- addr )
-        here GhostNames @ , GhostNames ! here 0 ,
-        bl word count
-\        2dup type space
-        dup c, here over chars allot swap move align ;
+    here GhostNames @ , GhostNames ! here 0 ,
+    bl word count
+    \ 2dup type space
+    string, cfalign ;
 
 hex
 
@@ -172,11 +172,18 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c,
 
 : align+  ( taddr -- rest )
     cell tuck 1- and - [ cell 1- ] Literal and ;
+: cfalign+  ( taddr -- rest )
+    \ see kernal.fs:cfaligned
+    float tuck 1- and - [ float 1- ] Literal and ;
 
 >TARGET
 : aligned ( taddr -- ta-addr )  dup align+ + ;
 \ assumes cell alignment granularity (as GNU C)
 
+: cfaligned ( taddr1 -- taddr2 )
+    \ see kernal.fs
+    dup cfalign+ + ;
+
 >CROSS
 : >image ( taddr -- absaddr )  image @ + ;
 >TARGET
@@ -195,6 +202,8 @@ CREATE Bittable 80 c, 40 c, 20 c, 10 c, 8 c, 4 c, 2 c, 1 c,
 : ,     ( w -- )        T here H cell T allot  ! H ;
 : c,    ( char -- )     T here    1 allot c! H ;
 : align ( -- )          T here H align+ 0 ?DO  bl T c, H LOOP ;
+: cfalign ( -- )
+    T here H cfalign+ 0 ?DO  bl T c, H LOOP ;
 
 : A!                    dup relon T ! H ;
 : A,    ( w -- )        T here H relon T , H ;
@@ -344,7 +353,7 @@ VARIABLE ^imm
 
 : string,  ( addr count -- )
   dup T c, H bounds  DO  I c@ T c, H  LOOP ; 
-: name,  ( "name" -- )  bl word count string, T align H ;
+: name,  ( "name" -- )  bl word count string, T cfalign H ;
 : view,   ( -- ) ( dummy ) ;
 
 VARIABLE CreateFlag CreateFlag off

errore.fs

@@ -10,7 +10,7 @@ AVARIABLE ErrLink              \ Linked list entry point
        ErrLink linked
        ,
        [char] " word count
-       dup c, here over chars allot swap move align ;
+       string, align ;
 
 decimal
 

float.fs

@@ -26,20 +26,16 @@
 
 : f, ( f -- )  here 1 floats allot f! ;
 
-\ !! have create produce faligned pfas
 : fconstant  ( r -- )
-  falign here f,  Create A,
-  DOES>  @ f@ ;
-
-: fvariable
-  falign here 0. d>f f, AConstant ;
+    Create f,
+    DOES> f@ ;
 
 : fdepth  ( -- n )  f0 @ fp@ - [ 1 floats ] Literal / ;
 
 : FLit ( -- r )  r> faligned dup f@ float+ >r ;
 : FLiteral ( r -- )  postpone FLit  falign f, ;  immediate
 
-&16 Value precision
+&15 Value precision
 : set-precision  to precision ;
 
 : scratch ( r -- addr len )
@@ -83,6 +79,10 @@
 
 ' sfnumber IS notfound
 
+: fvariable ( -- )
+    Create 0e0 f, ;
+    \ does> ( -- f-addr )
+
 1e0 fasin 2e0 f* fconstant pi
 
 : f2*  2e0 f* ;

kernal.fs

@@ -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
@@ -802,10 +813,14 @@ Avariable leave-sp  leave-stack 3 cells + leave-sp !
 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 +839,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 +851,7 @@ create nextname-buffer 32 chars allot
     ['] nextname-header IS (header) ;
 
 : noname-header ( -- )
-    0 last !
+    0 last ! cfalign
     input-stream ;
 
 : noname ( -- ) \ general
@@ -856,7 +871,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
@@ -992,7 +1007,7 @@ G forth-wordlist current T !
   dup cell+ @ @ 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 !