Fix GitLab issue #110 "Inconsistent stack length..."

* CodeAttr.java (fixupAdd); Don't set Label's needsStackMapEntry here.
(processFixups): Instead set it here, during pass 2.
This fixes GitLab issue #110, "Inconsistent stack length
when raising an exception from a parameterized procedure".
* gl110.scm: New test for GitLab issue #110.

7 files changed, 34 insertions, 10 deletions

diff --git a/gnu/bytecode/ChangeLog b/gnu/bytecode/ChangeLog
index 23d73042c..03b645347 100644
--- a/gnu/bytecode/ChangeLog
+++ b/gnu/bytecode/ChangeLog
@@ -1,5 +1,10 @@
 2023-02-26  Per Bothner  <per@bothner.com>
 
+	* CodeAttr.java (fixupAdd); Don't set Label's needsStackMapEntry here.
+	(processFixups): Instead set it here, during pass 2.
+	This fixes GitLab issue #110,
+	"Inconsistent stack length when raising an exception from a parameterized procedure".
+
 	* ExitableBlock.java (endLabel): Allocate lazily.
 	This avoids need to use not-quite-appropriate needsStackMapEntry field.
 
diff --git a/gnu/bytecode/ClassTypeWriter.java b/gnu/bytecode/ClassTypeWriter.java
index d8e13c8d9..990c03b45 100644
--- a/gnu/bytecode/ClassTypeWriter.java
+++ b/gnu/bytecode/ClassTypeWriter.java
@@ -315,7 +315,8 @@ public class ClassTypeWriter extends PrintWriter
 
   public final void printOptionalIndex(CpoolEntry entry)
   {
-    printOptionalIndex(entry.index);
+    if (entry != null)
+      printOptionalIndex(entry.index);
   }
 
   void printName(String name)
diff --git a/gnu/bytecode/CodeAttr.java b/gnu/bytecode/CodeAttr.java
index d3dce1cfe..bd65c6bde 100644
--- a/gnu/bytecode/CodeAttr.java
+++ b/gnu/bytecode/CodeAttr.java
@@ -142,9 +142,6 @@ public class CodeAttr extends Attribute implements AttrContainer
 
   final void fixupAdd (int kind, int offset, Label label)
   {
-    if (label != null && kind != FIXUP_DEFINE && kind != FIXUP_DEFINE_UNREACHABLE
-        && kind != FIXUP_SWITCH && kind != FIXUP_TRY)
-      label.needsStackMapEntry = true;
     int count = fixup_count;
     if (count == 0)
       {
@@ -2602,7 +2599,9 @@ public class CodeAttr extends Attribute implements AttrContainer
             break;
 	  case FIXUP_LINE_PC:
 	    i++;
+            break;
 	  case FIXUP_CASE:
+            break;
 	  case FIXUP_DELETE3:
 	    break;
           case FIXUP_DEFINE_UNREACHABLE:
@@ -2619,7 +2618,6 @@ public class CodeAttr extends Attribute implements AttrContainer
               if (i + 1 < fixup_count && fixupKind(i+1) == FIXUP_GOTO
                   && fixupOffset(i+1) == offset) {
                   for (int j = i; ; j--) {
-                      fixup_labels[j].needsStackMapEntry = false;
                       if (fixupKind(j) == FIXUP_DEFINE_UNREACHABLE)
                           break;
                   }
@@ -2698,7 +2696,9 @@ public class CodeAttr extends Attribute implements AttrContainer
             break;
 	  case FIXUP_LINE_PC:
 	    i++;
+            break;
 	  case FIXUP_CASE:
+            label.needsStackMapEntry = true;
 	    break;
 	  case FIXUP_DELETE3:
 	    delta -= 3;
@@ -2717,6 +2717,7 @@ public class CodeAttr extends Attribute implements AttrContainer
 	  case FIXUP_JSR:
 	  case FIXUP_TRANSFER:
 	    int rel = label.position - (offset+delta);
+            label.needsStackMapEntry = true;
 	    if ((short) rel == rel)
 	      {
                 fixupSet(i, FIXUP_TRANSFER2, offset);
@@ -2758,7 +2759,6 @@ public class CodeAttr extends Attribute implements AttrContainer
     int new_pc = 0;
     int next_fixup_index = 0;
     int next_fixup_offset = fixupOffset(0);
-    int oldPC = -1;
     Label pendingStackMapLabel = null;
   loop3:
     for (int old_pc = 0;  ;  )
@@ -3011,17 +3011,20 @@ public class CodeAttr extends Attribute implements AttrContainer
             else if (kind == FIXUP_CASE)
                 pc = prev_pc;
             disAssemble(dst, prev_pc, pc);
+            prev_pc = pc;
 
             dst.print("fixup#");  dst.print(i);
             dst.print(" @");  dst.print(offset);
-            prev_pc = pc;
             switch (kind) {
             case FIXUP_DEFINE:
             case FIXUP_DEFINE_UNREACHABLE:
                 dst.print(" DEFINE ");
                 if (kind == FIXUP_DEFINE_UNREACHABLE)
                     dst.print("(unreachable) ");
-                dst.println(label);
+                dst.print(label);
+                if (! label.isUsed())
+                    dst.print(" (not used)");
+                dst.println();
                 break;
             case FIXUP_SWITCH:
                 dst.println(" SWITCH");
diff --git a/gnu/bytecode/Label.java b/gnu/bytecode/Label.java
index 7d526315d..c0ac1486c 100644
--- a/gnu/bytecode/Label.java
+++ b/gnu/bytecode/Label.java
@@ -15,7 +15,6 @@ public class Label {
   int first_fixup;
 
   /** The PC of where the label is, or -1 if not yet defined.
-   * The value -2 means don't generate a StackMapTable entry.
    * This PC may be tentative if we later run processFixups.
    * The offset in the code array is cattr.fixupOffset(first_fixup). */
   int position;
diff --git a/testsuite/ChangeLog b/testsuite/ChangeLog
index 9a23e2c75..1da31e006 100644
--- a/testsuite/ChangeLog
+++ b/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2023-02-26  Per Bothner  <per@bothner.com>
+	    Robby Zambito (@zambyte)
+
+	* gl110.scm: New test for GitLab issue #110.
+	"Inconsistent stack length when raising an exception from a parameterized procedure".
+
 2022-10-17  Arvydas Silanskas  <nma.arvydas.silanskas@gmail.com>
 
 	* strings-test.scm: Group test asserts under test-group as to not exceed
diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am
index 71179ead7..9fc112628 100644
--- a/testsuite/Makefile.am
+++ b/testsuite/Makefile.am
@@ -723,7 +723,8 @@ SCRIPTS_TO_RUN = case-warnings.scm uninit1.scm \
   sva40077.scm sva40494.scm sva40649.scm sva40729.scm sva40814.scm \
   sva42377.scm sva42382.scm sva42689.scm sva42722.scm sva43131.scm \
   sva43750.scm sva47412.scm sva46728.scm sva47651.scm sva47725.scm \
-  sva47863.scm sva48938.scm sva49416.scm sva52390.scm sva53262.scm
+  sva47863.scm sva48938.scm sva49416.scm sva52390.scm sva53262.scm \
+  gl110.scm
 
 # Files needed for SCRIPTS_TO_RUN
 AUX_FOR_SCRIPTS_TO_RUN = aux-libs.scm sva46728x.scm sva46728z.scm
diff --git a/testsuite/gl110.scm b/testsuite/gl110.scm
new file mode 100644
index 000000000..c30876c11
--- /dev/null
+++ b/testsuite/gl110.scm
@@ -0,0 +1,9 @@
+; Test for Issue #110 on GitLab, from Robby Zambito (@zambyte)
+; "Inconsistent stack length when raising an exception from a parameterized procedure"
+ (let ((foo (make-parameter (lambda () 42))))
+  (guard (e ((eq? e 5) (display "guard ") (display e) #t)
+	    (else (display "guard #F") #f))
+    (parameterize ((foo (lambda () (raise 5))))
+      ((foo)))))
+(newline)
+;; Output: guard 5