Implemented the Load and Store instructions for majority of types. At

least int and long are working, not sure about double and float since I
need to look at IEEE format. Point is though, its getting there.

Author: Louis Jenkins

DataTypes/Class_File.hs

@@ -63,18 +63,11 @@ module DataTypes.Class_File where
     stack <- bootstrap
     str <- debugStack stack
     Prelude.putStrLn $ "Pre-Stack: " ++ str
-    pushFrame stack [1]
+    pushFrame stack [4,59,10,64]
     -- let codeAttr = getCodeAttribute (cp_info classFile) (classfile_attributes classFile)
     -- let code' = code codeAttr
     str' <- debugStack stack
     Prelude.putStrLn $ "Post-Stack: " ++ str'
     debugExec stack
     str'' <- debugStack stack
     Prelude.putStrLn $ "Final-Stack: " ++ str''
-    pushFrame stack [1,1,1,1]
-    debugExec stack
-    debugExec stack
-    debugExec stack
-    debugExec stack
-    str''' <- debugStack stack
-    Prelude.putStrLn $ "Extended-Stack: " ++ str'''

VirtualMachine/ByteCode.hs

@@ -1,14 +1,145 @@
 module VirtualMachine.ByteCode where
   import Data.IORef
+  import Data.Bits
   import VirtualMachine.Types
   import VirtualMachine.Stack_Frame
 
+  execute' :: StackFrame -> ByteCode -> Instructions -> IO ()
+  execute' frame bc instrRef
+    -- NOP
+    | bc == 0 = return ()
+    -- *CONST*
+    | bc >= 1 && bc <= 15 = constOp frame bc
+    -- BIPUSH BYTE
+    | bc == 16 = do
+      byte <- getNextBC instrRef
+      pushOp (fromIntegral byte) frame
+    -- SIPUSH BYTE1 BYTE2
+    | bc == 17 = do
+      byte1 <- getNextBC instrRef
+      byte2 <- getNextBC instrRef
+      pushOp (fromIntegral byte1 `shift` 8 .|. fromIntegral byte2) frame
+    -- LDC* (TODO)
+    -- *LOAD*
+    | bc >= 21 && bc <= 53 = loadOp frame bc instrRef
+    -- *STORE*
+    | bc >= 54 && bc <= 86 = storeOp frame bc instrRef
+    | otherwise = error $ "Bad ByteCode Instruction: " ++ show bc
+
   execute :: StackFrame -> Instructions -> IO ()
   execute frame instrRef = do
-    mnemonic <- getNextBC instrRef
-    case mnemonic of
-      1 -> pushOp 0 frame
-      _ -> return ()
+    instr <- readIORef instrRef
+    case length instr of
+      0 -> return ()
+      _ -> do
+        bc <- getNextBC instrRef
+        execute' frame bc instrRef
+        execute frame instrRef
+
+
+  constOp :: StackFrame -> ByteCode -> IO ()
+  constOp frame bc
+    -- ACONST_NULL
+    | bc == 1 = pushOp 0 frame
+    -- ICONST_*
+    | bc >= 2 && bc <= 8 = pushOp (fromIntegral $ bc - 3) frame
+    -- LCONST_*
+    | bc == 9 || bc == 10 = pushOp (fromIntegral $ bc - 9) frame
+    -- FCONST_*
+    | bc >= 11 && bc <= 13 = pushOp (fromIntegral $ bc - 11) frame
+    -- DCONST_*
+    | bc >= 14 && bc <= 15 = pushOp (fromIntegral $ bc - 14) frame
+    --
+    | otherwise = error $ "Bad ByteCode Instruction: " ++ show bc
+
+  loadOp :: StackFrame -> ByteCode -> Instructions -> IO ()
+  loadOp frame bc instrRef
+    -- ILOAD || FLOAD || ALOAD
+    | bc == 21 || bc == 23 || bc == 25 = do
+      idx <- getNextBC instrRef
+      local <- getLocal (fromIntegral idx) frame
+      pushOp (fromIntegral local) frame
+    -- LLOAD || DLOAD
+    | bc == 22 || bc == 24 = do
+      idx <- getNextBC instrRef
+      high <- getLocal (fromIntegral idx) frame
+      low <- getLocal (fromIntegral $ idx + 1) frame
+      let local = high .|. low
+      pushOp (fromIntegral local) frame
+    -- ILOAD_*
+    | bc >= 26 && bc <= 29 = do
+      local <- getLocal (fromIntegral $ bc - 26) frame
+      pushOp (fromIntegral local) frame
+    -- LLOAD_*
+    | bc >= 30 && bc <= 33 = do
+      let idx = fromIntegral $ bc - 30
+      high <- getLocal idx frame
+      low <- getLocal (idx + 1) frame
+      let local = high .|. low
+      pushOp (fromIntegral local) frame
+    -- FLOAD_*
+    | bc >= 34 && bc <= 37 = do
+      local <- getLocal (fromIntegral $ bc - 34) frame
+      pushOp (fromIntegral local) frame
+    -- DLOAD_*
+    | bc >= 38 && bc <= 41 = do
+      let idx = fromIntegral $ bc - 38
+      high <- getLocal idx frame
+      low <- getLocal (idx + 1) frame
+      let local = high .|. low
+      pushOp (fromIntegral local) frame
+    -- ALOAD_*
+    | bc >= 42 && bc <= 45 = do
+      local <- getLocal (fromIntegral $ bc - 42) frame
+      pushOp (fromIntegral local) frame
+    -- *ALOAD (TODO)
+    | otherwise = error $ "Bad ByteCode Instruction: " ++ show bc
+
+  storeOp :: StackFrame -> ByteCode -> Instructions -> IO ()
+  storeOp frame bc instrRef
+    -- ISTORE || FSTORE || ASTORE
+    | bc == 54 || bc == 56 || bc == 58 = do
+      idx <- getNextBC instrRef
+      operand <- popOp frame
+      putLocal (fromIntegral idx) (fromIntegral operand) frame
+    -- LSTORE || DSTORE
+    | bc == 55 || bc == 57 = do
+      idx <- getNextBC instrRef
+      operand <- popOp frame
+      let high = operand `shiftR` 32
+      let low = operand .&. 0xFFFFFFFF
+      putLocal (fromIntegral idx) (fromIntegral high) frame
+      putLocal (fromIntegral $ idx + 1) (fromIntegral low) frame
+    -- ISTORE_*
+    | bc >= 59 && bc <= 62 = do
+      operand <- popOp frame
+      putLocal (fromIntegral $ bc - 59) (fromIntegral operand) frame
+    -- LSTORE_*
+    | bc >= 63 && bc <= 66 = do
+      let idx = fromIntegral $ bc - 63
+      operand <- popOp frame
+      let high = operand `shiftR` 32
+      let low = operand .&. 0xFFFFFFFF
+      putLocal (fromIntegral idx) (fromIntegral high) frame
+      putLocal (fromIntegral $ idx + 1) (fromIntegral low) frame
+    -- FSTORE_*
+    | bc >= 67 && bc <= 70 = do
+      operand <- popOp frame
+      putLocal (fromIntegral $ bc - 67) (fromIntegral operand) frame
+    -- DSTORE_*
+    | bc >= 71 && bc <= 74 = do
+      let idx = fromIntegral $ bc - 71
+      operand <- popOp frame
+      let high = operand `shiftR` 32
+      let low = operand .&. 0xFFFFFFFF
+      putLocal (fromIntegral idx) (fromIntegral high) frame
+      putLocal (fromIntegral $ idx + 1) (fromIntegral low) frame
+    -- ALOAD_*
+    | bc >= 75 && bc <= 78 = do
+      operand <- popOp frame
+      putLocal (fromIntegral $ bc - 75) (fromIntegral operand) frame
+    -- *ALOAD (TODO)
+    | otherwise = error $ "Bad ByteCode Instruction: " ++ show bc
 
   getNextBC :: Instructions -> IO ByteCode
   getNextBC instrRef = do

VirtualMachine/Stack_Frame.hs

@@ -27,9 +27,15 @@ module VirtualMachine.Stack_Frame where
   putLocal offset val frameRef = do
     frame <- readIORef frameRef
     let l = locals frame
-    old <- readIORef l
-    writeIORef l ((element (fromEnum offset) .~ val) old)
-
+    -- TODO: Change to Data.Array.MArray, so I can avoid this mess
+    modifyIORef l (inject 0 offset val)
+      where
+        inject :: Word16 -> Word16 -> Value -> [Local_Variable] -> [Local_Variable]
+        inject m n val' (x:xs)
+          | n == m =  val' : x : xs
+          | n > m = x : inject (m+1) n val' xs
+          | otherwise = error $ "Bad range: " ++ show m ++ " of " ++ show n
+        inject _ _ val' [] = [val']
   {-
     Returns the value associated the given index.
   -}
@@ -43,26 +49,26 @@ module VirtualMachine.Stack_Frame where
   {-
     Pushes a value on the operand stack
   -}
-  pushOp :: Value -> StackFrame -> IO ()
+  pushOp :: Operand -> StackFrame -> IO ()
   pushOp val frameRef = do
     frame <- readIORef frameRef
     let o = opStack frame
-    modifyIORef' o (\old -> val : old)
+    modifyIORef' o (\old -> fromIntegral val : old)
 
   {-
     Pops the operand off of the stack
   -}
-  popOp :: StackFrame -> IO Value
+  popOp :: StackFrame -> IO Operand
   popOp frameRef = do
     frame <- readIORef frameRef
     let o = opStack frame
     arr <- readIORef o
     let val = head arr
     modifyIORef' o tail
-    return val
+    return $ fromIntegral val
 
   {-
     Pops off N operands off of the stack
   -}
-  popOpN :: Word8 -> StackFrame -> IO [Value]
+  popOpN :: Word8 -> StackFrame -> IO [Operand]
   popOpN n frameRef = replicateM (fromEnum n) (popOp frameRef)

VirtualMachine/Types.hs

@@ -9,12 +9,12 @@ module VirtualMachine.Types where
   type ByteCode = Word8
   type Instructions = IORef [ByteCode]
 
-  type Local_Variable = Int
-  type Operands = Int
-  type Value = Int
+  type Local_Variable = Word64
+  type Operand = Word32
+  type Value = Word64
 
   data Stack_Frame = Frame {
     locals :: IORef [Local_Variable],
-    opStack :: IORef [Operands],
+    opStack :: IORef [Operand],
     instructions :: Instructions
   }

proposal.md

@@ -26,9 +26,3 @@ the built-in Haskell functionality. As well, String concatenation of primitive t
 example of accessing constants can be seen at §3.4), as they can be further substituted for built-in types. As well, auto-boxed objects such as `Integer`, `Double`, and `Float` (auto-boxing generally created using the
 `valueOf` static method) can also be substituted. As well, support for invoking methods (creating a new stack frame) as well as basic exception handling (only `java/lang/Exception`), the latter being optional by the time
 of presentation, should simulate the stack.
-
-### Haskell Implementation Details
-
-This will make heavy-use of Haskell's built-in constructs as utilities, and involves comprehensive knowledge of mathematical constructs such as the `Functor` and `Monad`, as well as extensive knowledge of its control
-constructs. Parsing is handled using the `StateT` monad, which handles elegant simple state transitions, and the JVM `Environment` is kept mutable by using the `IORef` monad for mutable state, and also allowing interleaved
-IO. The implementation details, may change by the time of presentation.