powerpc backend fixes, remove some redundant vops

CHANGES.html

@@ -14,23 +14,44 @@
 <li>New basic block optimizer performs more aggressive dead load and store elimination.</li>
 <li>Stack shuffles are compiled more efficiently.</li>
 <li>Pushing literals on either side of a stack shuffle is now compiled more efficiently.</li>
-<li>Tail-recursive inlined words are compiled in a new way, saving a few instructions.</li>
 </ul>
 
 </li>
 
-<li>Sequences:
+<li>Collections:
 
 <ul>
 <li>Faster <code>map</code>, <code>2each</code> and <code>2map</code>.</li>
 <li>Arrays are now better supported and should be used instead of vectors where resizing is not desired.</li>
+<li>Some new sequence words that do not bounds check: <code>nth-unsafe</code> and <code>set-nth-unsafe</code>. These should only be used in special circumstances, such as inner loops (<code>each</code>, <code>map</code> and so on use them).</li>
+<li>Hashtables did not obey the rule that equal objects must have equal hashcodes, so using hashtables as hashtable keys did not work.</li>
 </li>
 
 <li>Everything else:
 
 <ul>
+<li>Easier exception handling. The <code>cleanup ( try cleanup -- )</code> word encapsulates the following idiom:
+<pre>
+[ A ] [ B rethrow ] catch
+[ A ] [ B ] cleanup
+</pre>
+The <code>recover ( try recover -- )</code> word encapsulates the following idiom:
+<pre>
+[ A ] [ [ B ] when* ] catch
+[ A ] [ B ] recover
+</pre>
+The <code>catch ( try -- error/f )</code> word no longer takes a quotation that receives the error caught; rather, it just pushes the error that was caught on the stack. That is, the old way:
+<pre>
+[ A ] [ B ] catch
+</pre>
+Becomes:
+<pre>
+[ A ] catch B
+</pre>
+However, most uses of <code>catch</code> can be replaced by <code>cleanup</code> and <code>recover</code>.</li>
 <li>The distinct <code>t</code> type is gone. Now, the <code>t</code> object is just a symbol.</li>
-<li>Hashtables did not obey the rule that equal objects must have equal hashcodes, so using hashtables as hashtable keys did not work.</li>
+<li>A new <code>with-server ( port ident quot -- )</code> combinator takes care of listening on a network socket, logging client connections, spawning client handler threads, and error handling. The quotation is called for each client, in a new scope with the client socket as the default stream.</li>
+<li>New <code>1+</code>, <code>1-</code> words are a bit faster than <code>1 +</code> and <code>1 -</code> since there is one less generic dispatch involved.</li>
 </ul>
 
 </ul>

TODO.FACTOR.txt

@@ -1,6 +1,21 @@
-- nodes: lazily create history, class/literal map hashes
 - 5 car gives wrong error
 - compile interruption checks
+- check that set-datastack and set-callstack compile correctly in the
+  face of optimization
+- [ 2cdr < ] sort -- sig11
+- slice: if sequence or seq start is changed, abstraction violation
+- array>tuple: check length and class
+- code walker & exceptions
+- floating point intrinsics
+- fix fixnum/mod overflow on PowerPC
+- intrinsic char-slot set-char-slot
+- split: return vectors
+- vectors: ensure its ok with bignum indices
+- nth-unsafe and set-nth-unsafe; ensure it works with bignum indices
+- set-path: iterative
+- parse-command-line: no unswons of cli args
+- investigate if rehashing on startup is really necessary
+- remove word transfer hack in bootstrap
 
 + ui:
 
@@ -35,7 +50,6 @@
   http://clozure.com/cgi-bin/viewcvs.cgi/ccl/lisp-kernel/lisp-exceptions.c?rev=1.9&content-type=text/vnd.viewcvs-markup
 
 - http keep alive, and range get
-- code walker & exceptions
 
 + ffi:
 
@@ -55,10 +69,7 @@
 - [ ] [ throw ] ifte ==> should raise 'unbalanced branches' error
 - declare slot types for built-ins
 - remove dead code after a 'throw'
-- floating point intrinsics
 - flushing optimization
-- fix fixnum/mod overflow on PowerPC
-- intrinsic char-slot set-char-slot
 - [ [ dup call ] dup call ] infer hangs
 - the invalid recursion form case needs to be fixed, for inlines too
 - recursion is iffy; if the stack at the recursive call doesn't match
@@ -66,11 +77,8 @@
 
 + sequences:
 
-- split: return vectors
 - specialized arrays
 - instances: do not use make-list
-- vectors: ensure its ok with bignum indices
-- nth-unsafe and set-nth-unsafe; ensure it works with bignum indices
 - >c/c>: vector stack
 - search: slow
 - vectorize >n, n>, (get)
@@ -91,10 +99,6 @@
 - there is a problem with hashcodes of words and bootstrapping
 - delegating generic words with a non-standard picker
 - code gc
-- set-path: iterative
-- parse-command-line: no unswons of cli args
-- investigate if rehashing on startup is really necessary
-- remove word transfer hack in bootstrap
 
 + i/o:
 

library/compiler/basic-blocks.factor

@@ -30,19 +30,17 @@ M: %inc-d simplify-stack* ( vop -- ) d-height accum-height ;
 
 M: %inc-r simplify-stack* ( vop -- ) r-height accum-height ;
 
-: update-ds ( vop -- )
+GENERIC: update-loc ( loc -- )
+
+M: ds-loc update-loc
     dup ds-loc-n d-height get - swap set-ds-loc-n ;
 
-: update-cs ( vop -- )
+M: cs-loc update-loc
     dup cs-loc-n r-height get - swap set-cs-loc-n ;
 
-M: %peek-d simplify-stack* ( vop -- ) 0 vop-in update-ds ;
+M: %peek simplify-stack* ( vop -- ) 0 vop-in update-loc ;
 
-M: %peek-r simplify-stack* ( vop -- ) 0 vop-in update-cs ;
+M: %replace simplify-stack* ( vop -- ) 0 vop-out update-loc ;
-
-M: %replace-d simplify-stack* ( vop -- ) 0 vop-out update-ds ;
-
-M: %replace-r simplify-stack* ( vop -- ) 0 vop-out update-cs ;
 
 : simplify-stack ( block -- )
     #! Combine all %inc-d/%inc-r into two final ones.
@@ -106,14 +104,10 @@ M: %inc-r trim-dead* ( tail vop -- ) simplify-inc drop ;
 : redundant-peek? ( vop -- ? )
     dup 0 vop-in swap 0 vop-out vreg-contents get hash = ;
 
-: ?dead-peek ( tail vop -- )
+M: %peek trim-dead* ( tail vop -- )
     dup redundant-peek? >r tuck live-load? not r> or
     [ dup remember-peek dup , ] unless drop ;
 
-M: %peek-d trim-dead* ( tail vop -- ) ?dead-peek ;
-
-M: %peek-r trim-dead* ( tail vop -- ) ?dead-peek ;
-
 : redundant-replace? ( vop -- ? )
     dup 0 vop-out swap 0 vop-in vreg-contents get hash = ;
 
@@ -128,14 +122,10 @@ M: %peek-r trim-dead* ( tail vop -- ) ?dead-peek ;
     dup 0 vop-out forget-stack-loc
     dup 0 vop-out swap 0 vop-in vreg-contents get set-hash ;
 
-: ?dead-replace ( tail vop -- )
+M: %replace trim-dead* ( tail vop -- )
     dup redundant-replace? >r tuck live-load? not r> or
     [ dup remember-replace dup , ] unless drop ;
 
-M: %replace-d trim-dead* ( tail vop -- ) ?dead-replace ;
-
-M: %replace-r trim-dead* ( tail vop -- ) ?dead-replace ;
-
 : ?dead-literal dup forget-vregs tuck live-load? ?, ;
 
 M: %immediate trim-dead* ( tail vop -- ) ?dead-literal ;

library/compiler/ppc/generator.factor

@@ -72,7 +72,7 @@ M: %untag generate-node ( vop -- )
 
 M: %dispatch generate-node ( vop -- )
     0 <vreg> check-src
-    3 3 2 SLWI
+    3 3 1 SRAWI
     ! The value 24 is a magic number. It is the length of the
     ! instruction sequence that follows to be generated.
     0 1 rel-address  compiled-offset 24 + 4 LOAD32
@@ -86,9 +86,11 @@ M: %type generate-node ( vop -- )
     <label> "f" set
     <label> "end" set
     ! Get the tag
-    3 4 tag-mask ANDI
+    3 5 tag-mask ANDI
+    ! Tag the tag
+    5 4 tag-fixnum
     ! Compare with object tag number (3).
-    0 4 object-tag CMPI
+    0 5 object-tag CMPI
     ! Jump if the object doesn't store type info in its header
     "end" get BNE
     ! It does store type info in its header
@@ -97,13 +99,14 @@ M: %type generate-node ( vop -- )
     "f" get BEQ
     ! The pointer is not equal to 3. Load the object header.
     4 3 object-tag neg LWZ
-    4 4 3 SRAWI
+    4 4 untag
     "end" get B
     "f" get save-xt
     ! The pointer is equal to 3. Load F_TYPE (9).
-    f type 4 LI
+    f type tag-bits shift 4 LI
     "end" get save-xt
     3 4 MR ;
 
 M: %tag generate-node ( vop -- )
-    dup 0 vop-in v>operand swap 0 vop-out v>operand tag-mask ANDI ;
+    dup 0 vop-in v>operand swap 0 vop-out v>operand
+    [ tag-mask ANDI ] keep dup tag-fixnum ;

library/compiler/ppc/stack.factor

@@ -3,8 +3,10 @@
 IN: compiler-backend
 USING: assembler compiler errors kernel math memory words ;
 
-: ds-op cell * neg 14 swap ;
+GENERIC: loc>operand
-: cs-op cell * neg 15 swap ;
+
+M: ds-loc loc>operand ds-loc-n cell * neg 14 swap ;
+M: cs-loc loc>operand cs-loc-n cell * neg 15 swap ;
 
 M: %immediate generate-node ( vop -- )
     dup 0 vop-in address swap 0 vop-out v>operand LOAD ;
@@ -15,20 +17,14 @@ M: %immediate generate-node ( vop -- )
 M: %indirect generate-node ( vop -- )
     dup 0 vop-out v>operand swap 0 vop-in load-indirect ;
 
-M: %peek-d generate-node ( vop -- )
+M: %peek generate-node ( vop -- )
-    dup 0 vop-out v>operand swap 0 vop-in ds-op LWZ ;
+    dup 0 vop-out v>operand swap 0 vop-in loc>operand LWZ ;
 
-M: %replace-d generate-node ( vop -- )
+M: %replace generate-node ( vop -- )
-    dup 1 vop-in v>operand swap 0 vop-in ds-op STW ;
+    dup 0 vop-in v>operand swap 0 vop-out loc>operand STW ;
 
 M: %inc-d generate-node ( vop -- )
     14 14 rot 0 vop-in cell * ADDI ;
 
 M: %inc-r generate-node ( vop -- )
     15 15 rot 0 vop-in cell * ADDI ;
-
-M: %peek-r generate-node ( vop -- )
-    dup 0 vop-out v>operand swap 0 vop-in cs-op LWZ ;
-
-M: %replace-r generate-node ( vop -- )
-    dup 1 vop-in v>operand swap 0 vop-in cs-op STW ;

library/compiler/vops.factor

@@ -119,21 +119,27 @@ C: %end-dispatch make-vop ;
 : %end-dispatch empty-vop <%end-dispatch> ;
 
 ! stack operations
-TUPLE: %peek-d ;
+TUPLE: %peek ;
-C: %peek-d make-vop ;
+C: %peek make-vop ;
+
+M: %peek basic-block? drop t ;
 
 : %peek-d ( vreg n -- vop )
-    <ds-loc> swap <vreg> src/dest-vop <%peek-d> ;
+    <ds-loc> swap <vreg> src/dest-vop <%peek> ;
 
-M: %peek-d basic-block? drop t ;
+: %peek-r ( vreg n -- vop )
+    <cs-loc> swap <vreg> src/dest-vop <%peek> ;
 
-TUPLE: %replace-d ;
+TUPLE: %replace ;
-C: %replace-d make-vop ;
+C: %replace make-vop ;
+
+M: %replace basic-block? drop t ;
 
 : %replace-d ( vreg n -- vop )
-    <ds-loc> src/dest-vop <%replace-d> ;
+    <ds-loc> src/dest-vop <%replace> ;
 
-M: %replace-d basic-block? drop t ;
+: %replace-r ( vreg n -- vop )
+    <cs-loc> src/dest-vop <%replace> ;
 
 TUPLE: %inc-d ;
 C: %inc-d make-vop ;
@@ -141,30 +147,6 @@ C: %inc-d make-vop ;
 
 M: %inc-d basic-block? drop t ;
 
-TUPLE: %immediate ;
-C: %immediate make-vop ;
-
-: %immediate ( vreg obj -- vop )
-    swap <vreg> src/dest-vop <%immediate> ;
-
-M: %immediate basic-block? drop t ;
-
-TUPLE: %peek-r ;
-C: %peek-r make-vop ;
-
-: %peek-r ( vreg n -- vop )
-    <cs-loc> swap <vreg> src/dest-vop <%peek-r> ;
-
-M: %peek-r basic-block? drop t ;
-
-TUPLE: %replace-r ;
-C: %replace-r make-vop ;
-
-: %replace-r ( vreg n -- vop )
-    <cs-loc> src/dest-vop <%replace-r> ;
-
-M: %replace-r basic-block? drop t ;
-
 TUPLE: %inc-r ;
 
 C: %inc-r make-vop ;
@@ -173,6 +155,14 @@ C: %inc-r make-vop ;
 
 M: %inc-r basic-block? drop t ;
 
+TUPLE: %immediate ;
+C: %immediate make-vop ;
+
+: %immediate ( vreg obj -- vop )
+    swap <vreg> src/dest-vop <%immediate> ;
+
+M: %immediate basic-block? drop t ;
+
 : in-1 0 0 %peek-d , ;
 : in-2 0 1 %peek-d ,  1 0 %peek-d , ;
 : in-3 0 2 %peek-d ,  1 1 %peek-d ,  2 0 %peek-d , ;

library/compiler/x86/stack.factor

@@ -5,20 +5,17 @@ USING: alien assembler compiler inference kernel lists math
 memory sequences words ;
 
 : reg-stack ( reg n -- op ) cell * neg 2list ;
-: ds-op ( ds-loc -- op ) ds-loc-n ESI swap reg-stack ;
-: cs-op ( cs-loc -- op ) cs-loc-n EBX swap reg-stack ;
 
-: (%peek) dup 0 vop-out v>operand swap 0 vop-in ;
+GENERIC: loc>operand
 
-M: %peek-d generate-node ( vop -- ) (%peek) ds-op MOV ;
+M: ds-loc loc>operand ds-loc-n ESI swap reg-stack ;
+M: cs-loc loc>operand cs-loc-n EBX swap reg-stack ;
 
-M: %peek-r generate-node ( vop -- ) (%peek) cs-op MOV ;
+M: %peek generate-node ( vop -- )
+    dup 0 vop-out v>operand swap 0 vop-in loc>operand swap MOV ;
 
-: (%replace) dup 0 vop-in v>operand swap 0 vop-out ;
+M: %replace generate-node ( vop -- )
-    
+    dup 0 vop-in v>operand swap 0 vop-out loc>operand swap MOV ;
-M: %replace-d generate-node ( vop -- ) (%replace) ds-op swap MOV ;
-
-M: %replace-r generate-node ( vop -- ) (%replace) cs-op swap MOV ;
 
 : (%inc) swap 0 vop-in cell * dup 0 > [ ADD ] [ neg SUB ] ifte ;