Add a bunch more set operations to the PowerPC backends, and the Pascal test

for the same.

mach/powerpc/libem/and.s

@@ -3,11 +3,13 @@
 .sect .text
 
 ! Set intersection.
-!  Stack: ( b a -- a*b )
+!  Stack: ( b a size -- a*b )
-!  With r3 = size of set
 
 .define .and
 .and:
+	lwz r3, 0 (sp)      ! r3 = size
+	addi sp, sp, 4
+
 	mr	r4, sp			! r4 = ptr to set a
 	add	r5, sp, r3		! r5 = ptr to set b
 	rlwinm	r6, r3, 30, 2, 31

mach/powerpc/libem/com.s

@@ -3,11 +3,13 @@
 .sect .text
 
 ! Set complement.
-!  Stack: ( a -- ~a )
+!  Stack: ( a size -- ~a )
-!  With r3 = size of set
 
 .define .com
 .com:
+	lwz r3, 0 (sp)       ! size
+	addi sp, sp, 4
+
 	mr	r4, sp			! r4 = pointer to set a
 	rlwinm	r5, r3, 30, 2, 31
 	mtspr	ctr, r5			! ctr = r3 / 4

mach/powerpc/libem/ior.s

@@ -3,7 +3,7 @@
 .sect .text
 
 ! Set union.
-!  Stack: ( size b a -- a+b )
+!  Stack: ( b a size -- a+b )
 
 .define .ior
 .ior:

mach/powerpc/libem/rck.s

@@ -3,13 +3,13 @@
 .sect .text
 
 ! Bounds check. Traps if the value is out of range.
-!  Stack: ( descriptor value -- )
+!  Stack: ( value descriptor -- value )
 
 .define .rck
 .rck:
     lwz r3, 0 (sp)
     lwz r4, 4 (sp)
-    addi sp, sp, 8
+    addi sp, sp, 4 ! leave value on stack
 
     lwz r5, 0 (r3)
     cmp cr0, 0, r4, r5

mach/powerpc/libem/set.s

@@ -3,7 +3,7 @@
 .sect .text
 
 ! Create singleton set.
-!  Stack: ( size bitnumber -- set )
+!  Stack: ( bitnumber size -- set )
 
 .define .set
 .set:

mach/powerpc/ncg/table

@@ -1466,11 +1466,13 @@ PATTERNS
 			yields %a
 
 	pat and defined($1)                /* AND set */
-		with STACK
+		leaving
-			kills ALL
+			loc $1
-			gen
+			cal ".and"
-				move {CONST, $1}, R3
+
-				bl {LABEL, ".and"}
+	pat and !defined($1)
+		leaving
+			cal ".and"
 
 	pat ior $1==4                      /* OR word */
 		with REG NOT_R
@@ -1559,10 +1561,13 @@ PATTERNS
 			yields {NOT_R, %1}
 
 	pat com defined($1)                /* NOT set */
-		with STACK
+		leaving
-			gen
+			loc $1
-				move {CONST, $1}, R3
+			cal ".com"
-				bl {LABEL, ".com"}
+
+	pat com !defined($1)
+		leaving
+			cal ".com"
 
 	pat zer $1==4                      /* Push zero */
 		leaving
@@ -1663,6 +1668,10 @@ PATTERNS
 			loc $1
 			cal ".inn"
 
+	pat inn !defined($1)
+		leaving
+			cal ".inn"
+
 
 /* Boolean resolutions */
 
@@ -2053,13 +2062,14 @@ PATTERNS
 			ass 4
 
 	pat lae rck $2==4                  /* Range check */
-		with GPR
+		with REG
 			uses CR0
 			gen
 				cmpli %a, {CONST, 0}, %1, {CONST, rom($1, 1)}
 				bc IFTRUE, LT, {LABEL, ".trap_erange"}
 				cmpli %a, {CONST, 0}, %1, {CONST, rom($1, 2)}
 				bc IFTRUE, GT, {LABEL, ".trap_erange"}
+			yields %1
 
 
 

mach/proto/mcg/treebuilder.c

@@ -519,7 +519,19 @@ static void insn_simple(int opcode)
         }
 
         case op_trp: helper_function(".trp"); break;
-        case op_sig: helper_function(".sig"); break;
+
+        case op_sig:
+        {
+            struct ir* value = pop(EM_pointersize);
+            appendir(
+                store(
+                    EM_pointersize,
+                    new_labelir(".trppc"), 0,
+                    value
+                )
+            );
+            break;
+        }
 
         case op_rtt:
         {
@@ -614,7 +626,7 @@ static void simple_alu1(int opcode, int size, int irop, const char* fallback)
     if (size > (2*EM_wordsize))
     {
         if (!fallback)
-            fatal("treebuilder: can't do opcode %d with size %d", opcode, size);
+            fatal("treebuilder: can't do opcode %s with size %d", em_mnem[opcode - sp_fmnem], size);
         push(
             new_wordir(size)
         );
@@ -638,7 +650,7 @@ static void simple_alu2(int opcode, int size, int irop, const char* fallback)
     if (size > (2*EM_wordsize))
     {
         if (!fallback)
-            fatal("treebuilder: can't do opcode %d with size %d", opcode, size);
+            fatal("treebuilder: can't do opcode %s with size %d", em_mnem[opcode - sp_fmnem], size);
         push(
             new_wordir(size)
         );
@@ -751,10 +763,10 @@ static void insn_ivalue(int opcode, arith value)
         case op_rmu: simple_alu2(opcode, value, IR_MODU, NULL); break;
         case op_dvu: simple_alu2(opcode, value, IR_DIVU, NULL); break;
 
-        case op_and: simple_alu2(opcode, value, IR_AND, NULL); break;
+        case op_and: simple_alu2(opcode, value, IR_AND, ".and"); break;
         case op_ior: simple_alu2(opcode, value, IR_OR, ".ior"); break;
         case op_xor: simple_alu2(opcode, value, IR_EOR, NULL); break;
-        case op_com: simple_alu1(opcode, value, IR_NOT, NULL); break;
+        case op_com: simple_alu1(opcode, value, IR_NOT, ".com"); break;
 
         case op_adf: simple_alu2(opcode, value, IR_ADDF, NULL); break;
         case op_sbf: simple_alu2(opcode, value, IR_SUBF, NULL); break;

plat/linuxppc/libsys/trap.s

@@ -63,7 +63,9 @@ EUNIMPL = 63		! unimplemented em-instruction called
 	addi r3, r0, ERANGE
 	b .trap
 
+.define .trp
 .define .trap
+.trp:
 .trap:
 	cmpi cr0, 0, r3, 15      ! traps >15 can't be ignored
 	bc IFTRUE, LT, 1f

plat/qemuppc/libsys/trap.s

@@ -63,10 +63,3 @@ EUNIMPL = 63		! unimplemented em-instruction called
 .trp:
 .trap:
 	b .trp					! spin forever
-
-.define .sig
-.sig:
-	lwz r3, 0(sp)
-	li32 r4, .trppc
-	stw r3, 0(r4)
-	bclr ALWAYS, 0, 0		! return

tests/plat/pascalsets_p.p

@@ -24,5 +24,14 @@ begin
     for i := 0 to 255 do
         s := s + [chr(i)];
 
+    i := 99; (* to defeat optimisation *)
+    ASSERT(chr(42) in s);
+    ASSERT(chr(142) in s);
+    ASSERT(chr(i) in s);
+    s := s - [chr(42)];
+    ASSERT(not(chr(42) in s));
+    ASSERT(chr(142) in s);
+    ASSERT(chr(i) in s);
+
     finished
 end.