[direct register allocation behaviour fix
Adrian Prantl <adrian@complang.tuwien.ac.at>**20090127101004] {
hunk ./compiler.fs 38
+: DirectArg 512 ; \ Register was assigned in the head
hunk ./compiler.fs 81
+: push-comment; ( addr u -- ) s"  (" push-xt push-xt s" )" push-xt; ;
hunk ./compiler.fs 117
-    query? not if s" wam-allocate" push-xt; endif
hunk ./compiler.fs 119
-    
+
+    ( Backtracking )
hunk ./compiler.fs 125
+
+    ( Trail stack management )
+    query? not if s" wam-allocate" push-xt; endif
hunk ./compiler.fs 386
+    2dup
hunk ./compiler.fs 388
-    lastX Yreg s" unify_variable" push-xt;
+    lastX Yreg s" unify_variable" push-xt
+    push-comment;
hunk ./compiler.fs 393
+: direct-arg? ( u -- u b ) dup DirectArg set? ;
hunk ./compiler.fs 401
-		->ar Areg s" unify_variable" push-xt;
+		dup ->ar Areg s" unify_variable" push-xt
+		addr u push-comment;
+		\ mark as directly alloc'd
+		DirectArg or addr u bind-new-var
+		\ s" direct " push-comment;
hunk ./compiler.fs 428
-    head? if  \  FIXME: WHY
+    query? if  \  head?
hunk ./compiler.fs 430
-	lastX yreg i areg getput-variable push-cr
-    else query? if
+        lastX yreg i areg getput-variable
+        addr u lastX register-query-var
+	addr u push-comment;
+    else
hunk ./compiler.fs 435
-        lastX yreg i areg getput-variable push-cr
-	addr u lastX register-query-var
-    endif endif
+	lastX yreg i areg getput-variable
+	addr u push-comment;
+    endif
hunk ./compiler.fs 440
-: compile-var-arg { i addr u -- }
+: compile-var-arg { i addr u -- }  \	addr u push-comment;
hunk ./compiler.fs 443
-	future-arg? head? nand if
-	    drop \ ignore
-	    i addr u copy-temporary
+	direct-arg? if
+	    \ skip (already unified)
+	    ->ar addr u bind-new-var
hunk ./compiler.fs 447
-	    ->ar dup i = if
-		drop \ skip (identical) copy
-	    else Yreg i Areg getput-value push-cr endif
+	    future-arg? head? nand if
+		drop \ ignore
+		i addr u copy-temporary
+	    else
+		->ar dup i = if
+		    \ skip (identical) copy and mark as directly alloc'd
+		    DirectArg or addr u bind-new-var
+		    \ s" direct " push-comment;
+		else Yreg i Areg getput-value addr u push-comment; endif
+	    endif
hunk ./compiler.fs 775
-s" concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3)." compile eval
-s" :- concatenate([],[],[])." compile eval
+s" concatenate([X|L1],L2,[X|L3]) :- concatenate(L1,L2,L3)." compile eval 
+s" :- concatenate([],[],[])." compile eval 
hunk ./compiler.fs 786
-s" qsort([X|L],R0,R) :- split(L,X,L1,L2), qsort(L1,R0,[X|R1]), qsort(L2,R1,R)." compile
+s" qsort([X|L],R0,R) :- split(L,X,L1,L2), qsort(L1,R0,[X|R1]), qsort(L2,R1,R)." compile bye
}