From bd027710cc31829ec9f65b1253e53b66d326fd05 Mon Sep 17 00:00:00 2001 From: macthomasengineering Date: Tue, 23 Aug 2016 22:52:00 -0400 Subject: [PATCH] Add Java library --- Java/Codeblock.bas | 187 +++++ Java/Codegen.bas | 1756 +++++++++++++++++++++++++++++++++++++++++ Java/LICENSE.txt | 30 + Java/MtelBuildLib.b4j | 109 +++ Java/Mtelog.bas | 479 +++++++++++ Java/PCODE.bas | 92 +++ Java/Run.bas | 583 ++++++++++++++ 7 files changed, 3236 insertions(+) create mode 100644 Java/Codeblock.bas create mode 100644 Java/Codegen.bas create mode 100644 Java/LICENSE.txt create mode 100644 Java/MtelBuildLib.b4j create mode 100644 Java/Mtelog.bas create mode 100644 Java/PCODE.bas create mode 100644 Java/Run.bas diff --git a/Java/Codeblock.bas b/Java/Codeblock.bas new file mode 100644 index 0000000..c2e7962 --- /dev/null +++ b/Java/Codeblock.bas @@ -0,0 +1,187 @@ +Type=Class +Version=4.2 +ModulesStructureVersion=1 +B4J=true +@EndOfDesignText@ +'********************************************************************************** +'* +'* Codeblock.bas - Compilable blocks of code +'* +'********************************************************************************** + +#Region BSD License +'********************************************************************************** +'* +'* Copyright (c) 2016, MacThomas Engineering +'* All rights reserved. +'* +'* You may use this file under the terms of the BSD license as follows: +'* +'* Redistribution and use in source and binary forms, with or without +'* modification, are permitted provided that the following conditions are met: +'* +'* 1. Redistributions of source code must retain the above copyright notice, this +'* list of conditions, and the following disclaimer. +'* +'* 2. Redistributions in binary form must reproduce the above copyright notice, +'* this list of conditions and the following disclaimer in the documentation +'* and/or other materials provided with the distribution. +'* +'* 3. MacThomas Engineering may not be used to endorse or promote products derived +'* from this software without specific prior written permission. +'* +'* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +'* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +'* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +'* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +'* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +'* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +'* LOSS OF USE, DATA, Or PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED And +'* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +'* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +'* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +'* +'********************************************************************************** +#End Region + +#Region Revision History +'********************************************************************************** +'* Revision History: +'* +'* No. Who Date Description +'* ===== === ========== ====================================================== +'* 1.01 MTE 2016/08/23 - Added #if B4I in Run.bas for Mod operator +'* - Added #if B4I and custom ExtractExpressions until +'* we sort out the RegEx difference between B4A and B4I +'* 1.00 MTE 2016/08/23 - Preparing for release +'* 0.01 MTE 2016/08/11 - Begin here! +'* +'* +'********************************************************************************** +#End Region + +Sub Class_Globals + + Private Bytecode As List + Public Text As String + Public Error As Int + Public ErrorDesc As String + Public ErrorDetail As String + + ' Errors + Public Const ERROR_NONE = 0 As Int + Public Const ERROR_SYNTAX = 1 As Int + Public Const ERROR_MISSING_BRACKET = 2 As Int + Public Const ERROR_MISSING_PIPE = 3 As Int + Public Const ERROR_MISSING_PAREN = 4 As Int + Public Const ERROR_MISSING_COMMA = 5 As Int + Public Const ERROR_MISSING_ARG = 6 As Int + Public Const ERROR_NOT_A_VAR = 7 As Int + Public Const ERROR_MISSING_PARAM = 8 As Int + Public Const ERROR_MISSING_EXPR = 9 As Int + Public Const ERROR_RESERVED_WORD = 10 As Int + Public Const ERROR_TOO_MANY_ARGS = 11 As Int + Public Const ERROR_UNBALANCED_PARENS = 12 As Int + Public Const ERROR_PUTBACK = 13 As Int + Public Const ERROR_NO_CODE = 20 As Int + Public Const ERROR_ILLEGAL_CODE = 21 As Int + Public Const ERROR_INSUFFICIENT_ARGS = 22 As Int + Public Const ERROR_STACK_OVERFLOW = 23 As Int + Public Const ERROR_DIVIDE_BY_ZERO = 24 As Int + Public Const ERROR_ARG_NOT_NUMBER = 25 As Int + Public Const ERROR_OTHER = 33 As Int + + Public Version="1.01" As String + +End Sub + +'------------------------------------------------- +' Initialize Codeblock +' +' +' +Public Sub Initialize + + Text = "" + Error = ERROR_NONE + ErrorDesc = "" + ErrorDetail = "" + +End Sub + +'------------------------------------------------- +' Compile expression into Codeblock +' +' Example: Dim cb as Codeblock +' error = cb.Compile( "{||3+8}" ) +' +Public Sub Compile( sCodeblock As String ) As Int + Private nResult As Int + + ' Reset code and error + Bytecode.Initialize + Error = ERROR_NONE + ErrorDesc = "" + ErrorDetail = "" + + ' Store codeblock in text form + Text = sCodeblock + + ' Compile the codeblock + nResult = Codegen.CompileCodeBlock( Me, Bytecode ) + + Return ( nResult ) + +End Sub + +'------------------------------------------------- +' Evaulate a Codeblock +' +' Example: Dim cb as Codeblock +' error = cb.Compile( "{||3+8}" ) +' result = cb.Eval +' +Public Sub Eval As Double + Private nResult As Double 'ignore + Private aArgs() As Object + + nResult = Run.Execute( Me, Bytecode, aArgs ) + + Return ( nResult ) +End Sub + +'------------------------------------------------- +' Evaulate a Codeblock with parameters +' +' Example: Dim cb as CodeBlock +' error = cb.Compile( "{|a,b|3*a+8*b}" ) +' result = cb.Eval2( Array( 6, 10 ) ) +' +Public Sub Eval2( aArgs() As Object ) As Double + Private nResult As Double 'ignore + + nResult = Run.Execute( Me, Bytecode, aArgs ) + + Return ( nResult ) +End Sub + + + +'------------------------------------------------- +' Decompile Codeblock +' +' Example: Dim cb as CodeBlock +' Dim Decode as List +' error = cb.Compile( "{|a,b|3*a+8*b}" ) +' Decode = cb.Decompile +' +Public Sub Decompile As List + Private Decode As List + Decode.Initialize + Run.Dump( Me, Bytecode, Decode ) + Return ( Decode ) +End Sub + + + + diff --git a/Java/Codegen.bas b/Java/Codegen.bas new file mode 100644 index 0000000..9b0af30 --- /dev/null +++ b/Java/Codegen.bas @@ -0,0 +1,1756 @@ +Type=StaticCode +Version=4.2 +ModulesStructureVersion=1 +B4J=true +@EndOfDesignText@ +'********************************************************************************** +'* +'* Codegen.bas - Parser and code generator +'* +'********************************************************************************** + +#Region BSD License +'********************************************************************************** +'* +'* Copyright (c) 2016, MacThomas Engineering +'* All rights reserved. +'* +'* You may use this file under the terms of the BSD license as follows: +'* +'* Redistribution and use in source and binary forms, with or without +'* modification, are permitted provided that the following conditions are met: +'* +'* 1. Redistributions of source code must retain the above copyright notice, this +'* list of conditions, and the following disclaimer. +'* +'* 2. Redistributions in binary form must reproduce the above copyright notice, +'* this list of conditions and the following disclaimer in the documentation +'* and/or other materials provided with the distribution. +'* +'* 3. MacThomas Engineering may not be used to endorse or promote products derived +'* from this software without specific prior written permission. +'* +'* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +'* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +'* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +'* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +'* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +'* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +'* LOSS OF USE, DATA, Or PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED And +'* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +'* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +'* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +'* +'********************************************************************************** +#End Region + +Sub Process_Globals + + ' Types + Type TOKEN ( nType As Int, sText As String ) + Type JUMP ( nCodeIndex As Int, nLabelIndex As Int ) + Type FUNC_INFO ( nPcode As Int, nArgCount As Int ) + + Private gCodeBlock As Codeblock + Private gBytecode As List + Private gCodeIndex As Int + Private gCodeBlock As Codeblock + Private gParamExpr As String + Private gEvalExpr As String + Private gTokenList As List + Private gToken As TOKEN + Private gTokenIndex As Int + Private gTokenEndIndex As Int + Private gFuncInfo As FUNC_INFO + Private gPutBackCount As Int + Private gPutBackIndex As Int + + ' Jump table + Private gJumpTable(20) As JUMP + Private gJumpCount=0 As Int + + ' Labels + Private gLabelTargets(20) As Int + Private gLabelIndex=0 As Int + + ' Parameter names + Private gParameters(20) As String + Private gParameterCount=0 As Int + + ' Parenthesis + Private gParenCount As Int + + ' Tokens + Private Const TOKEN_TYPE_NONE=0 As Int 'ignore + Private Const TOKEN_TYPE_DELIMITER=1 As Int 'ignore + Private Const TOKEN_TYPE_IDENTIFIER=2 As Int 'ignore + Private Const TOKEN_TYPE_NUMBER=3 As Int 'ignore + Private Const TOKEN_TYPE_KEYWORD=4 As Int 'ignore + Private Const TOKEN_TYPE_TEMP=5 As Int 'ignore + Private Const TOKEN_TYPE_STRING=6 As Int 'ignore + Private Const TOKEN_TYPE_BLOCK=7 As Int 'ignore + Private Const TOKEN_TYPE_UNKNOWN=8 As Int 'ignore + Private Const TOKEN_TYPE_FINISHED=9 As Int 'ignore + Private Const NULL_TOKEN=Chr(0) As String + + ' RegEx + Private Const TOKENIZER_MATCH="\(|\)|>=|<=|<>|\|\||&&|!=|==|[+><=*/\-!%,]|[\.\d]+|\b\w+\b" As String + 'Private Const TOKENIZER_MATCH="\(|\)|>=|<=|<>|\|\||&&|!=|==|[+><=*/\-!%,#]|[\.\d]+|\b\w+\b" As String + Private Const CODEBLOCK_MATCH="(\{)?(\|)?([^\|\}]*)(\|)?([^}]*)(\})?" As String + Private Const GROUP_OPEN_BRACKET = 1 As Int + Private Const GROUP_OPEN_PIPE = 2 As Int + Private Const GROUP_PARAM_EXPR = 3 As Int + Private Const GROUP_CLOSE_PIPE = 4 As Int + Private Const GROUP_EVAL_EXPR = 5 As Int + Private Const GROUP_CLOSE_BRACKET = 6 As Int + + ' Abort used to unwind the parser when error found + Private Const ABORT=False As Boolean + Private Const SUCCESS=True As Boolean + +End Sub + + +'*---------------------------------------------------------------- ResetCode +'* +Private Sub ResetCode + +' ' Init table of internal functions +' mapInternalFuncs = CreateMap( "abs" : PCODE.FUNC_ABS, _ ' revisit +' "iif" : PCODE.FUNC_IIF ) + + ' init code index + gCodeIndex = 0 ' First item in bytecode is the codeblock parameter count. + ' Pcode starts at Bytecode.Get( 1 ) + + ' Init jump count and label index + gJumpCount = 0 + gLabelIndex = 0 + gParameterCount = 0 + gParenCount = 0 + gPutBackCount = 0 + gPutBackIndex = 0 + + gParamExpr = "" + gEvalExpr = "" + +End Sub + + +'*--------------------------------------------------------- CompileCodeBlock +'* +Public Sub CompileCodeBlock( oCodeBlock As Codeblock, lstBytecode As List ) As Int + Private nError As Int + + ' Set global reference to the codeblock + gCodeBlock = oCodeBlock + + ' Set global reference to Bytecode + gBytecode = lstBytecode + + ' Reset code index and tables + ResetCode + + ' Extract parameter and eval expressions + nError = ExtractExpressions( gCodeBlock ) + + ' If no error, continue + If ( nError = gCodeBlock.ERROR_NONE ) Then + + ' Process codeblock parameters + nError = CompileParameters + + ' If no error, continue + If ( nError = gCodeBlock.ERROR_NONE ) Then + + ' Store parameter count in the code + EmitCodeHeader( gParameterCount ) + + ' Compile expression + nError = CompileExpression + + End If + + End If + + ' If error delete the code + If ( nError <> gCodeBlock.ERROR_NONE ) Then + gBytecode.Initialize + End If + + Return ( nError ) + +End Sub + + +'*************************************************************************** +'* +'* Parser +'* +'*************************************************************************** + +'*--------------------------------------------------------- CompileExpression +'* +'* +Private Sub CompileExpression As Int + Private bFinished As Boolean + Private bSuccess As Boolean + + ' Tokenize expression + gTokenList = Tokenize( gEvalExpr ) + + bFinished = False + Do Until ( bFinished ) + + ' Run Parser and generate code + bSuccess = EvalExpression + + If ( bSuccess = ABORT ) Then + Exit + End If + + ' Check for completion or unexpected error + Select ( gToken.nType ) + Case TOKEN_TYPE_FINISHED + DoEndCode + FixupJumps + bFinished = True + Case TOKEN_TYPE_NONE + SetError( gCodeBlock.ERROR_OTHER, "Token type none." ) + bFinished = True + Case TOKEN_TYPE_UNKNOWN + SetError( gCodeBlock.ERROR_OTHER, "Unknown token." ) + bFinished = True + End Select + Loop + + Return ( gCodeBlock.Error ) + +End Sub + + +'*------------------------------------------------------- CompileParameters +'* +'* GetToken Advancement +'* -------------------- +'* 1. |a,b,c| +'* ^ +'* 2. |a,b,c| +'* ^ +'* 3. |a,b,c| +'* ^ +'* 4. |a,b,c| +'* ^ +'* 5. |a,b,c| +'* ^ +'* 6. |a,b,c| +'* ^ +Private Sub CompileParameters As Int + Private bFinished As Boolean + Private nCommaCount=0 As Int + + ' Reset parameter count + gParameterCount = 0 + + ' Tokenize argument expression + gTokenList = Tokenize( gParamExpr ) + + ' Build table of parameter names + bFinished = False + Do Until ( bFinished ) + + ' Get parameter + GetToken + + Select ( gToken.nType ) + + Case TOKEN_TYPE_IDENTIFIER + + ' Reserved word? + If ( gToken.sText = "ce" Or gToken.sText = "cpi" ) Then + SetError( gCodeBlock.ERROR_RESERVED_WORD, gToken.sText ) + Exit + End If + + ' Store variable name + gParameters( gParameterCount ) = gToken.sText + + ' Increment count + gParameterCount = gParameterCount + 1 + + ' Reset comma count + nCommaCount = 0 + + Case TOKEN_TYPE_DELIMITER + + ' Not a comma? + If ( gToken.sText <> "," ) Then + SetError2( gCodeBlock.ERROR_MISSING_COMMA ) + Exit + End If + + ' Missed argument? + If ( nCommaCount > 0 ) Then + SetError2( gCodeBlock.ERROR_MISSING_PARAM ) + End If + + ' Bump comma count + nCommaCount = nCommaCount + 1 + + Case TOKEN_TYPE_FINISHED + + If ( nCommaCount > 0 ) Then + SetError2( gCodeBlock.ERROR_MISSING_PARAM ) + End If + + bFinished = True + + Case Else + + ' Invalid value in args list + SetError2( gCodeBlock.ERROR_MISSING_PARAM ) + + End Select + + ' If error exit loop + If ( gCodeBlock.Error <> gCodeBlock.ERROR_NONE ) Then + bFinished = True + End If + + Loop + + Return ( gCodeBlock.Error ) + +End Sub + +#if B4I + +'*-------------------------------------------------------- ExtractExpressions +'* +Private Sub ExtractExpressions( cb As Codeblock ) As Int + Private matchParts As Matcher + Private sTrimmed As String + Private i As Int + Private nGroupCount As Int + Private nError As Int + Private sDetail As String +#if B4I + Private sGroupText As String +#end if + + gEvalExpr = "" + gParamExpr = "" + + ' Strip spaces and change case + sTrimmed = cb.Text.Replace(" ", "" ).ToLowerCase + + ' Break expression into component parts + matchParts = Regex.Matcher(CODEBLOCK_MATCH, sTrimmed ) + + ' Apply pattern + matchParts.Find + + ' Save group count + nGroupCount = matchParts.GroupCount + +#if B4I + nGroupCount = nGroupCount - 1 +#end if + + ' No matches? + If ( nGroupCount = 0 ) Then + Return ( SetError( gCodeBlock.ERROR_SYNTAX, "" ) ) + End If + + ' Inspect groups + For i = 1 To nGroupCount + + sGroupText = "" + Try + sGroupText = matchParts.Group( i ) + + ' Build detail string + If ( sGroupText <> Null ) Then + sDetail = sDetail & sGroupText + End If + + ' Group value missing + If ( sGroupText = Null ) Then + + ' Which one is missing? + Select( i ) + Case GROUP_OPEN_BRACKET + nError = gCodeBlock.ERROR_MISSING_BRACKET + Case GROUP_OPEN_PIPE + nError = gCodeBlock.ERROR_MISSING_PIPE + ' Case GROUP_PARAM_EXPR ' Param expr null ok. + ' nError = gCodeBlock.ERROR_MISSING_PARAM + Case GROUP_CLOSE_PIPE + nError = gCodeBlock.ERROR_MISSING_PIPE + Case GROUP_EVAL_EXPR + nError = gCodeBlock.ERROR_MISSING_EXPR + Case GROUP_CLOSE_BRACKET + nError = gCodeBlock.ERROR_MISSING_BRACKET + End Select + + End If + Catch + nError = gCodeBlock.ERROR_SYNTAX + End Try + + + ' If error found, complete detail and return here + If ( nError <> gCodeBlock.ERROR_NONE) Then + sDetail = sDetail & " " + SetError( nError, sDetail ) + Return ( nError ) + End If + + Next + + ' RegEx should create six groups + If ( nGroupCount = 6 ) Then + + ' Store parameter expression + If ( matchParts.Group( GROUP_PARAM_EXPR ) <> Null ) Then + gParamExpr = matchParts.Group( GROUP_PARAM_EXPR ) ' a,b,c + End If + + ' Store main expression + gEvalExpr = matchParts.Group( GROUP_EVAL_EXPR ) ' 1 * a + c * 5 + + ' And it's not zero length + If ( gEvalExpr.Length <> 0 ) Then + Return ( gCodeBlock.ERROR_NONE ) + End If + + End If + + ' Set syntax error + nError = gCodeBlock.ERROR_SYNTAX + sDetail = sDetail & " " + + Return ( SetError( nError, sDetail ) ) + +End Sub + +#else + +'*-------------------------------------------------------- ExtractExpressions +'* +Private Sub ExtractExpressions( cb As Codeblock ) As Int + Private matchParts As Matcher + Private sTrimmed As String + Private i As Int + Private nGroupCount As Int + Private nError As Int + Private sDetail As String + + gEvalExpr = "" + gParamExpr = "" + + ' Strip spaces and change case + sTrimmed = cb.Text.Replace(" ", "" ).ToLowerCase + + ' Break expression into component parts + matchParts = Regex.Matcher(CODEBLOCK_MATCH, sTrimmed ) + + ' Apply pattern + matchParts.Find + + ' Save group count + nGroupCount = matchParts.GroupCount + + ' No matches? + If ( nGroupCount = 0 ) Then + Return ( SetError( gCodeBlock.ERROR_SYNTAX, "" ) ) + End If + + ' Inspect groups + For i = 1 To nGroupCount + + ' Build detail string + If ( matchParts.Group( i ) <> Null ) Then + sDetail = sDetail & matchParts.Group( i ) + End If + + ' Group value missing + If ( matchParts.Group( i ) = Null ) Then + + ' Which one is missing? + Select( i ) + Case GROUP_OPEN_BRACKET + nError = gCodeBlock.ERROR_MISSING_BRACKET + Case GROUP_OPEN_PIPE + nError = gCodeBlock.ERROR_MISSING_PIPE + ' Case GROUP_PARAM_EXPR ' Param expr null ok. + ' nError = gCodeBlock.ERROR_MISSING_PARAM + Case GROUP_CLOSE_PIPE + nError = gCodeBlock.ERROR_MISSING_PIPE + Case GROUP_EVAL_EXPR + nError = gCodeBlock.ERROR_MISSING_EXPR + Case GROUP_CLOSE_BRACKET + nError = gCodeBlock.ERROR_MISSING_BRACKET + End Select + + End If + + ' If error found, complete detail and return here + If ( nError <> gCodeBlock.ERROR_NONE) Then + sDetail = sDetail & " " + SetError( nError, sDetail ) + Return ( nError ) + End If + + Next + + ' RegEx should create six groups + If ( nGroupCount = 6 ) Then + + ' Store parameter expression + If ( matchParts.Group( GROUP_PARAM_EXPR ) <> Null ) Then + gParamExpr = matchParts.Group( GROUP_PARAM_EXPR ) ' a,b,c + End If + + ' Store main expression + gEvalExpr = matchParts.Group( GROUP_EVAL_EXPR ) ' 1 * a + c * 5 + + ' And it's not zero length + If ( gEvalExpr.Length <> 0 ) Then + Return ( gCodeBlock.ERROR_NONE ) + End If + + End If + + ' Set syntax error + nError = gCodeBlock.ERROR_SYNTAX + sDetail = sDetail & " " + + Return ( SetError( nError, sDetail ) ) + +End Sub + +#end if + +'*----------------------------------------------------------------- Tokenize +'* +Private Sub Tokenize( sExpr As String ) As List + Private lstTokens As List + Private matchExpr As Matcher + + lstTokens.Initialize + + matchExpr = Regex.Matcher(TOKENIZER_MATCH, sExpr) + + ' Extract tokens + Do While ( matchExpr.Find = True ) + lstTokens.Add( matchExpr.Match ) + Loop + + ' Reset navigation + gTokenIndex = -1 + gTokenEndIndex = lstTokens.Size - 1 + + Return ( lstTokens ) + +End Sub + + +'*----------------------------------------------------------------- GetToken +'* +Private Sub GetToken As Int + Private sMatch As String + ' Private sLeadChar As String + + ' Init token + gToken.nType = TOKEN_TYPE_NONE + gToken.sText = NULL_TOKEN + + 'Advanced index + gTokenIndex = gTokenIndex + 1 + + 'If index is past the end, no more tokens + If ( gTokenIndex > gTokenEndIndex ) Then + gToken.nType = TOKEN_TYPE_FINISHED + Return (gToken.nType) + End If + + ' Get token + sMatch = gTokenList.Get( gTokenIndex ) + + 'Mtelog.Dbg( "sMatch=" & sMatch ) + 'Log( "sMatch=" & sMatch ) + + ' Relational operators? + If ( Regex.IsMatch("<=|>=|==|<|>|!=|\|\||&&", sMatch) = True ) Then + + gToken.sText = sMatch + gToken.nType = TOKEN_TYPE_DELIMITER + Return ( gToken.nType ) + + End If + + ' General Delimeter? Note: equals removed + If ( Regex.IsMatch("[+\-*^/%(),!|]", sMatch) = True ) Then + + gToken.sText = sMatch + gToken.nType = TOKEN_TYPE_DELIMITER + Return ( gToken.nType ) + + End If + + ' Number? + If ( IsNumber( sMatch ) = True ) Then + + gToken.sText = sMatch + gToken.nType = TOKEN_TYPE_NUMBER + Return ( gToken.nType ) + + End If + + ' Is it a word? + If ( Regex.IsMatch( "\w+", sMatch ) = True ) Then + + gToken.sText = sMatch + gToken.nType = TOKEN_TYPE_IDENTIFIER + + ' Unknown + Else + + SyntaxError( gCodeBlock.ERROR_OTHER ) + + gToken.sText = sMatch + gToken.nType = TOKEN_TYPE_UNKNOWN + + End If + + Return ( gToken.nType ) + +End Sub + +'*------------------------------------------------------------ EvalExpression +'* +Private Sub EvalExpression As Boolean + Private bSuccess As Boolean + + ' Get this party started! + GetToken + + ' Evaluate assignment + bSuccess = EvalAssignment + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Return token to the input stream. This is needed due to "look ahead" + ' nature of the parser. + bSuccess = PutBack + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + + Return ( SUCCESS ) +End Sub + +'*------------------------------------------------------------- EvalAssignment +'* +Private Sub EvalAssignment As Boolean + Private bSuccess As Boolean + + ' Future assignment support goes here + + ' Next precedence + bSuccess = EvalLogicalOr + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + Return ( SUCCESS ) + +End Sub + +'*-------------------------------------------------------------- EvalLogicalOr +'* +Private Sub EvalLogicalOr As Boolean + Private sOperator As String + Private nDropOut As Int + Private bSuccess As Boolean + + ' Next precedence + bSuccess = EvalLogicalAnd + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Save operator on local stack + sOperator = gToken.sText + + ' Process Or + Do While ( sOperator = "||" ) + + ' Gen label for dropout + nDropOut = NewLabel + + ' If true skip right operand + BranchTrue( nDropOut ) + + ' Push, get, and do next level + Push + GetToken + bSuccess = EvalLogicalAnd + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Gen code + DoLogicalOr + + ' Post dropout label + PostLabel( nDropOut ) + + ' Update operator + sOperator = gToken.sText + + Loop + + Return ( SUCCESS ) + +End Sub + +'*------------------------------------------------------------- EvalLogicalAnd +'* +Private Sub EvalLogicalAnd As Boolean + Private sOperator As String + Private nDropOut As Int + Private bSuccess As Boolean + + ' Next higher precedence + bSuccess = EvalRelational + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Save operator on local stack + sOperator = gToken.sText + + ' Process And + Do While ( sOperator = "&&" ) + + ' Gen label for dropout + nDropOut = NewLabel + + ' If false skip right operand + BranchFalse( nDropOut ) + + ' Push, get, do next level + Push + GetToken + + bSuccess = EvalRelational + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Gen code + DoLogicalAnd + + ' Post dropout label + PostLabel( nDropOut ) + + ' Update operator + sOperator = gToken.sText + + Loop + + Return ( SUCCESS ) + +End Sub + +'*------------------------------------------------------------- EvalRelational +'* +Private Sub EvalRelational As Boolean + Private sOperator As String + Private bSuccess As Boolean + + ' Next higher rprecedence + bSuccess = EvalAddSub + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Save operator on local stack + sOperator = gToken.sText + + ' Relational operator? + If ( Regex.IsMatch("<=|>=|==|<|>|!=|\|\||&&", sOperator ) = True ) Then + + 'Push, get, and do next level + Push + GetToken + + bSuccess = EvalAddSub + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + 'Which one? + Select ( sOperator ) + Case "<" ' LT + DoLess + Case "<=" ' LE + DoLessEqual + Case ">" ' GT + DoGreater + Case ">=" ' GE + DoGreaterEqual + Case "==" ' EQ + DoEqual + Case "!=" ' NE + DoNotEqual + End Select + + End If + + Return ( SUCCESS ) + +End Sub + +'*----------------------------------------------------------------- EvalAddSub +'* +Private Sub EvalAddSub As Boolean + Private sOperator As String + Private bSuccess As Boolean + + ' Next higher precedence + bSuccess = EvalFactor + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Store operator on local stack + sOperator = gToken.sText + + ' While add or subtract + Do While ( Regex.IsMatch("[+\-]", sOperator ) = True ) + + ' Push on stack and continue + Push + GetToken + + bSuccess = EvalFactor + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Generate code + Select sOperator + Case "-" + DoSubtract + Case "+" + DoAdd + End Select + + ' Update operator as token may have changed + sOperator = gToken.sText + + Loop + + Return ( SUCCESS ) + +End Sub + +'*----------------------------------------------------------------- EvalFactor +'* +Private Sub EvalFactor As Boolean + Private sOperator As String + Private bSuccess As Boolean + + ' Next higher precedence + bSuccess = EvalUnary + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Store operator on local stack + sOperator = gToken.sText + + 'While multiply, divide, or modulous + Do While ( Regex.IsMatch("[\*/%]", sOperator ) = True ) + + ' Push value on stack and continue + Push + GetToken + bSuccess = EvalUnary + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Generate code + Select sOperator + Case "*" + DoMultiply + Case "/" + DoDivide + Case "%" + DoModulo + End Select + + ' Update operator as token may have changed + sOperator = gToken.sText + + Loop + + Return ( SUCCESS ) + +End Sub + +'*------------------------------------------------------------------ EvalUnary +'* +Private Sub EvalUnary As Boolean + Private sOperator As String + Private bSuccess As Boolean + + ' Set operator to null + sOperator = "" + + ' Is this a unary operator? + If ( Regex.IsMatch( "[+\-!]", gToken.sText ) = True ) Then + + ' Save operator on local stack and continue + sOperator = gToken.sText + GetToken + bSuccess = EvalUnary + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + Else + + ' Next higher precedence + bSuccess = EvalParen + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + End If + + ' Which one? + Select sOperator + Case "-" + DoNegate + Case "!" + DoLogicalNot + End Select + + Return ( SUCCESS ) + +End Sub + +'*------------------------------------------------------------------ EvalParen +'* +Private Sub EvalParen() As Boolean + Private bSuccess As Boolean + + ' Is this an open parenthesis? + If ( gToken.sText = "(" ) Then + + ' Count open/close parenthesis + gParenCount = gParenCount + 1 + + 'Mtelog.Dbg( "( Open paren" ) + + ' Get token + GetToken + + ' Eval sub expression + bSuccess = EvalAssignment + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Expecting a closed parenthesis here + If ( gToken.sText <> ")" ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_PAREN ) + Return ( ABORT ) + End If + + ' Reduce count + gParenCount = gParenCount - 1 + + 'Mtelog.Dbg( ") Closed paren" ) + + ' Get next token + GetToken + + Else + + ' Next higher precedence + bSuccess = EvalAtom + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + End If + + Return ( SUCCESS ) + +End Sub + +'*------------------------------------------------------------------- EvalAtom +'* +Private Sub EvalAtom As Boolean + Private nParameterIndex As Int + Private bSuccess As Boolean + + Select ( gToken.nType ) + Case TOKEN_TYPE_IDENTIFIER + + 'Find internal function + gFuncInfo = FindInternalFunc( gToken.sText ) + + ' If function found + If ( gFuncInfo.nPcode > 0 ) Then + + ' IIF is special + If ( gFuncInfo.nPcode = PCODE.FUNC_IIF ) Then + + bSuccess = DoIIF + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Call built-in function + Else + + 'Ouput instruction to call function + bSuccess = DoCallInternalFunc( gFuncInfo ) + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + End If + + ' Either built-in constant or parameter + Else + + Select ( gToken.sText ) + Case "ce" + DoLoadNumber( cE ) + Case "cpi" + DoLoadNumber( cPI ) + Case Else + nParameterIndex = FindParameter( gToken.sText ) + If ( nParameterIndex >= 0 ) Then + DoLoadVariable( nParameterIndex ) + Else + SyntaxError( gCodeBlock.ERROR_NOT_A_VAR ) + Return ( ABORT ) + End If + End Select + + End If + + ' Get next token + GetToken + + Case TOKEN_TYPE_NUMBER + + 'Convert string to value + Private nValue As Double = gToken.sText + + ' Output instruction to load number + DoLoadNumber( nValue ) + + ' Get next token + GetToken + + Case TOKEN_TYPE_DELIMITER + + If ( gToken.sText = ")" And gParenCount = 0 ) Then + SyntaxError( gCodeBlock.ERROR_UNBALANCED_PARENS ) + Return ( ABORT ) + End If + + Return ( SUCCESS ) + + Case TOKEN_TYPE_FINISHED + + Return ( SUCCESS ) + + Case Else + + ' Syntax error + SyntaxError( gCodeBlock.ERROR_OTHER ) + Return ( ABORT ) + + End Select + + Return ( SUCCESS ) + +End Sub + + +'*--------------------------------------------------------------------- GetArgs +'* +Private Sub GetArgs( nExpectedArgs As Int ) As Boolean + Private bFinished As Boolean + Private nArgCount=0 As Int + Private bSuccess As Boolean + + ' Get next token + GetToken + + ' If not a parenthesis + If ( gToken.sText <> "(" ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_PAREN ) + Return ( ABORT ) + End If + + ' Get next token + GetToken + + ' If closing paren, no args. + If ( gToken.sText = ")" ) Then + Return ( SUCCESS ) + End If + + ' Return token to stream + PutBack + + bFinished = False + Do Until ( bFinished ) + + ' Parse arguments + bSuccess = EvalExpression + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Count args. Too many? + nArgCount = nArgCount + 1 + If ( nArgCount > nExpectedArgs ) Then + SyntaxError( gCodeBlock.ERROR_TOO_MANY_ARGS ) + Return ( ABORT ) + End If + + ' Push value on stack and get next token + Push + GetToken + + ' If no comma, we've consumed all the arguments + If ( gToken.sText <> "," ) Then + bFinished = True + End If + + Loop + + ' Short arguments? + If ( nArgCount < nExpectedArgs ) Then + SyntaxError( gCodeBlock.ERROR_INSUFFICIENT_ARGS) + Return ( ABORT ) + End If + + ' Should be closing paren here + If ( gToken.sText <> ")" ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_PAREN ) + Return ( ABORT ) + End If + + Return ( SUCCESS ) + +End Sub + +'*--------------------------------------------------------------------- PutBack +'* +Private Sub PutBack As Boolean + + ' Safety check to prevent parser from hanging on bug + If ( gPutBackIndex = gTokenIndex ) Then + gPutBackCount = gPutBackCount + 1 + If ( gPutBackCount > 5 ) Then + SyntaxError( gCodeBlock.ERROR_PUTBACK ) + Return ( ABORT ) + End If + Else + gPutBackIndex = gTokenIndex + gPutBackCount = 0 + End If + + ' Decrement token index + gTokenIndex = gTokenIndex - 1 + + Return ( SUCCESS ) + +End Sub + + +'*----------------------------------------------------------------------- Push +'* +Private Sub Push + + DoPush + +End Sub + +'*************************************************************************** +'* +'* Code Generator +'* +'*************************************************************************** + +'*------------------------------------------------------------- EmitCodeHeader +'* +Private Sub EmitCodeHeader( nParamCount As Int ) + + gBytecode.Add( nParamCount ) + gCodeIndex = gCodeIndex + 1 + +End Sub + +'*-------------------------------------------------------------- EmitShortCode +'* +Private Sub EmitShortCode( nPcode As Int ) + + ' Add instruction + gBytecode.Add( nPcode ) + gCodeIndex = gCodeIndex + 1 + +End Sub + +'*--------------------------------------------------------------- EmitLongCode +'* +Private Sub EmitLongCode( nPcode As Int, nValue As Double ) + + ' Add Pcode + gBytecode.Add( nPcode ) + gCodeIndex = gCodeIndex + 1 + + ' Add value inline + gBytecode.Add( nValue ) + gCodeIndex = gCodeIndex + 1 + +End Sub + +'*--------------------------------------------------------- DoCallInternalFunc +'* +Private Sub DoCallInternalFunc( tFuncInfo As FUNC_INFO ) As Boolean + Private bSuccess As Boolean + + 'Mtelog.Dbg( "DoInternalFunc") + + ' Get arguments and push on stack + bSuccess = GetArgs( tFuncInfo.nArgCount ) + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Call func + EmitShortCode( tFuncInfo.nPcode ) + + Return ( SUCCESS ) + +End Sub + +'*---------------------------------------------------------------------- DoIFF +'* +'* After GetToken returns the TokenIndex is here +'* ---------------------------------------------- +'* 1. IIF( ..., ..., ...) +'* ^ +'* 2. IIF( ..., ..., ...) +'* ^ +'* 3. IIF( ..., ..., ...) +'* ^ +'* 4. IIF( ..., ..., ...) +'* ^ +'* +Private Sub DoIIF As Boolean + Private nIfFalse As Int + Private nEndofIf As Int + Private bSuccess As Boolean + + 'Mtelog.Dbg( "DoIIF") + + ' 1. Get next token + GetToken + + ' If not a parenthesis + If ( gToken.sText <> "(" ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_PAREN ) + Return ( ABORT ) + End If + + ' Eval conditional expression + bSuccess = EvalExpression + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Get labels + nIfFalse = NewLabel : nEndofIf = nIfFalse + + ' 2. Get next token + GetToken + + ' Expect a comma here + If ( gToken.sText <> "," ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_COMMA ) + Return ( ABORT ) + End If + + ' Set false branch + BranchFalse(nIfFalse) + + ' Get Then condition + bSuccess = EvalExpression + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Push value + Push + + ' 3. Get next token + GetToken + + ' Expect a comma here + If ( gToken.sText <> "," ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_COMMA ) + Return ( ABORT ) + End If + + ' Post label for "Else" + nEndofIf = NewLabel + Branch( nEndofIf ) + PostLabel( nIfFalse ) + + ' Compile Else condition + bSuccess = EvalExpression + If ( bSuccess = ABORT ) Then Return ( ABORT ) + + ' Push value on stack + Push + + ' 4. Get Next token + GetToken + + ' Should be closing paren + If ( gToken.sText <> ")" ) Then + SyntaxError( gCodeBlock.ERROR_MISSING_PAREN ) + Return ( ABORT ) + End If + + ' End of IIF + PostLabel( nEndofIf ) + + Return ( SUCCESS ) + +End Sub + + +'*---------------------------------------------------=--------- DoLoadNumber +'* + Sub DoLoadNumber( nValue As Double ) + + 'Mtelog.Dbg( "DoLoadNumber(), nValue=" & nValue ) + EmitLongCode( PCODE.LOADCONST, nValue ) + +End Sub + +'*----------------------------------------------------------- DoLoadVariable +'* +Private Sub DoLoadVariable( nIndex As Int ) + + 'Mtelog.Dbg( "DoLoadVariable") + EmitLongCode( PCODE.LOADVAR, nIndex ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoMultiply + + 'Mtelog.Dbg( "DoMultiply" ) + EmitShortCode( PCODE.MULTIPLY ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoDivide + + 'Mtelog.Dbg( "DoDivide" ) + EmitShortCode( PCODE.DIVIDE ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoModulo + + 'Mtelog.Dbg( "DoModulo" ) + EmitShortCode( PCODE.MODULO ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoNegate + + 'Mtelog.Dbg( "DoNegate" ) + EmitShortCode( PCODE.NEG ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoLogicalNot + + 'Mtelog.Dbg( "DoLogicalNot" ) + EmitShortCode( PCODE.LOGICAL_NOT ) + +End Sub + + +'*-------------------------------------------------------------------------- +'* +Private Sub DoSubtract + + 'Mtelog.Dbg( "DoSubtract") + EmitShortCode( PCODE.SUBTRACT ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoAdd + + 'Mtelog.Dbg( "DoAdd") + EmitShortCode( PCODE.ADD ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoLess + + 'Mtelog.Dbg( "DoLess") + EmitShortCode( PCODE.LESS_THAN ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoLessEqual + + 'Mtelog.Dbg( "DoLessEqual") + EmitShortCode( PCODE.LESS_EQUAL ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoGreater + + 'Mtelog.Dbg( "DoGreater") + EmitShortCode( PCODE.GREATER_THAN ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoGreaterEqual + + 'Mtelog.Dbg( "DoGreaterEqual") + EmitShortCode( PCODE.GREATER_EQUAL ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoEqual + + 'Mtelog.Dbg( "DoEqual") + EmitShortCode( PCODE.EQUAL ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoNotEqual + + 'Mtelog.Dbg( "DoNotEqual") + EmitShortCode( PCODE.NOT_EQUAL ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoPush + + 'Mtelog.Dbg("DoPush") + EmitShortCode( PCODE.PUSH ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoEndCode + + 'Mtelog.Dbg("DoEndCode") + EmitShortCode( PCODE.ENDCODE ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub NewLabel As Int + Private nNextLabelIndex As Int + nNextLabelIndex = gLabelIndex + gLabelIndex = gLabelIndex + 1 + Return ( nNextLabelIndex ) +End Sub + + +'*-------------------------------------------------------------------------- +'* +Private Sub AddJump ( nTargetIndex As Int ) + + ' Save the location of the jump instruction in the code + gJumpTable( gJumpCount ).nCodeIndex = gCodeIndex + + ' Label will have the codeindex where we should jump to + gJumpTable( gJumpCount ).nLabelIndex = nTargetIndex + + ' Bump count + gJumpCount = gJumpCount + 1 + +End Sub + +'*--------------------------------------------------------------- FixupJumps +'* +Private Sub FixupJumps + Private i As Int + Private nCodeIndex As Int + Private nJumpToIndex As Int + Private nJumpOffset As Int + Private nLastJump As Int + + ' Any jumps to fixup? + If ( gJumpCount > 0 ) Then + + ' Fix jumps + nLastJump = gJumpCount - 1 + For i = 0 To nLastJump + + ' This is the location of the jump Pcode + nCodeIndex = gJumpTable(i).nCodeIndex + + ' This is the index where we want to jump to + nJumpToIndex = gLabelTargets( gJumpTable(i).nLabelIndex ) + + ' Calculate the offset + nJumpOffset = (nJumpToIndex - nCodeIndex) - 1 + + ' Replace inline value with the correct offset + gBytecode.Set( nCodeIndex + 1, nJumpOffset) + + Next + + End If + + ' Reset jumps and label counts + gJumpCount = 0 + gLabelIndex = 0 + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub PostLabel( nLabelIndex As Int ) + + ' This is the location (codeindex) where this label should jump to + gLabelTargets( nLabelIndex ) = gCodeIndex + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub Branch( nLabelIndex As Int ) + + 'Mtelog.Dbg("Branch") + + ' Add to jump table + AddJump( nLabelIndex ) + + ' Add jump to code + EmitLongCode( PCODE.JUMP_ALWAYS, 0 ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub BranchFalse( nLabelIndex As Int ) + + 'Mtelog.Dbg("BranchFalse") + + ' Add to jump table + AddJump( nLabelIndex ) + + ' Add jump to code + EmitLongCode( PCODE.JUMP_FALSE, 0 ) + +End Sub + + +'*-------------------------------------------------------------------------- +'* +Private Sub BranchTrue( nLabelIndex As Int ) + + 'Mtelog.Dbg("BranchTrue") + + ' Add to jump table + AddJump( nLabelIndex ) + + ' Add jump to code + EmitLongCode( PCODE.JUMP_TRUE, 0 ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoLogicalOr + + 'Mtelog.Dbg( "DoLogicalOr" ) + EmitShortCode( PCODE.LOGICAL_OR ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +Private Sub DoLogicalAnd + + 'Mtelog.Dbg( "DoLogicalAnd" ) + EmitShortCode( PCODE.LOGICAL_AND ) + +End Sub + +'*--------------------------------------------------------- FindInternalFunc +'* +Private Sub FindInternalFunc( sName As String ) As FUNC_INFO + Private tFuncInfo As FUNC_INFO + + tFuncInfo.Initialize + + Select ( sName ) + Case "abs" + tFuncInfo.nPcode = PCODE.FUNC_ABS + tFuncInfo.nArgCount = 1 + Case "iif", "if" + tFuncInfo.nPcode = PCODE.FUNC_IIF + tFuncInfo.nArgCount = 3 + Case "max" + tFuncInfo.nPcode = PCODE.FUNC_MAX + tFuncInfo.nArgCount = 2 + Case "min" + tFuncInfo.nPcode = PCODE.FUNC_MIN + tFuncInfo.nArgCount = 2 + Case "sqrt" + tFuncInfo.nPcode = PCODE.FUNC_SQRT + tFuncInfo.nArgCount = 1 + Case Else + tFuncInfo.nPcode = -1 + tFuncInfo.nArgCount = 0 + End Select + + Return ( tFuncInfo ) + +End Sub + +'*------------------------------------------------------------ FindParameter +'* +Private Sub FindParameter( sName As String ) As Int + Private nIndex As Int + Private nLastParam As Int + + ' No parameters? + If ( gParameterCount = 0 ) Then + Return ( -1 ) + End If + + ' Find parameter in table + nLastParam = gParameterCount - 1 + For nIndex = 0 To nLastParam + If ( gParameters( nIndex ) = sName ) Then + Return ( nIndex ) + End If + Next + + Return ( -1 ) +End Sub + + +'*************************************************************************** +'* +'* Error +'* +'*************************************************************************** + +'*---------------------------------------------------------------- SetError +'* +Private Sub SetError( nError As Int, sDetail As String ) As Int + Private sDesc As String + + ' Get error description + Select( nError ) + Case gCodeBlock.ERROR_MISSING_BRACKET + sDesc = "{ } bracket not found." + Case gCodeBlock.ERROR_MISSING_PIPE + sDesc = "| | pipe not found." + Case gCodeBlock.ERROR_MISSING_PAREN + sDesc = "Missing parenthesis." + Case gCodeBlock.ERROR_MISSING_PARAM + sDesc = "Missing parameter." + Case gCodeBlock.ERROR_MISSING_EXPR + sDesc = "Missing expression." + Case gCodeBlock.ERROR_RESERVED_WORD + sDesc = "Reserved word." + Case gCodeBlock.ERROR_MISSING_COMMA + sDesc = "Missing comma." + Case gCodeBlock.ERROR_MISSING_ARG + sDesc = "Missing argument." + Case gCodeBlock.ERROR_TOO_MANY_ARGS + sDesc = "Too many arguments" + Case gCodeBlock.ERROR_INSUFFICIENT_ARGS + sDesc = "Insufficient arguments" + Case gCodeBlock.ERROR_NOT_A_VAR + sDesc = "Unknown parameter." + Case gCodeBlock.ERROR_UNBALANCED_PARENS + sDesc = "Unbalanced parens." + Case gCodeBlock.ERROR_PUTBACK + sDesc = "Internal parser error." + Case Else + sDesc = "Syntax error." + End Select + + ' Store error + gCodeBlock.Error = nError + gCodeBlock.ErrorDesc = sDesc + gCodeBlock.ErrorDetail = sDetail + + ''Mtelog.Console( "Error: nError=" & nError & " - " & sDesc ) + ''Mtelog.Console( "Error: " & sDetail ) + + Return ( nError ) +End Sub + +'*---------------------------------------------------------------- SetError2 +'* +Private Sub SetError2( nError As Int ) As Int + Private sDetail As String + + ' Build detail string from tokens + sDetail = BuildErrorDetail( nError ) + + ' Set error in Codeblock + SetError( nError, sDetail ) + + Return ( nError ) +End Sub + +'*--------------------------------------------------------- BuildErrorDetail +'* +Private Sub BuildErrorDetail( nError As Int ) As String + Private i As Int + Private k As Int + Private sb As StringBuilder + + If ( gTokenIndex < 0 ) Then + Return ( "" ) + End If + + If ( gTokenList.Size = 0 ) Then + Return ( "" ) + End If + + ' Build description from tokens + sb.Initialize + k = Min( gTokenIndex, gTokenEndIndex ) + For i = 0 To k + sb.Append( gTokenList.Get( i ) ) + Next + + ' Add error code + sb.Append( " " ) + + Return ( sb.ToString ) + +End Sub + +'*------------------------------------------------------------- Syntax Error +'* +Private Sub SyntaxError( nError As Int ) + + ' Set error in codeblock with detail + SetError2( nError ) + + +End Sub + diff --git a/Java/LICENSE.txt b/Java/LICENSE.txt new file mode 100644 index 0000000..ee820da --- /dev/null +++ b/Java/LICENSE.txt @@ -0,0 +1,30 @@ +'********************************************************************************** +'* +'* Copyright (c) 2016, MacThomas Engineering +'* All rights reserved. +'* +'* Redistribution and use in source and binary forms, with or without +'* modification, are permitted provided that the following conditions are met: +'* +'* 1. Redistributions of source code must retain the above copyright notice, this +'* list of conditions, and the following disclaimer. +'* +'* 2. Redistributions in binary form must reproduce the above copyright notice, +'* this list of conditions and the following disclaimer in the documentation +'* and/or other materials provided with the distribution. +'* +'* 3. MacThomas Engineering may not be used to endorse or promote products derived +'* from this software without specific prior written permission. +'* +'* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +'* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +'* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +'* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +'* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +'* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +'* LOSS OF USE, DATA, Or PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED And +'* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +'* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +'* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +'* +'********************************************************************************** \ No newline at end of file diff --git a/Java/MtelBuildLib.b4j b/Java/MtelBuildLib.b4j new file mode 100644 index 0000000..445e956 --- /dev/null +++ b/Java/MtelBuildLib.b4j @@ -0,0 +1,109 @@ +Version=4.2 +AppType=StandardJava +NumberOfModules=5 +Module1=Codeblock +Module2=Codegen +Module3=Mtelog +Module4=PCODE +Module5=Run +Build1=Default,b4j.example +NumberOfFiles=0 +NumberOfLibraries=2 +Library1=jcore +Library2=javaobject +@EndOfDesignText@ +'Non-UI application (console / server application) +#Region Project Attributes + #CommandLineArgs: + #MergeLibraries: True + + #LibraryVersion: 1.01 + #LibraryName: MteEval + #LibraryAuthor: MacThomas Engineering + +#End Region + +Sub Process_Globals + +End Sub + +Sub AppStart (Args() As String) + + RunTests + +End Sub + + +'*-------------------------------------------------------------------------- +'* +'* RunTests - Run test cases +'* +'* +Private Sub RunTests + + + DoTest( 1, "Add and Subtract", "{||5+6-3}", Array () ) + DoTest( 2, "Divide By Zero", "{||5+6/0}", Array () ) + DoTest( 3, "Cirumference of circle, radius=5", "{|r|2*CPi*r}", Array (5) ) + DoTest( 4, "Area of circle, radius=5", "{|r|CPi*(r*r)}", Array (5) ) + DoTest( 5, "Missing parenthesis", "{||35*3+6)}", Array (5) ) + DoTest( 6, "Min with iif()", "{|a,b| iif( a > b, b, a) }", Array (5,10) ) + DoTest( 7, "Find length of diagonal", "{|a,b| sqrt(a*a+b*b)}", Array (7,9) ) + DoTest( 8, "Report e", "{|| ce }", Array() ) + DoTest( 9, "Kitchen Sink", "{|a,b,c,d,e,f|-abs(iif(a+c*f <= e/d*a, iif( min(a,d) >= max(c,e), b*b, c*c ), iif( 5 == c || 5 == e || 77 > 22 && !(10 < 3), Sqrt(c), Sqrt(d))))}", Array ( 34, 43, 17, 25,45, 13) ) + + Mtelog.Stop + + End Sub + + '*-------------------------------------------------------------------------- +'* +'* DoTest - Compile and run test case +'* +'* + Private Sub DoTest ( nTestNumber As Int, sDescription As String, sCodeblockText As String, aArgs() As Object ) + Private cb As Codeblock + Private nResult As Double + + + Log( "*********************************") + Log( nTestNumber & " - " & sDescription ) + Log( "Codeblock=" & sCodeblockText ) + + cb.Initialize + cb.Compile( sCodeblockText ) + If ( cb.Error <> cb.ERROR_NONE ) Then + Log( "Compile error=" & cb.Error ) + Log( "Error Description: " & cb.ErrorDesc) + Log( "Error Detail: " & cb.ErrorDetail ) + Return + End If + Log( "Codeblock compiled.") + + If ( aArgs.Length = 0 ) Then + nResult = cb.Eval + Else + nResult = cb.Eval2( aArgs ) + End If + + Log( "Codeblock executed.") + Log( "Result=" & nResult ) + + If ( cb.Error <> cb.ERROR_NONE ) Then + Log( "Eval error=" & cb.Error ) + Log( "Error Description: " & cb.ErrorDesc) + Log( "Error Detail: " & cb.ErrorDetail ) + End If + + 'Uncomment To Decompile + Private CodeListing As List + CodeListing = cb.Decompile + Log( "------------------------") + For Each sLine As String In CodeListing + Log( sLine ) + Next + Log( "------------------------") + + Return + +End Sub diff --git a/Java/Mtelog.bas b/Java/Mtelog.bas new file mode 100644 index 0000000..4767b12 --- /dev/null +++ b/Java/Mtelog.bas @@ -0,0 +1,479 @@ +Type=StaticCode +Version=4.2 +ModulesStructureVersion=1 +B4J=true +@EndOfDesignText@ +#ExcludeFromLibrary: True + +'*************************************************************************** +'* +'* Mtelog.bas - Application logger by MacThomas Engineering +'* +'* Notes: +'* ------ +'* 1. Log written to: +'( +'* B4J: C:\Users\\AppData\Roaming\ +'* B4A: Files.DirInternal +'* B4I: ToDo +'* +'* 2. Default log name: MTELOG.TXT +'* +'* 3. Default max log size: 100K +'* +'* 4. In release builds LogDbf() method will not output to log. +'* This setting can be overridden with LogDbgOn( True ) + +'* +'*************************************************************************** + +#Region BSD License +'********************************************************************************** +'* +'* Copyright (c) 2016, MacThomas Engineering +'* All rights reserved. +'* +'* You may use this file under the terms of the BSD license as follows: +'* +'* Redistribution and use in source and binary forms, with or without +'* modification, are permitted provided that the following conditions are met: +'* +'* 1. Redistributions of source code must retain the above copyright notice, this +'* list of conditions, and the following disclaimer. +'* +'* 2. Redistributions in binary form must reproduce the above copyright notice, +'* this list of conditions and the following disclaimer in the documentation +'* and/or other materials provided with the distribution. +'* +'* 3. MacThomas Engineering may not be used to endorse or promote products derived +'* from this software without specific prior written permission. +'* +'* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +'* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +'* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +'* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +'* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +'* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +'* LOSS OF USE, DATA, Or PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED And +'* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +'* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +'* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +'* +'********************************************************************************** +#End Region + +#Region Revision History +'********************************************************************************** +'* MTE Logger Revision History: +'* +'* No. Who Date Description +'* ===== === ========== ====================================================== +'* 1.0.0 MTE 2016/08/05 - Begin here! +'* +'* +'********************************************************************************** +#End Region + +Sub Process_Globals + + ' Configurables + Private sLogFileName="mtelog.txt" As String ' Default log name + Private nLogMaxSize=1024*1024 As Int ' 100K + #if RELEASE + Private bDebugTypeEnabled = False As Boolean + #else + Private bDebugTypeEnabled = True As Boolean + #End if + + ' Private + Private bLogEnabled = False As Boolean + Private sLogDirectory As String + Private twrLogger As TextWriter + Private ostLogger As OutputStream + Private bLogEnabled = False As Boolean + Private nLogSize=0 As Int + Private NativeMe As JavaObject + + 'Constants + Private Const FILE_APPEND=True As Boolean 'ignore + Private CONST FILE_TRUNCATE=False As Boolean 'ignore + + ' Mte logger version + Public Const VersionText="1.0.0" As String + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* Start - Start logger +'* +'* +Public Sub Start As Boolean + Private bSuccess As Boolean + + ' Set date time format + SetDateFormat( "yyMMdd-HHmmss" ) + + ' Initialize data directory + SetLogDirectory + + ' Open log file + bSuccess = OpenLog + If ( bSuccess = True ) Then + bLogEnabled = True + Else + bLogEnabled = False + End If + + Return ( bLogEnabled ) + +End Sub + + +'*-------------------------------------------------------------------------- +'* +'* Stop - Stop logger +'* +'* +Public Sub Stop + + If ( bLogEnabled = True ) Then + + ' Disable + bLogEnabled = False + + ' Close writer + twrLogger.Close + + ' Close stream + ostLogger.Close + + End If + +End Sub + + +'*-------------------------------------------------------------------------- +'* +'* Inf - Log Info entry +'* +'* +Public Sub Inf( sText As String ) + + ' Log enabled? + If ( bLogEnabled = False ) Then Return + + WriteLogEntry( "i", sText ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* Console - Log Info to file and console +'* +'* +Public Sub Console( sText As String ) + + ' Log enabled? + If ( bLogEnabled = False ) Then Return + + WriteLogEntry( "i", sText ) + Log( sText ) + +End Sub + + +'*-------------------------------------------------------------------------- +'* +'* Dbg - Log debug entry +'* +'* +Public Sub Dbg( sText As String ) + + ' Log enabled? + If ( bDebugTypeEnabled = False Or bLogEnabled = False ) Then Return + + WriteLogEntry( "d", sText ) + Log( sText ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* Err - Log error +'* +'* +Public Sub Err( sText As String ) + + ' Log enabled? + If ( bLogEnabled = False ) Then Return + + WriteLogEntry( "e", sText ) + Log( sText ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* DbgOn - Enable debug logging in RELEASE builds. Or disable in DEBUG +'* +'* By default debug log entries are discarded in RELEASE mode. +'* This allows flag to be overriden. +'* +'* +Public Sub DbgOn( bEnable As Boolean ) + + bDebugTypeEnabled = bEnable + +End Sub + + +'*-------------------------------------------------------------------------- +'* +'* SetFileName - Set log file name +'* +'* +Public Sub SetFileName( sFileName As String ) + + sLogFileName = sFileName + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* SetMaxSize - Set max log file size +'* +'* +Public Sub SetMaxSize( nMaxSize As Int ) As Int + Private Const MIN_LOG_SIZE=1024 * 10 As Int + Private nOldMaxSize As Int + + ' Save old value before change + nOldMaxSize = nLogMaxSize + + ' Greater then 10k ? + If ( nMaxSize > MIN_LOG_SIZE ) Then + nLogMaxSize = nMaxSize + End If + + Return ( nOldMaxSize ) + +End Sub + + +'*-------------------------------------------------------------------------- +'* +'* SetDateFormat - Set date format that prefixes log entries +'* +'* +Private Sub SetDateFormat( sDateFormat As String ) + + If ( NativeMe.IsInitialized = False ) Then + #if B4J + NativeMe = Me + #else + #if B4A + NativeMe.InitializeStatic(Application.PackageName & ".mte") + #else + NativeMe = Platform not supported + #end if + #end if + End If + + ' Set date time format + NativeMe.RunMethod("mteSetDateTimeFormat", Array( sDateFormat ) ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* SetLogDirectory - Build path to log directory +'* +'* +Private Sub SetLogDirectory + +#if B4J + + Private jo As JavaObject + Private sAppName As String + Private search As Matcher + + ' Init javaobject + jo.InitializeStatic("anywheresoftware.b4a.BA") + + ' Extract last section of package name. This is our app name + search = Regex.Matcher("\w+$", jo.GetField("packageName") ) + search.Find + sAppName = search.Match + + ' Build path to log directory (e.g. C:\Users\Stan\AppData\Roaming\ ) + sLogDirectory = File.DirData( sAppName ) + +#else + + #if B4A + + ' Default to internal directory + sLogDirectory = File.DirInternal + + #else + + ' Force compiler to generate an error + sLogDirectory = Platform Not Supported + + #end if + +#end if + + + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* OpenLog - Open the log file +'* +'* +Private Sub OpenLog As Boolean + Private bAppendFlag As Boolean + Private bSuccess=True As Boolean + + ' Get size of existing log. Will return zero if file doesn't exist + nLogSize = File.Size( sLogDirectory, sLogFileName ) + + ' If over max log size set flag to truncate + If ( nLogSize > nLogMaxSize ) Then + bAppendFlag = FILE_TRUNCATE + nLogSize = 0 + Else + bAppendFlag = FILE_APPEND + End If + + Try + ' Open file + ostLogger = File.OpenOutput( sLogDirectory, sLogFileName, bAppendFlag ) + + ' Connect stream to text writer + twrLogger.Initialize(ostLogger ) + + 'twrLogger.Initialize2(ostLogger, "ISO-8859-1") + + Catch + ' Set flag on error + bSuccess = False + End Try + + Return ( bSuccess ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* CloseLog - Close log file +'* +'* +Private Sub CloseLog + + ' Close writer + twrLogger.Close + + ' Close stream + ostLogger.Close + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* ResetLog - Close and re-open the log +'* +'* +Private Sub ResetLog As Boolean + Private bSuccess As Boolean + + ' Close log + CloseLog + + ' Re-open the log + bSuccess = OpenLog + + ' Log back in service? + If ( bSuccess = True ) Then + bLogEnabled = True + Inf( "<-- Reset Log --") + Else + bLogEnabled = False + End If + + Return ( bSuccess ) + +End Sub + +'*-------------------------------------------------------------------------- +'* +'* WriteLogEntry() - Write entry to log file +'* +'* +Private Sub WriteLogEntry( sEntryType As String, sText As String ) + Private sbOutText As StringBuilder + Private sDateText As String + Private bSuccess As Boolean + + ' If max log size then reset and start new log + If ( nLogSize > nLogMaxSize ) Then + bSuccess = ResetLog + If ( bSuccess = False ) Then + Return + End If + End If + + ' Get formatted date time string + sDateText = NativeMe.RunMethod("mteGetDateTimeString", Null) + + ' Build log entry + sbOutText.Initialize + sbOutText.Append(sDateText) + sbOutText.Append("[") + sbOutText.Append(sEntryType) + sbOutText.Append("]: ") + sbOutText.Append( sText ) + + ' Write and flush + twrLogger.WriteLine( sbOutText.ToString ) + twrLogger.Flush + + ' Add to file size + nLogSize = nLogSize + sbOutText.Length + 1 ' +1 For end of line character 0xA + +End Sub + +#If JAVA + +import java.util.Date; +import java.text.SimpleDateFormat; + +// Store date format +public static SimpleDateFormat mteDateFormat; + +/*-------------------------------------------------------------------------- +'* +'* mteSetDateTimeFormat() +'* +*/ +public static void mteSetDateTimeFormat( String formatSpec ) { + mteDateFormat = new SimpleDateFormat( formatSpec ); +} + +/*-------------------------------------------------------------------------- +'* +'* mteGetDateTimeString() +'* +*/ +public static String mteGetDateTimeString() { + return mteDateFormat.format( new Date() ); +} + +#End If + + + + \ No newline at end of file diff --git a/Java/PCODE.bas b/Java/PCODE.bas new file mode 100644 index 0000000..40728f1 --- /dev/null +++ b/Java/PCODE.bas @@ -0,0 +1,92 @@ +Type=StaticCode +Version=4.2 +ModulesStructureVersion=1 +B4J=true +@EndOfDesignText@ +'********************************************************************************** +'* +'* Pcode.bas - OP codes +'* +'********************************************************************************** + +#Region BSD License +'********************************************************************************** +'* +'* Copyright (c) 2016, MacThomas Engineering +'* All rights reserved. +'* +'* You may use this file under the terms of the BSD license as follows: +'* +'* Redistribution and use in source and binary forms, with or without +'* modification, are permitted provided that the following conditions are met: +'* +'* 1. Redistributions of source code must retain the above copyright notice, this +'* list of conditions, and the following disclaimer. +'* +'* 2. Redistributions in binary form must reproduce the above copyright notice, +'* this list of conditions and the following disclaimer in the documentation +'* and/or other materials provided with the distribution. +'* +'* 3. MacThomas Engineering may not be used to endorse or promote products derived +'* from this software without specific prior written permission. +'* +'* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +'* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +'* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +'* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +'* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +'* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +'* LOSS OF USE, DATA, Or PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED And +'* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +'* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +'* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +'* +'********************************************************************************** +#End Region + +Sub Process_Globals + + ' Stack + Public Const PUSH = 1 As Int + + ' Math + Public Const NEG = 2 As Int + Public Const ADD = 3 As Int + Public Const SUBTRACT = 4 As Int + Public Const DIVIDE = 5 As Int + Public Const MULTIPLY = 6 As Int + Public Const MODULO = 7 As Int + + ' Logical + Public Const LOGICAL_OR = 10 As Int + Public Const LOGICAL_AND = 11 As Int + Public Const LOGICAL_NOT = 12 As Int + + ' Relational + Public Const EQUAL = 13 As Int + Public Const NOT_EQUAL = 14 As Int + Public Const LESS_THAN = 15 As Int + Public Const LESS_EQUAL = 16 As Int + Public Const GREATER_THAN = 17 As Int + Public Const GREATER_EQUAL = 18 As Int + + ' Jumps + Public Const JUMP_ALWAYS = 20 As Int + Public Const JUMP_FALSE = 21 As Int + Public Const JUMP_TRUE = 22 As Int + + ' Loaders + Public Const LOADCONST = 30 As Int + Public Const LOADVAR = 31 As Int + + ' Internal functions + Public Const FUNC_ABS = 50 As Int + Public Const FUNC_IIF = 51 As Int + Public Const FUNC_MAX = 52 As Int + Public Const FUNC_MIN = 53 As Int + Public Const FUNC_SQRT = 54 As Int + + ' End code + Public Const ENDCODE = 100 As Int + +End Sub \ No newline at end of file diff --git a/Java/Run.bas b/Java/Run.bas new file mode 100644 index 0000000..a3910fc --- /dev/null +++ b/Java/Run.bas @@ -0,0 +1,583 @@ +Type=StaticCode +Version=4.2 +ModulesStructureVersion=1 +B4J=true +@EndOfDesignText@ +'********************************************************************************** +'* +'* Run.bas - Execute code +'* +'********************************************************************************** + +#Region BSD License +'********************************************************************************** +'* +'* Copyright (c) 2016, MacThomas Engineering +'* All rights reserved. +'* +'* You may use this file under the terms of the BSD license as follows: +'* +'* Redistribution and use in source and binary forms, with or without +'* modification, are permitted provided that the following conditions are met: +'* +'* 1. Redistributions of source code must retain the above copyright notice, this +'* list of conditions, and the following disclaimer. +'* +'* 2. Redistributions in binary form must reproduce the above copyright notice, +'* this list of conditions and the following disclaimer in the documentation +'* and/or other materials provided with the distribution. +'* +'* 3. MacThomas Engineering may not be used to endorse or promote products derived +'* from this software without specific prior written permission. +'* +'* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +'* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +'* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +'* DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +'* ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +'* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +'* LOSS OF USE, DATA, Or PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED And +'* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +'* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +'* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +'* +'********************************************************************************** +#End Region + +Sub Process_Globals + + ' Budget + Private Const STACK_SIZE=100 As Int 'ignore + Private Const MEMORY_SIZE=20 As Int 'ignore + + ' Global reference to Codeblock + Private gCodeBlock As Codeblock + + ' Virtual Machine + Private nAX=0 As Double ' Accumlator + Private nIP=0 As Int ' Instruction pointer + Private nSP=0 As Int ' Stack pointer + Private aStack( STACK_SIZE ) As Double ' Stack + + ' Variable memory storage (Parameters stored here) + Private aVarMemory( MEMORY_SIZE ) As Double + + Private Const CODE_HEADER_PARAM_COUNT = 0 As Int 'ignore + Private Const CODE_STARTS_HERE = 1 As Int 'ignore + +End Sub + +'*--------------------------------------------------------------- Execute +'* +Public Sub Execute( oCodeBlock As Codeblock, Bytecode As List, aArgs() As Object ) As Double + Private nRetVal As Double + Private nParamCount As Int + Private nArgIndex As Int + + + ' Set global reference to Codeblock + gCodeBlock = oCodeBlock + + ' Attempt to run before compiling? Compile error? + If ( Bytecode.Size = 0 ) Then + SetError( gCodeBlock.ERROR_NO_CODE, "Check compile error." ) + Return ( 0 ) + End If + + ' Get parameter count + nParamCount = Bytecode.Get( CODE_HEADER_PARAM_COUNT ) + + ' Invalid number of parameters? Return error + If ( nParamCount > aArgs.Length ) Then + SetError( gCodeBlock.ERROR_INSUFFICIENT_ARGS, "Expecting " & nParamCount & " arguments." ) + Return ( 0 ) + End If + + ' Store parameters + If ( nParamCount > 0 ) Then + + ' Store parameter values in variable memory + For nArgIndex = 0 To nParamCount - 1 + + ' Validate parameter is a number + If ( IsNumber( aArgs( nArgIndex )) = False ) Then + SetError( gCodeBlock.ERROR_ARG_NOT_NUMBER, "Argument #" & nArgIndex & "not a number." ) + Return ( 0 ) + End If + aVarMemory( nArgIndex ) = aArgs( nArgIndex ) + + Next + + End If + + ' Run code + nRetVal = ExecuteCode( Bytecode ) + + Return ( nRetVal ) + +End Sub + +'*----------------------------------------------------------- ExecuteCode +'* +Private Sub ExecuteCode( Code As List ) As Double + Private nPcode As Int + Private bRun=True As Boolean + Private nRetVal=0 As Double + Private nValue As Double + + ' Set instruction pointer + nIP = CODE_STARTS_HERE + + Do While ( bRun ) + + ' Get op code + nPcode = Code.Get( nIP ) + + ' Execute + Select ( nPcode ) + + Case PCODE.PUSH + + ' Advance stack pointer and store + nSP = nSP + 1 + + ' Overlfow? + If ( nSP >= STACK_SIZE ) Then + StackOverFlowError + Return ( 0 ) + End If + + aStack( nSP ) = nAX + + 'Mtelog.Dbg( "<--- Push AX=" & nAX ) + + Case PCODE.NEG + + nAX = - (nAX) + + Case PCODE.ADD + + nAX = aStack( nSP ) + nAX + nSP = nSP - 1 ' pop + + Case PCODE.SUBTRACT + + nAX = aStack( nSP ) - nAX + nSP = nSP - 1 ' pop + + Case PCODE.MULTIPLY + + nAX = aStack( nSP ) * nAX + nSP = nSP - 1 ' pop + + Case PCODE.DIVIDE + + ' Check for divide by zero + If ( nAX = 0 ) Then + DivideByZeroError + Return ( 0 ) + End If + + nAX = aStack( nSP ) / nAX + nSP = nSP - 1 ' pop + + Case PCODE.MODULO +#If B4I + Private nTStack, nTAX As Int + nTStack = aStack(nSP) + nTAX = nAX + nAX = nTStack Mod nTAX +#else + nAX = aStack( nSP ) Mod nAX +#end if + nSP = nSP - 1 ' pop + + Case PCODE.EQUAL + + If ( aStack( nSP ) = nAX ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.NOT_EQUAL + + If ( aStack( nSP ) <> nAX ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.LESS_THAN + + If ( aStack( nSP ) < nAX ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.LESS_EQUAL + + If ( aStack( nSP ) <= nAX ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.GREATER_THAN + + If ( aStack( nSP ) > nAX ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.GREATER_EQUAL + + If ( aStack( nSP ) >= nAX ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.LOGICAL_OR + + ' A > 0 or B > 0 + If ( ( aStack( nSP ) > 0 ) Or ( nAX > 0 ) ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.LOGICAL_AND + + ' A > 0 And B > 0 + If ( ( aStack( nSP ) > 0 ) And ( nAX > 0 ) ) Then nAX = 1 Else nAX = 0 + nSP = nSP - 1 + + Case PCODE.LOGICAL_NOT + + ' !( A ) + If (nAX = 0 ) Then nAX = 1 Else nAX = 0 + + Case PCODE.JUMP_ALWAYS + + nIP = nIP + Code.Get( nIP + 1 ) + + Case PCODE.JUMP_FALSE + + If ( nAX = 0 ) Then nIP = nIP + Code.Get( nIP + 1 ) Else nIP = nIP + 1 + + Case PCODE.JUMP_TRUE + + If ( nAX > 0 ) Then nIP = nIP + Code.Get( nIP + 1 ) Else nIP = nIP + 1 + + Case PCODE.LOADCONST + + ' Advance instruction pointer + nIP = nIP + 1 + + ' Load value from code + nAX = Code.Get( nIP ) + + Case PCODE.LOADVAR + Private nVarIndex As Int + + ' Advance instruction pointer + nIP = nIP + 1 + + ' Get index into memory block for this var + nVarIndex = Code.Get( nIP ) + + ' Fetch value from memory + nAX = aVarMemory( nVarIndex ) + + Case PCODE.FUNC_ABS + + nValue = aStack( nSP ) ' get arg + nSP = nSP - 1 ' pop stack + nAX = Abs( nValue ) ' call func + + Case PCODE.FUNC_MAX + + nAX = Max(aStack(nSP - 1), aStack( nSP )) ' get arg1 and arg2 + nSP = nSP - 2 ' pop stack + + Case PCODE.FUNC_MIN + + nAX = Min(aStack(nSP - 1), aStack( nSP )) ' get arg1 and arg2 + nSP = nSP - 2 ' pop stack + + Case PCODE.FUNC_SQRT + + nValue = aStack( nSP ) ' get arg + nSP = nSP - 1 ' pop stack + nAX = Sqrt( nValue ) ' call func + + Case PCODE.ENDCODE + + bRun = False + nRetVal = nAX + + Case Else + + SetError( gCodeBlock.ERROR_ILLEGAL_CODE, "Pcode=" & nPcode ) + Return ( 0 ) + + End Select + + ' Advance instruction pointer + nIP = nIP + 1 + + Loop + + 'Mtelog.Dbg( $"CPU state IP=${nIP}, AX=${nAX}, SP=${nSP}"$) + + Return ( nRetVal ) + +End Sub + +'*------------------------------------------------------- StackOverFlowError +'* +Private Sub StackOverFlowError As Int + Private sDetail As String + + ' Prcoessor state + sDetail = $"IP=${nIP}, AX=${nAX}, SP=${nSP}"$ + + Return ( SetError( gCodeBlock.ERROR_STACK_OVERFLOW, sDetail ) ) + +End Sub + +'*------------------------------------------------------- StackOverFlowError +'* +Private Sub DivideByZeroError As Int + Private sDetail As String + + ' Prcoessor state + sDetail = $"IP=${nIP}, AX=${nAX}, SP=${nSP}"$ + + Return ( SetError( gCodeBlock.ERROR_DIVIDE_BY_ZERO, sDetail ) ) + +End Sub + + + +'*---------------------------------------------------------------- SetError +'* +Private Sub SetError( nError As Int, sDetail As String ) As Int + Private sDesc As String + + ' Get error description + Select( nError ) + Case gCodeBlock.ERROR_NO_CODE + sDesc = "No code to execute." + Case gCodeBlock.ERROR_ILLEGAL_CODE + sDesc = "Ilegal Instruction." + Case gCodeBlock.ERROR_INSUFFICIENT_ARGS + sDesc = "Insufficient arguments." + Case gCodeBlock.ERROR_STACK_OVERFLOW + sDesc = "Stack Overflow." + Case gCodeBlock.ERROR_DIVIDE_BY_ZERO + sDesc = "Divide by zero." + Case Else + sDesc = "Other error." + End Select + + ' Store error + gCodeBlock.Error = nError + gCodeBlock.ErrorDesc = sDesc + gCodeBlock.ErrorDetail = sDetail + + Return ( nError ) + +End Sub + + +'*-------------------------------------------------------------- Dump +'* +Public Sub Dump( oCodeBlock As Codeblock, Bytecode As List, Codelist As List ) As List + + ' If no code then return here + If ( Bytecode.Size = 0 ) Then + Return ( Codelist ) + End If + + ' Dump instructions to a list + DumpCode( Bytecode, Codelist ) + + Return ( Codelist ) + +End Sub + +'*---------------------------------------------------------- DumpCode +'* +Private Sub DumpCode( Code As List, Decode As List ) As Int + Private nPcode As Int + Private bRun=True As Boolean + Private nRetVal=0 As Double + Private nValue As Double + Private nTarget As Int + Private nParamCount As Int + + nParamCount = Code.Get( CODE_HEADER_PARAM_COUNT ) + Decode.Add( "-- Header --" ) + Decode.Add( "Parameters=" & nParamCount ) + Decode.Add( "-- Code --" ) + + ' Set instruction pointer + nIP = CODE_STARTS_HERE + + Do While ( bRun ) + + ' Get op code + nPcode = Code.Get( nIP ) + + ' Execute + Select ( nPcode ) + + Case PCODE.PUSH + + Decode.Add(pad( nIP, "push", "ax" ) ) + + Case PCODE.NEG + + Decode.Add(pad( nIP, "neg", "ax")) + + Case PCODE.ADD + + Decode.Add(pad( nIP, "add", "stack[sp] + ax" )) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.SUBTRACT + + Decode.Add(pad( nIP, "sub", "stack[sp] - ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.MULTIPLY + + Decode.Add(pad( nIP, "mul", "stack[sp] * ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.DIVIDE + + Decode.Add(pad( nIP, "div", "stack[sp] / ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.MODULO + + Decode.Add(pad( nIP, "mod", "stack[sp] % ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.EQUAL + + Decode.Add(pad( nIP, "eq", "stack[sp] == ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.NOT_EQUAL + + Decode.Add(pad( nIP, "neq", "stack[sp] != ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.LESS_THAN + + Decode.Add(pad( nIP, "lt", "stack[sp] < ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.LESS_EQUAL + + Decode.Add(pad( nIP, "le", "stack[sp] <= ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.GREATER_THAN + + Decode.Add(pad( nIP, "gt", "stack[sp] > ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.GREATER_EQUAL + + Decode.Add(pad( nIP, "ge", "stack[sp] >= ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.LOGICAL_OR + + Decode.Add(pad( nIP, "or", "stack[sp] || ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.LOGICAL_AND + + Decode.Add(pad( nIP, "and", "stack[sp] && ax")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.LOGICAL_NOT + + Decode.Add(pad( nIP, "not", "ax")) + + Case PCODE.JUMP_ALWAYS + + nTarget = nIP + Code.Get( nIP + 1 ) + 1 ' + 1 needed to for correct location + Decode.Add(pad( nIP, "jump", nTarget)) + nIP = nIP + 1 + + Case PCODE.JUMP_FALSE + + nTarget = nIP + Code.Get( nIP + 1 ) + 1 ' + 1 needed to for correct location + Decode.Add(pad( nIP, "jumpf", nTarget)) + nIP = nIP + 1 + + Case PCODE.JUMP_TRUE + Private nTarget As Int + + nTarget = nIP + Code.Get( nIP + 1 ) + 1 ' + 1 needed to for correct location + Decode.Add(pad( nIP, "jumpt", nTarget)) + nIP = nIP + 1 + + Case PCODE.LOADCONST + + nIP = nIP + 1 + nValue = Code.Get( nIP ) + Decode.Add(pad( nIP-1, "loadc", "ax, " & nValue)) + + Case PCODE.LOADVAR + Private nVarIndex As Int + + nIP = nIP + 1 + nVarIndex = Code.Get( nIP ) + Decode.Add(pad( nIP-1, "loadv", $"ax, varmem[${ nVarIndex }]"$)) + + Case PCODE.FUNC_ABS + + Decode.Add(pad( nIP, "call", "abs")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.FUNC_MAX + + Decode.Add(pad( nIP, "call", "max")) + Decode.Add(pad( nIP, "pop", "2")) + + Case PCODE.FUNC_MIN + + Decode.Add(pad( nIP, "call", "min")) + Decode.Add(pad( nIP, "pop", "2")) + + Case PCODE.FUNC_SQRT + + Decode.Add(pad( nIP, "call", "sqrt")) + Decode.Add(pad( nIP, "pop", "")) + + Case PCODE.ENDCODE + + Decode.Add(pad( nIP, "end", "")) + bRun = False + + Case Else + + Decode.Add(pad( nIP, "err", "pcode=" & nPcode)) + Return ( 0 ) + + End Select + + ' Advance instruction pointer + nIP = nIP + 1 + + Loop + + Return ( nRetVal ) + +End Sub + +'*--------------------------------------------------------------- pad +'* +Private Sub pad( nIP2 As Int, sInstruct As String, sOperands As String ) As String + Private sInstructWithPad As String + Private sIpWithPad As String + + sIpWithPad = nIP2 & ": " + sInstructWithPad = sInstruct & " " + + 'Log( "IPLen=" & sIpWithPad.SubString2(0, 7).Length ) + 'Log( "InstLen=" & sInstructWithPad.SubString2(0,8).Length ) + + + Return ( sIpWithPad.SubString2(0, 7) & sInstructWithPad.SubString2(0,8) & sOperands ) + +End Sub