From 5bdf787f7b1d30e8ea73d31f9d5e5c1263aa9856 Mon Sep 17 00:00:00 2001
From: "Ilya V. Portnov" <i.portnov@compassplus.ru>
Date: Wed, 5 Oct 2011 15:30:59 +0600
Subject: [PATCH] Enhace constants pool handling when building code.

---
 JVM/Builder/Monad.hs | 18 +++++++++---------
 JVM/ClassFile.hs     |  2 ++
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/JVM/Builder/Monad.hs b/JVM/Builder/Monad.hs
index b61b6f3..59c915b 100644
--- a/JVM/Builder/Monad.hs
+++ b/JVM/Builder/Monad.hs
@@ -34,6 +34,7 @@ import Java.ClassPath
 data GState = GState {
   generated :: [Instruction],             -- ^ Already generated code (in current method)
   currentPool :: Pool Direct,             -- ^ Already generated constants pool
+  nextPoolIndex :: Word16,
   doneMethods :: [Method Direct],         -- ^ Already generated class methods
   currentMethod :: Maybe (Method Direct), -- ^ Current method
   stackSize :: Word16,                    -- ^ Maximum stack size for current method
@@ -47,6 +48,7 @@ emptyGState ::  GState
 emptyGState = GState {
   generated = [],
   currentPool = M.empty,
+  nextPoolIndex = 1,
   doneMethods = [],
   currentMethod = Nothing,
   stackSize = 496,
@@ -98,13 +100,6 @@ withClassPath cp = do
   st <- St.get
   St.put $ st {classPath = res}
 
--- | Append a constant to pool
-appendPool :: Constant Direct -> Pool Direct -> (Pool Direct, Word16)
-appendPool c pool =
-  let ix = if M.null pool then 1 else maximum (M.keys pool) + 1
-      pool' = M.insert ix c pool
-  in  (pool', ix)
-
 -- | Add a constant to pool
 addItem :: (Generator e g) => Constant Direct -> g e Word16
 addItem c = do
@@ -112,9 +107,14 @@ addItem c = do
   case lookupPool c pool of
     Just i -> return i
     Nothing -> do
-      let (pool', i) = appendPool c pool
+      i <- St.gets nextPoolIndex
+      let pool' = M.insert i c pool
+          i' = if long c
+                 then i+2
+                 else i+1
       st <- St.get
-      St.put $ st {currentPool = pool'}
+      St.put $ st {currentPool = pool',
+                   nextPoolIndex = i'}
       return i
 
 -- | Lookup in a pool
diff --git a/JVM/ClassFile.hs b/JVM/ClassFile.hs
index 6171c1b..faf94ca 100644
--- a/JVM/ClassFile.hs
+++ b/JVM/ClassFile.hs
@@ -25,6 +25,7 @@ module JVM.ClassFile
    NameType (..),
    fieldNameType, methodNameType,
    lookupField, lookupMethod,
+   long,
    toString,
    className,
    apsize, arsize, arlist
@@ -459,6 +460,7 @@ whileJust m = do
               return (x: next)
     Nothing -> return []
 
+long :: Constant stage -> Bool
 long (CLong _)   = True
 long (CDouble _) = True
 long _           = False
-- 
2.25.1