new assembler; wrote a new asm primitives

TODO.FACTOR.txt

@@ -1,8 +1,9 @@
 + compiler:
 
+- type inference fails with some assembler words
 - optimize away dispatch
 - getenv/setenv: if literal arg, compile as a load/store
-- assembler opcodes dispatch on operand types
+- update compiler for new assembler
 
 + oop:
 
@@ -33,6 +34,7 @@
 
 + kernel:
 
+- ppc register decls
 - do partial objects cause problems?
 - better i/o scheduler
 - remove sbufs

factor/DefaultVocabularyLookup.java

@@ -91,7 +91,7 @@ public class DefaultVocabularyLookup implements VocabularyLookup
 		FactorWord ine = define("syntax",";");
 		ine.parsing = new Ine(def,ine);
 		FactorWord symbol = define("syntax","SYMBOL:");
-		symbol.parsing = new Symbol(symbol);
+		symbol.parsing = new Definer(symbol);
 
 		/* reading numbers with another base */
 		FactorWord bin = define("syntax","BIN:");
@@ -105,7 +105,7 @@ public class DefaultVocabularyLookup implements VocabularyLookup
 		FactorWord noParsing = define("syntax","POSTPONE:");
 		noParsing.parsing = new NoParsing(noParsing);
 		FactorWord defer = define("syntax","DEFER:");
-		defer.parsing = new Defer(defer);
+		defer.parsing = new Definer(defer);
 		FactorWord in = define("syntax","IN:");
 		in.parsing = new In(in);
 		FactorWord use = define("syntax","USE:");
@@ -116,9 +116,9 @@ public class DefaultVocabularyLookup implements VocabularyLookup
 
 		/* OOP */
 		FactorWord generic = define("generic","GENERIC:");
-		generic.parsing = new Generic(generic);
+		generic.parsing = new Definer(generic);
 		FactorWord traits = define("generic","TRAITS:");
-		traits.parsing = new Traits(traits);
+		traits.parsing = new Definer(traits);
 		FactorWord beginMethod = define("generic","M:");
 		beginMethod.parsing = new BeginMethod(beginMethod,def);
 		FactorWord beginConstructor = define("generic","C:");

factor/ExternalFactor.java

@@ -123,6 +123,9 @@ public class ExternalFactor extends DefaultVocabularyLookup
 	 */
 	public synchronized String eval(String cmd) throws IOException
 	{
+		if(isClosed)
+			throw new IOException("ExternalFactor stream closed");
+
 		try
 		{
 			waitForAck();

factor/FactorMethodDefinition.java

@@ -32,15 +32,16 @@ package factor;
 /**
  * M: type generic ... ;M
  */
-public class FactorMethodDefinition extends FactorWordDefinition
+public class FactorMethodDefinition
 {
 	private FactorWord type;
+	private FactorWord generic;
 	private Cons def;
 
 	public FactorMethodDefinition(FactorWord type,
 		FactorWord generic, Cons def)
 	{
-		super(generic);
+		this.generic = generic;
 		this.type = type;
 		this.def = def;
 	}

factor/FactorTraitsDefinition.java

@@ -1,41 +0,0 @@
-/* :folding=explicit:collapseFolds=1: */
-
-/*
-* $Id$
-*
-* Copyright (C) 2004 Slava Pestov.
-*
-* Redistribution and use in source and binary forms, with or without
-* modification, are permitted provided that the following conditions are met:
-*
-* 1. Redistributions of source code must retain the above copyright notice,
-*    this list of conditions and the following disclaimer.
-*
-* 2. Redistributions in binary form must reproduce the above copyright notice,
-*    this list of conditions and the following disclaimer in the documentation
-*    and/or other materials provided with the distribution.
-*
-* THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-* INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-* FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-* DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-*/
-
-package factor;
-
-/**
- * TRAITS: type
- */
-public class FactorTraitsDefinition extends FactorSymbolDefinition
-{
-	public FactorTraitsDefinition(FactorWord word)
-	{
-		super(word,word);
-	}
-}

factor/FactorWord.java

@@ -42,9 +42,9 @@ public class FactorWord implements FactorExternalizable
 	public FactorParsingDefinition parsing;
 
 	/**
-	 * Stub for interpreter definition.
+	 * For browsing, the parsing word that was used to define this word.
 	 */
-	public FactorWordDefinition def;
+	private FactorWord definer;
 
 	/**
 	 * Should the parser keep doc comments?
@@ -70,4 +70,19 @@ public class FactorWord implements FactorExternalizable
 	{
 		return name == null ? "#<unnamed>" : name;
 	} //}}}
+	
+	//{{{ getDefiner() method
+	public FactorWord getDefiner()
+	{
+		if(definer == null)
+			return new FactorWord(null,"DEFER:");
+		else
+			return definer;
+	} //}}}
+
+	//{{{ setDefiner() method
+	public void setDefiner(FactorWord definer)
+	{
+		this.definer = definer;
+	} //}}}
 }

factor/FactorWordDefinition.java

@@ -1,62 +0,0 @@
-/* :folding=explicit:collapseFolds=1: */
-
-/*
- * $Id$
- *
- * Copyright (C) 2003, 2004 Slava Pestov.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- *    this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- *    this list of conditions and the following disclaimer in the documentation
- *    and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-package factor;
-
-import java.io.*;
-import java.util.*;
-
-/**
- * A word definition.
- */
-public abstract class FactorWordDefinition
-{
-	public FactorWord word;
-
-	//{{{ FactorWordDefinition constructor
-	/**
-	 * A new definition.
-	 */
-	public FactorWordDefinition(FactorWord word)
-	{
-		this.word = word;
-	} //}}}
-
-	//{{{ toList() method
-	public Cons toList()
-	{
-		return null;
-	} //}}}
-
-	//{{{ toString() method
-	public String toString()
-	{
-		return getClass().getName() + ": " + word;
-	} //}}}
-}

factor/jedit/FactorAsset.java

@@ -30,7 +30,6 @@
 package factor.jedit;
 
 import factor.FactorWord;
-import factor.FactorWordDefinition;
 import javax.swing.Icon;
 import javax.swing.text.Position;
 import org.gjt.sp.jedit.Buffer;

factor/jedit/FactorPlugin.props

@@ -48,10 +48,7 @@ sidekick.parser.factor.label=Factor
 mode.factor.sidekick.parser=factor
 
 factor.completion.in=<font color="#a0a0a0">IN: {0}</font>\ 
-factor.completion.colon=: <b>{0}</b>
+factor.completion.def={0} <b>{1}</b>
-factor.completion.defer=DEFER: <b>{0}</b>
-factor.completion.parsing=PARSING: <b>{0}</b>
-factor.completion.symbol=SYMBOL: <b>{0}</b>
 factor.completion.stack={0} ( {1})
 
 # Dialog boxes

factor/jedit/FactorSideKickParser.java

@@ -130,12 +130,12 @@ public class FactorSideKickParser extends SideKickParser
 				errorSource);
 			r = new FactorReader(scanner,false,FactorPlugin.getExternalInstance());
 
-			Cons parsed = r.parse();
+			r.parse();
 
 			d.in = r.getIn();
 			d.use = r.getUse();
 
-			addWordDefNodes(d,parsed,buffer);
+			addWordDefNodes(d,r.getDefinedWords(),buffer);
 		}
 		catch(FactorParseException pe)
 		{
@@ -172,19 +172,13 @@ public class FactorSideKickParser extends SideKickParser
 	} //}}}
 
 	//{{{ addWordDefNodes() method
-	private void addWordDefNodes(FactorParsedData d, Cons parsed, Buffer buffer)
+	private void addWordDefNodes(FactorParsedData d, Cons words, Buffer buffer)
 	{
 		FactorAsset last = null;
 
-		while(parsed != null)
+		while(words != null)
 		{
-			if(parsed.car instanceof FactorWordDefinition)
+			FactorWord word = (FactorWord)words.car;
-			{
-				FactorWordDefinition def
-					= (FactorWordDefinition)
-					parsed.car;
-
-				FactorWord word = def.word;
 
 			/* word lines are indexed from 1 */
 			int startLine = Math.max(0,Math.min(
@@ -201,9 +195,8 @@ public class FactorSideKickParser extends SideKickParser
 
 			last = new FactorAsset(word,buffer.createPosition(start));
 			d.root.add(new DefaultMutableTreeNode(last));
-			}
 
-			parsed = parsed.next();
+			words = words.next();
 		}
 
 		if(last != null)

factor/jedit/FactorWordRenderer.java

@@ -39,19 +39,12 @@ public class FactorWordRenderer extends DefaultListCellRenderer
 	//{{{ getWordHTMLString() method
 	public static String getWordHTMLString(FactorWord word, boolean showIn)
 	{
-		String prop = "factor.completion.colon";
+		String defStr = jEdit.getProperty(
-
+			"factor.completion.def",
-		/* if(def == null)
+			new String[] {
-		{
+				MiscUtilities.charsToEntities(word.getDefiner().name),
-			if(word.parsing != null)
+				MiscUtilities.charsToEntities(word.name)
-				prop = "factor.completion.parsing";
+			});
-			else
-				prop = "factor.completion.defer";
-		}
-		else if(def instanceof FactorSymbolDefinition)
-		{
-			prop = "factor.completion.symbol";
-		} */
 
 		String in;
 		if(showIn)
@@ -64,8 +57,8 @@ public class FactorWordRenderer extends DefaultListCellRenderer
 		else
 			in = "";
 
-		String html = "<html>" + in + jEdit.getProperty(prop,
+		String html = "<html>" + in + defStr;
-			new Object[] { MiscUtilities.charsToEntities(word.name) });
+
 		if(word.stackEffect != null)
 		{
 			html = jEdit.getProperty("factor.completion.stack",

factor/parser/Defer.java

@@ -1,50 +0,0 @@
-/* :folding=explicit:collapseFolds=1: */
-
-/*
- * $Id$
- *
- * Copyright (C) 2004 Slava Pestov.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- *    this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- *    this list of conditions and the following disclaimer in the documentation
- *    and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-package factor.parser;
-
-import factor.*;
-
-public class Defer extends FactorParsingDefinition
-{
-	//{{{ Defer constructor
-	/**
-	 * A new definition.
-	 */
-	public Defer(FactorWord word)
-	{
-		super(word);
-	} //}}}
-
-	public void eval(FactorReader reader)
-		throws Exception
-	{
-		reader.nextWord(true);
-	}
-}

factor/parser/Definer.java

@@ -31,9 +31,13 @@ package factor.parser;
 
 import factor.*;
 
-public class Symbol extends FactorParsingDefinition
+/**
+ * A definer where the word name to be defined follows the parsing word.
+ * Eg, DEFER: SYMBOL: GENERIC: etc.
+ */
+public class Definer extends FactorParsingDefinition
 {
-	public Symbol(FactorWord word)
+	public Definer(FactorWord word)
 	{
 		super(word);
 	}
@@ -42,7 +46,9 @@ public class Symbol extends FactorParsingDefinition
 		throws Exception
 	{
 		FactorWord w = reader.nextWord(true);
-		w.def = new FactorSymbolDefinition(w,w);
+		/* Only ever null with restartable scanner;
-		reader.append(w.def);
+		error already logged, so give up */
+		if(w != null)
+			w.setDefiner(word);
 	}
 }

factor/parser/Generic.java

@@ -1,48 +0,0 @@
-/* :folding=explicit:collapseFolds=1: */
-
-/*
- * $Id$
- *
- * Copyright (C) 2004 Slava Pestov.
- *
- * Redistribution and use in source and binary forms, with or without
- * modification, are permitted provided that the following conditions are met:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- *    this list of conditions and the following disclaimer.
- *
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- *    this list of conditions and the following disclaimer in the documentation
- *    and/or other materials provided with the distribution.
- *
- * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
- * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
- * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
- * DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- */
-
-package factor.parser;
-
-import factor.*;
-
-public class Generic extends FactorParsingDefinition
-{
-	public Generic(FactorWord word)
-	{
-		super(word);
-	}
-
-	public void eval(FactorReader reader)
-		throws Exception
-	{
-		FactorWord w = reader.nextWord(true);
-		w.def = new FactorGenericDefinition(w);
-		reader.append(w.def);
-	}
-}

factor/parser/Ine.java

@@ -48,10 +48,7 @@ public class Ine extends FactorParsingDefinition
 		FactorWord w = state.defining;
 		/* Only ever null with restartable scanner;
 		error already logged, so give up */
-		if(w == null)
+		if(w != null)
-			return;
+			w.setDefiner(start);
-
-		w.def = new FactorCompoundDefinition(w,state.first);
-		reader.append(w.def);
 	}
 }

library/bootstrap/boot-stage2.factor

@@ -181,8 +181,9 @@ os "win32" = [
 
 cpu "x86" = [
     [
-         "/library/compiler/assembly-x86.factor"
+         "/library/compiler/x86/assembler.factor"
-         "/library/compiler/generator-x86.factor"
+         "/library/compiler/x86/generator.factor"
+         "/library/compiler/x86/fixnum.factor"
     ] [
         dup print
         run-resource

library/compiler/assembly-x86.factor

@@ -1,229 +0,0 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-IN: compiler
-USE: kernel
-USE: compiler
-USE: math
-
-: EAX 0 ;
-: ECX 1 ;
-: EDX 2 ;
-: EBX 3 ;
-: ESP 4 ;
-: EBP 5 ;
-: ESI 6 ;
-: EDI 7 ;
-
-: byte? -128 127 between? ;
-
-: eax/other ( reg quot quot -- )
-    #! Execute first quotation if reg is EAX, second quotation
-    #! otherwise, leaving reg on the stack.
-    pick EAX = [ drop nip call ] [ nip call ] ifte ; inline
-
-: byte/eax/cell ( imm reg byte eax cell -- )
-    #! Assemble an instruction with 3 forms; byte operand, any
-    #! register; eax register, cell operand; other register,
-    #! cell operand.
-    >r >r >r >r dup byte? [
-        r> r> call r> drop r> drop compile-byte
-    ] [
-        r> dup EAX = [
-            drop r> drop r> call r> drop compile-cell
-        ] [
-            r> drop r> drop r> call compile-cell
-        ] ifte
-    ] ifte ; inline
-
-: MOD-R/M ( r/m reg/opcode mod -- )
-    #! MOD-R/M is MOD REG/OPCODE R/M
-    6 shift swap 3 shift bitor bitor compile-byte ;
-
-: PUSH-R ( reg -- )
-    HEX: 50 + compile-byte ;
-
-: PUSH-[R] ( reg -- )
-    HEX: ff compile-byte BIN: 110 0 MOD-R/M ;
-
-: PUSH-I ( imm -- )
-    HEX: 68 compile-byte compile-cell ;
-
-: PUSH-I/PARTIAL ( -- fixup )
-    #! This is potentially bad. In the compilation of
-    #! #return-to, we need to push something which is
-    #! only known later.
-    #!
-    #! Returns address of 32-bit immediate.
-    HEX: 68 compile-byte  compiled-offset  0 compile-cell ;
-
-: POP-R ( reg -- )
-    HEX: 58 + compile-byte ;
-
-: LEAVE ( -- )
-    HEX: c9 compile-byte ;
-
-: I>R ( imm reg -- )
-    #! MOV <imm> TO <reg>
-    HEX: b8 + compile-byte  compile-cell ;
-
-: [I]>R ( imm reg -- )
-    #! MOV INDIRECT <imm> TO <reg>
-    [
-        HEX: a1 compile-byte
-    ] [
-        HEX: 8b compile-byte
-        BIN: 101 swap 0 MOD-R/M
-    ] eax/other compile-cell ;
-
-: I>[R] ( imm reg -- )
-    #! MOV <imm> TO INDIRECT <reg>
-    HEX: c7 compile-byte  compile-byte  compile-cell ;
-
-: R>[I] ( reg imm -- )
-    #! MOV <reg> TO INDIRECT <imm>.
-    swap [
-        HEX: a3 compile-byte
-    ] [
-        HEX: 89 compile-byte
-        BIN: 101 swap 0 MOD-R/M
-    ] eax/other compile-cell ;
-
-: R>R ( reg reg -- )
-    #! MOV <reg> TO <reg>.
-    HEX: 89 compile-byte  swap BIN: 11 MOD-R/M ;
-
-: [R]>R ( reg reg -- )
-    #! MOV INDIRECT <reg> TO <reg>.
-    HEX: 8b compile-byte  0 MOD-R/M ;
-
-: D[R]>R ( disp reg reg -- )
-    #! MOV INDIRECT DISPLACED <reg> TO <reg>.
-    HEX: 8b compile-byte  1 MOD-R/M  compile-byte ;
-
-: R>[R] ( reg reg -- )
-    #! MOV <reg> TO INDIRECT <reg>.
-    HEX: 89 compile-byte  swap 0 MOD-R/M ;
-
-: I+[I] ( imm addr -- )
-    #! ADD <imm> TO ADDRESS <addr>
-    HEX: 81 compile-byte
-    BIN: 101 0 0 MOD-R/M
-    compile-cell
-    compile-cell ;
-
-: EAX+/PARTIAL ( -- fixup )
-    #! This is potentially bad. In the compilation of
-    #! generic and 2generic, we need to add something which is
-    #! only known later.
-    #!
-    #! Returns address of 32-bit immediate.
-    HEX: 05 compile-byte  compiled-offset  0 compile-cell ;
-
-: R+I ( imm reg -- )
-    #! ADD <imm> TO <reg>, STORE RESULT IN <reg>
-    [
-        HEX: 83 compile-byte
-        0 BIN: 11 MOD-R/M
-    ] [
-        HEX: 05 compile-byte
-    ] [
-        HEX: 81 compile-byte
-        0 BIN: 11 MOD-R/M
-    ] byte/eax/cell ;
-
-: R-I ( imm reg -- )
-    #! SUBTRACT <imm> FROM <reg>, STORE RESULT IN <reg>
-    [
-        HEX: 83 compile-byte
-        BIN: 101 BIN: 11 MOD-R/M
-    ] [
-        HEX: 2d compile-byte
-    ] [
-        HEX: 81 compile-byte
-        BIN: 101 BIN: 11 MOD-R/M
-    ] byte/eax/cell ;
-
-: R<<I ( imm reg -- )
-    #! SHIFT <reg> BY <imm>, STORE RESULT IN <reg>
-    HEX: c1 compile-byte
-    BIN: 100 BIN: 11 MOD-R/M
-    compile-byte ;
-
-: R>>I ( imm reg -- )
-    #! SHIFT <reg> BY <imm>, STORE RESULT IN <reg>
-    HEX: c1 compile-byte
-    BIN: 111 BIN: 11 MOD-R/M
-    compile-byte ;
-
-: CMP-I-R ( imm reg -- )
-    #! There are three forms of CMP we assemble
-    #! 83 f8 03                cmpl   $0x3,%eax
-    #! 81 fa 33 33 33 00       cmpl   $0x333333,%edx
-    #! 3d 33 33 33 00          cmpl   $0x333333,%eax
-    [
-        HEX: 83 compile-byte
-        BIN: 111 BIN: 11 MOD-R/M
-    ] [
-        HEX: 3d compile-byte
-    ] [
-        HEX: 81 compile-byte
-        BIN: 111 BIN: 11 MOD-R/M
-    ] byte/eax/cell ;
-
-: JUMP-FIXUP ( addr where -- )
-    #! Encode a relative offset to addr from where at where.
-    #! Add 4 because addr is relative to *after* insn.
-    dup >r 4 + - r> set-compiled-cell ;
-
-: (JUMP) ( xt -- fixup )
-    #! addr is relative to *after* insn
-    compiled-offset  0 compile-cell ;
-
-: JUMP ( -- fixup )
-    #! Push address of branch for fixup
-    HEX: e9 compile-byte  (JUMP) ;
-
-: JUMP-[R] ( reg -- )
-    #! JUMP TO INDIRECT <reg>.
-    HEX: ff compile-byte  BIN: 100 0 MOD-R/M ;
-
-: CALL ( -- fixup )
-    HEX: e8 compile-byte  (JUMP) ;
-
-: CALL-[R] ( reg -- )
-    #! CALL INDIRECT <reg>.
-    HEX: ff compile-byte  BIN: 10 0 MOD-R/M ;
-
-: JE ( -- fixup )
-    HEX: 0f compile-byte HEX: 84 compile-byte  (JUMP) ;
-
-: JNE ( -- fixup )
-    HEX: 0f compile-byte HEX: 85 compile-byte  (JUMP) ;
-
-: RET ( -- )
-    HEX: c3 compile-byte ;

library/compiler/compiler.factor

@@ -102,3 +102,9 @@ M: compound (compile) ( word -- )
     ] [
         "Unsupported CPU" print
     ] ifte ;
+
+: decompile ( word -- )
+    [ word-primitive ] keep set-word-primitive ;
+
+: recompile ( word -- )
+    dup decompile compile ;

library/compiler/generator-x86.factor

@@ -1,175 +0,0 @@
-! :folding=indent:collapseFolds=1:
-
-! $Id$
-!
-! Copyright (C) 2004 Slava Pestov.
-! 
-! Redistribution and use in source and binary forms, with or without
-! modification, are permitted provided that the following conditions are met:
-! 
-! 1. Redistributions of source code must retain the above copyright notice,
-!    this list of conditions and the following disclaimer.
-! 
-! 2. Redistributions in binary form must reproduce the above copyright notice,
-!    this list of conditions and the following disclaimer in the documentation
-!    and/or other materials provided with the distribution.
-! 
-! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
-! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
-! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
-! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
-! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
-! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-IN: compiler
-USE: alien
-USE: inference
-USE: kernel
-USE: namespaces
-USE: words
-USE: lists
-USE: math
-
-: DS ( -- address ) "ds" f dlsym ;
-
-: absolute-ds ( -- )
-    #! Add an entry to the relocation table for the 32-bit
-    #! immediate just compiled.
-    "ds" f f rel-dlsym ;
-
-: PEEK-DS ( -- )
-    #! Peek datastack to EAX.
-    DS ECX [I]>R  absolute-ds
-    ECX EAX [R]>R ;
-
-: POP-DS ( -- )
-    #! Pop datastack to EAX.
-    PEEK-DS
-    4 ECX R-I
-    ECX DS R>[I]  absolute-ds ;
-
-#push-immediate [
-    DS ECX [I]>R  absolute-ds
-    4 ECX R+I
-    address  ECX I>[R]
-    ECX DS R>[I]  absolute-ds
-] "generator" set-word-property
-
-#push-indirect [
-    DS ECX [I]>R  absolute-ds
-    4 ECX R+I
-    intern-literal EAX [I]>R  rel-address
-    EAX ECX R>[R]
-    ECX DS R>[I]  absolute-ds
-] "generator" set-word-property
-
-#replace-immediate [
-    DS ECX [I]>R  absolute-ds
-    address  ECX I>[R]
-    ECX DS R>[I]  absolute-ds
-] "generator" set-word-property
-
-#replace-indirect [
-    DS ECX [I]>R  absolute-ds
-    intern-literal EAX [I]>R  rel-address
-    EAX ECX R>[R]
-    ECX DS R>[I]  absolute-ds
-] "generator" set-word-property
-
-#slot [
-    PEEK-DS
-    2unlist type-tag >r cell * r> - EAX EAX D[R]>R
-    DS ECX [I]>R  absolute-ds
-    EAX ECX R>[R]
-] "generator" set-word-property
-
-#call [
-    dup dup postpone-word
-    CALL compiled-offset defer-xt
-    t rel-word
-] "generator" set-word-property
-
-#jump [
-    dup dup postpone-word
-    JUMP compiled-offset defer-xt
-    t rel-word
-] "generator" set-word-property
-
-#call-label [
-    CALL compiled-offset defer-xt
-] "generator" set-word-property
-
-#jump-label [
-    JUMP compiled-offset defer-xt
-] "generator" set-word-property
-
-#jump-t [
-    POP-DS
-    ! condition is now in EAX
-    f address EAX CMP-I-R
-    ! jump w/ address added later
-    JNE compiled-offset defer-xt
-] "generator" set-word-property
-
-#return-to [
-    PUSH-I/PARTIAL 0 defer-xt rel-address
-] "generator" set-word-property
-
-#return [ drop RET ] "generator" set-word-property
-
-#dispatch [
-    #! Compile a piece of code that jumps to an offset in a
-    #! jump table indexed by the fixnum at the top of the stack.
-    #! The jump table must immediately follow this macro.
-    drop
-    POP-DS
-    1 EAX R>>I
-    EAX+/PARTIAL ( -- fixup ) rel-address
-    EAX JUMP-[R]
-    compile-aligned
-    compiled-offset swap set-compiled-cell ( fixup -- )
-] "generator" set-word-property
-
-#target [
-    #! Jump table entries are absolute addresses.
-    compiled-offset 0 compile-cell 0 defer-xt rel-address
-] "generator" set-word-property
-
-#c-call [
-    uncons load-dll 2dup dlsym CALL JUMP-FIXUP t rel-dlsym
-] "generator" set-word-property
-
-#unbox [
-    dup f dlsym CALL JUMP-FIXUP f t rel-dlsym
-    EAX PUSH-R
-] "generator" set-word-property
-
-#box [
-    EAX PUSH-R
-    dup f dlsym CALL JUMP-FIXUP f t rel-dlsym
-    4 ESP R+I
-] "generator" set-word-property
-
-#cleanup [
-    dup 0 = [ drop ] [ ESP R+I ] ifte
-] "generator" set-word-property
-
-[
-    [ #drop drop ]
-    [ #dup  dup  ]
-    [ #swap swap ]
-    [ #over over ]
-    [ #pick pick ]
-    [ #>r   >r   ]
-    [ #r>   r>   ]
-] [
-    uncons
-    [
-        car dup CALL compiled-offset defer-xt t rel-word drop
-    ] cons
-    "generator" set-word-property
-] each

library/compiler/simplifier.factor

@@ -42,9 +42,6 @@ USE: unparser
 USE: vectors
 USE: words
 
-! <LittleDan> peephole?
-! <LittleDan> "whose peephole are we optimizing" "your mom's"
-
 : labels ( linear -- list )
     #! Make a list of all labels defined in the linear IR.
     [ [ unswons #label = [ , ] [ drop ] ifte ] each ] make-list ;
@@ -80,7 +77,7 @@ USE: words
     dup [ uncons simplify-node drop (simplify) ] [ drop ] ifte ;
 
 : simplify ( linear -- linear )
-    purge-labels [ (simplify) ] make-list ;
+    ( purge-labels ) [ (simplify) ] make-list ;
 
 : follow ( linear -- linear )
     dup car car "follow" [ ] singleton ;

library/compiler/x86/fixnum.factor

@@ -0,0 +1,113 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004 Slava Pestov.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are met:
+! 
+! 1. Redistributions of source code must retain the above copyright notice,
+!    this list of conditions and the following disclaimer.
+! 
+! 2. Redistributions in binary form must reproduce the above copyright notice,
+!    this list of conditions and the following disclaimer in the documentation
+!    and/or other materials provided with the distribution.
+! 
+! THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
+! INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+! FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+! DEVELOPERS AND CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+! OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+! WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+! OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+USE: compiler
+IN: math-internals
+USE: assembler
+USE: inference
+USE: math
+USE: words
+USE: kernel
+USE: alien
+USE: lists
+
+! This file provides compiling definitions for fixnum words
+! that are faster than what C gives us.
+
+#drop [
+    drop
+    ECX DS>
+    ECX 4 SUB
+    ECX >DS
+] "generator" set-word-property
+
+#dup [
+    drop
+    ECX DS>
+    EAX [ ECX ] MOV
+    ECX 4 ADD
+    [ ECX ] EAX MOV
+    ECX >DS
+] "generator" set-word-property
+
+#swap [
+    drop
+    ECX DS>
+    EAX [ ECX ] MOV
+    EDX [ ECX -4 ] MOV
+    [ ECX ] EDX MOV
+    [ ECX -4 ] EAX MOV
+] "generator" set-word-property
+
+#over [
+    drop
+    ECX DS>
+    EAX [ ECX -4 ] MOV
+    ECX 4 ADD
+    [ ECX ] EAX MOV
+    ECX >DS
+] "generator" set-word-property
+
+#pick [
+    drop
+    ECX DS>
+    EAX [ ECX -8 ] MOV
+    ECX 4 ADD
+    [ ECX ] EAX MOV
+    ECX >DS
+] "generator" set-word-property
+
+\ #dup f "linearize" set-word-property
+
+: self ( word -- )
+    f swap dup "infer-effect" word-property (consume/produce) ;
+
+\ fixnum- [ \ fixnum- self ] "infer" set-word-property
+
+\ fixnum+ [ \ fixnum+ self ] "infer" set-word-property
+
+: fixnum-insn ( overflow opcode -- )
+    #! This needs to be factored.
+    ECX DS>
+    EAX [ ECX -4 ] MOV
+    EAX [ ECX ] rot execute
+    0 JNO fixup
+    swap compile-call
+    0 JMP fixup >r
+    compiled-offset swap patch
+    ECX 4 SUB
+    [ ECX ] EAX MOV
+    ECX >DS
+    r> compiled-offset swap patch ;
+
+\ fixnum+ [
+    drop \ fixnum+ \ ADD fixnum-insn
+] "generator" set-word-property
+
+\ fixnum- [
+    drop \ fixnum- \ SUB fixnum-insn
+] "generator" set-word-property

library/test/benchmark/fib.factor

@@ -3,6 +3,17 @@ USE: compiler
 USE: kernel
 USE: math
 USE: test
+USE: math-internals
+
+: fixnum-fib ( n -- nth fibonacci number )
+    dup 1 fixnum<= [
+        drop 1
+    ] [
+        1 fixnum- dup fixnum-fib swap 1 fixnum- fixnum-fib fixnum+
+    ] ifte ;
+    compiled
+
+[ 9227465 ] [ 34 fixnum-fib ] unit-test
 
 : fib ( n -- nth fibonacci number )
     dup 1 <= [ drop 1 ] [ 1 - dup fib swap 1 - fib + ] ifte ;

library/test/compiler/asm-test.factor

@@ -1,46 +0,0 @@
-IN: scratchpad
-USE: compiler
-
-0 EAX I>R
-0 ECX I>R
-
-0 EAX [I]>R
-0 ECX [I]>R
-
-0 EAX I>[R]
-0 ECX I>[R]
-
-EAX 0 R>[I]
-ECX 0 R>[I]
-
-EAX EAX [R]>R
-EAX ECX [R]>R
-ECX EAX [R]>R
-ECX ECX [R]>R
-
-EAX EAX R>[R]
-EAX ECX R>[R]
-ECX EAX R>[R]
-ECX ECX R>[R]
-
-4 0 I+[I]
-0 4 I+[I]
-
-4 EAX R+I
-4 ECX R+I
-65535 EAX R+I
-65535 ECX R+I
-
-4 EAX R-I
-4 ECX R-I
-65535 EAX R-I
-65535 ECX R-I
-
-EAX PUSH-R
-ECX PUSH-R
-EAX PUSH-[R]
-ECX PUSH-[R]
-65535 PUSH-I
-
-EAX JUMP-[R]
-ECX JUMP-[R]

library/test/compiler/generic.factor

@@ -73,10 +73,10 @@ USE: words
         [ drop ]
         [ drop ]
         [ drop ]
-    } single-combination + ; compiled
+    } single-combination ; compiled
 
-[ 5 ] [ 2 3 4 single-combination-test-alt ] unit-test
+[ 5 ] [ 2 3 4 single-combination-test-alt + ] unit-test
-[ 7/2 ] [ 2 3 3/2 single-combination-test-alt ] unit-test
+[ 7/2 ] [ 2 3 3/2 single-combination-test-alt + ] unit-test
 
 DEFER: single-combination-test-2
 

library/test/compiler/stack.factor

@@ -7,16 +7,26 @@ USE: math
 USE: kernel
 
 ! Make sure that stack ops compile to correct code.
-: compile-call ( quot -- word )
+: compile-1 ( quot -- word )
     gensym [ swap define-compound ] keep dup compile execute ;
 
-[ ] [ 1 [ drop ] compile-call ] unit-test
+[ ] [ 1 [ drop ] compile-1 ] unit-test
-[ ] [ [ 1 drop ] compile-call ] unit-test
+[ ] [ [ 1 drop ] compile-1 ] unit-test
-[ ] [ [ 1 2 2drop ] compile-call ] unit-test
+[ ] [ [ 1 2 2drop ] compile-1 ] unit-test
-[ ] [ 1 [ 2 2drop ] compile-call ] unit-test
+[ ] [ 1 [ 2 2drop ] compile-1 ] unit-test
-[ ] [ 1 2 [ 2drop ] compile-call ] unit-test
+[ ] [ 1 2 [ 2drop ] compile-1 ] unit-test
-[ 1 1 ] [ 1 [ dup ] compile-call ] unit-test
+[ 2 1 ] [ [ 1 2 swap ] compile-1 ] unit-test
-[ 1 1 ] [ [ 1 dup ] compile-call ] unit-test
+[ 2 1 ] [ 1 [ 2 swap ] compile-1 ] unit-test
+[ 2 1 ] [ 1 2 [ swap ] compile-1 ] unit-test
+[ 1 1 ] [ 1 [ dup ] compile-1 ] unit-test
+[ 1 1 ] [ [ 1 dup ] compile-1 ] unit-test
+[ 1 2 1 ] [ [ 1 2 over ] compile-1 ] unit-test
+[ 1 2 1 ] [ 1 [ 2 over ] compile-1 ] unit-test
+[ 1 2 1 ] [ 1 2 [ over ] compile-1 ] unit-test
+[ 1 2 3 1 ] [ [ 1 2 3 pick ] compile-1 ] unit-test
+[ 1 2 3 1 ] [ 1 [ 2 3 pick ] compile-1 ] unit-test
+[ 1 2 3 1 ] [ 1 2 [ 3 pick ] compile-1 ] unit-test
+[ 1 2 3 1 ] [ 1 2 3 [ pick ] compile-1 ] unit-test
 
 ! Test various kill combinations