remove -falign-functions=8 restriction

build.sh

@@ -1,7 +1,7 @@
 rm *.o
 
 export CC=gcc34
-export CFLAGS="-pedantic -Wall -Winline -O4 -Os -march=pentium4 -fomit-frame-pointer -falign-functions=8"
+export CFLAGS="-pedantic -Wall -Winline -O3 -march=pentium4 -fomit-frame-pointer"
 
 $CC $CFLAGS -o f native/*.c
 

library/platform/native/image.factor

@@ -68,7 +68,6 @@ USE: words
 : cons-tag   BIN: 010 ;
 : object-tag BIN: 011 ;
 : header-tag BIN: 100 ;
-: xt-tag     BIN: 101 ;
 
 : immediate ( x tag -- tagged ) swap tag-bits shift< bitor ;
 : >header ( id -- tagged ) header-tag immediate ;
@@ -121,7 +120,8 @@ USE: words
 
 ( Words )
 
-: word, ( -- pointer ) word-tag here-as xt-tag emit ;
+: word, ( -- pointer )
+    word-tag here-as word-tag >header emit 0 emit ;
 
 ! This is to handle mutually recursive words
 ! It is a hack. A recursive word in the cdr of a
@@ -232,7 +232,8 @@ IN: cross-compiler
     r> ( -- plist )
     r> ( primitive -- ) emit
     r> ( parameter -- ) emit
-    ( plist -- ) emit ;
+    ( plist -- ) emit
+    0 emit ( padding ) ;
 
 : primitive, ( word primitive -- ) f (worddef,) ;
 : compound, ( word definition -- ) 1 swap (worddef,) ;

native/gc.c

@@ -69,6 +69,9 @@ void collect_object(void)
 	
 	switch(untag_header(get(scan)))
 	{
+	case WORD_TYPE:
+		collect_word((WORD*)scan);
+		break;
 	case ARRAY_TYPE:
 		collect_array((ARRAY*)scan);
 		break;
@@ -91,10 +94,6 @@ void collect_next(void)
 	gc_debug("collect_next header",get(scan));
 	switch(TAG(get(scan)))
 	{
-	case XT_TYPE:
-		collect_word((WORD*)scan);
-		scan += sizeof(WORD);
-		break;
 	case HEADER_TYPE:
 		collect_object();
 		break;

native/primitives.c

@@ -94,16 +94,10 @@ XT primitives[] = {
 
 CELL primitive_to_xt(CELL primitive)
 {
-	XT xt;
-
 	if(primitive < 0 || primitive >= PRIMITIVE_COUNT)
 		general_error(ERROR_BAD_PRIMITIVE,tag_fixnum(primitive));
 	
-	xt = primitives[primitive];
+	return primitives[primitive];
-	if((CELL)xt % 8 != 0)
-		fatal_error("compile with -falign-functions=8",xt);
-	
-	return RETAG(xt,XT_TYPE);
 }
 
 void primitive_eq(void)

native/relocate.c

@@ -12,6 +12,9 @@ void relocate_object()
 	size = untagged_object_size(relocating);
 	switch(untag_header(get(relocating)))
 	{
+	case WORD_TYPE:
+		fixup_word((WORD*)relocating);
+		break;
 	case ARRAY_TYPE:
 		fixup_array((ARRAY*)relocating);
 		break;
@@ -32,10 +35,6 @@ void relocate_next()
 {
 	switch(TAG(get(relocating)))
 	{
-	case XT_TYPE:
-		fixup_word((WORD*)relocating);
-		relocating += sizeof(WORD);
-		break;
 	case HEADER_TYPE:
 		relocate_object();
 		break;

native/run.c

@@ -9,7 +9,6 @@ void clear_environment(void)
 
 void init_environment(void)
 {
-	/* + CELLS * 2 to skip header and length cell */
 	env.ds_bot = tag_object(array(STACK_SIZE,empty));
 	reset_datastack();
 	env.cs_bot = tag_object(array(STACK_SIZE,empty));
@@ -17,7 +16,7 @@ void init_environment(void)
 	env.cf = env.boot;
 }
 
-#define EXECUTE(w) ((XT)(UNTAG(w->xt)))()
+#define EXECUTE(w) ((XT)(w->xt))()
 
 void run(void)
 {

native/types.c

@@ -80,6 +80,8 @@ CELL untagged_object_size(CELL pointer)
 	
 	switch(untag_header(get(pointer)))
 	{
+	case WORD_TYPE:
+		return align8(sizeof(WORD));
 	case F_TYPE:
 	case T_TYPE:
 	case EMPTY_TYPE:

native/types.h

@@ -10,8 +10,7 @@
 #define CONS_TYPE 2
 #define OBJECT_TYPE 3
 #define HEADER_TYPE 4
-#define XT_TYPE 5
+#define GC_COLLECTED 5 /* See gc.c */
-#define GC_COLLECTED 6 /* See gc.c */
 
 /*** Header types ***/
 

native/word.h

@@ -1,9 +1,11 @@
 typedef void (*XT)(void);
 
 typedef struct {
-	/* TAGGED execution token: jump here to execute word */
+	/* TAGGED header */
+	CELL header;
+	/* untagged execution token: jump here to execute word */
 	CELL xt;
-	/* on-disk primitive number */
+	/* untagged on-disk primitive number */
 	CELL primitive;
 	/* TAGGED parameter to xt; used for colon definitions */
 	CELL parameter;