Compile Subroutine SRP_Precompiler(Routine, ProgName) /************************************************************************************************ This program is proprietary and is not to be used by or disclosed to others, nor is it to be copied without written permission from SRP Computer Solutions, Inc. Name : SRP_Precompiler Description : Enhances BASIC+ with new features. Parameters: Routine [IN] - The orginal source code when we will alter ProgName [IN] - The stored procedure name History (Date, Initials, Notes) 08/25/16 KRF Original programmer 10/20/17 KRF Added support for unit test modules 11/16/18 dmb Added support for web APIs ************************************************************************************************/ $insert LOGICAL $insert SRPARRAY Declare function Max, Get_Property, RetStack, SRP_String // Don't precompile THIS!!!! If ProgName _EQC "SRP_PRECOMPILER" then return #region Declarations UsesGoSubList = 0 UsesEventNames = 0 UsesTestResult = 0 UsesEncoding = 0 UsesUnpackTarget = 0 UsesUnpackSkip = 0 HasLoops = 0 EventNames = "" ; // List of all events ServiceNames = "" ; // List of all services APINames = "" ; // List of all Web APIs ServicePos = 0 ; // The current position of the current service in ServiceNames (counts services essentially) APIPos = 0 ; // The current position of the current API in APINames (counts APIs essentially) ReturnVar = "" ; // The return variable for the store procedure CommonsAdded = No$ ; // Keeps track as to whether or not the commons have been added yet MaxNumParams = 0 ; // Keeps track of the number of generic parameters needed to cover all events or services AutoParamsNeeded = No$ ; // Keeps track as to whether or not there is an auto parameter keyword ReferenceParams = "" ; // Keeps track of servce parameters using pass-by-reference InCommentBlock = No$ ; // Keeps track as to whether or not the current line is within a comment block TestLineNumbers = "" ; // Keeps track of line numbers of test modules // The metadata types: SERVICE or TEST Type = "" // The SERVICE metadata DefaultParams = 0 ; // The service's default parameters ServiceParamPos = 0 ; // Indicates position of the parameter to receive the service name Param1Pos = 0 ; // Indicates the position of the first generic parameter ServiceNamesQuoted = 1 ; // Service parameters are always quoted when using precompiler ParamOptions = "" ; // Reserved. (Unused at the moment.) ServiceParams = "" ; // The parameter lists for each service ServiceParamOptions = "" ; // The parameter options for each service parameter APIParams = "" ; // The parameter lists for each API APIParamOptions = "" ; // The parameter options for each API parameter OptionNames = "" ; // The list of all options, by name OptionLists = "" ; // The option lists associated to the above option names OptionQuoteFlags = "" ; // The option lists' quoted flag associated to the above option names // We need a stack to handle nest for-each and for loops. When a for-each loop is encountered, // we push "FOREACH" to the stack. When a regular for loop is encountered, we push "FOR" to the // stack. So, when we encounter "NEXT" statments, we know whether to handle them or ignore them NextStack = "" NextStackCount = 0 #endregion // Determine if this version of OI supports UTF8 op codes SupportsUTF8Ops = Field(Get_Property("SYSTEM", "VERSION")<2>, ".", 1, 2) GE "9.2" If SupportsUTF8Ops then SupportsUTF8Ops = Xlate("SYSENV", "SRP_EDITOR_NO_UTF8_OPS", "", "X") NE 1 end // Break the code into an array of lines and create a blank array of lines for the new code Lines = Routine NewLines = "" NumLines = DCount(Lines, @FM) ParseState = "" // Loop through each line For iLine = 1 to NumLines Line = Lines GoSub ParseLine Begin Case // First line of code Case iLine EQ 1 // Required @SERVICE parameter (if service) Pos = IndexC(Line, "@SERVICE", 1) If Pos GT 0 then If Trim(Line[Pos, ")"][1, ","]) _EQC "@SERVICE" then Line[Pos, 8] = "Service" ServiceParamPos = DCount(Line[1, Pos], ",") IsServiceModule = 1 end end // Required @TEST parameter (if unit test module) Pos = IndexC(Line, "@TEST", 1) If Pos GT 0 then If Trim(Line[Pos, ")"][1, ","]) _EQC "@TEST" then Line[Pos, 5] = "TestName" ServiceParamPos = DCount(Line[1, Pos], ",") UsesTestResult = 1 end end // Required @API parameter (if API module) Pos = IndexC(Line, "@API", 1) If Pos GT 0 then If Trim(Line[Pos, ")"][1, ","]) _EQC "@API" then Line[Pos, 4] = "Api" ServiceParamPos = DCount(Line[1, Pos], ",") IsServiceModule = 1 end end // Optional @PARAMS parameter Pos = IndexC(Line, "@PARAMS", 1) If Pos GT 0 then If Trim(Line[Pos, ")"][1, ","]) _EQC "@PARAMS" then Line[Pos, 7] = "%%AUTOPARAMLIST%%" AutoParamsNeeded = Yes$ end end Locate "(" in Tokens using @FM setting ParenPos then ParamList = SRP_String("DetokenizeCode", Field(Tokens, @FM, ParenPos, NumTokens)) GoSub CleanParamList end else ParamList = "" end DefaultParams = ParamList Convert @FM to @SVM in DefaultParams Convert @Lower.Case to @Upper.Case in ParamList Locate "PARAM1" in ParamList using @FM setting Param1Pos else Locate "@PARAMS" in ParamList using @FM setting Param1Pos else null end // Get the proc name as it is written CasedProcName = Line[1, "("][-1, "B "] NewLines<-1> = Line // Replace pragma with common statement. This is a much better place for it, assuming the pragma is at the top Case Trim(Line[1, 15]) _EQC "*pragma precomp" NewLines<-1> = "%%SRPAUTO_COMMON%%" // Ignore all assignment statements Case IsAssignmentOrMethod NewLines<-1> = Line // Check for For-Each loop Case Tokens<1> _EQC "FOR" LineFormat = "FOR,EACH,*,IN,*,USING|SETTING,*,SETTING" GoSub FormatTokens If Tokens<2> _EQC "EACH" AND Tokens<4> _EQC "IN" then HasLoops = 1 ElementVar = Tokens<3> ListVar = Tokens<5> CounterVar = "" NextToken = 6 If Tokens _EQC "USING" then Delimiter = Tokens NextToken += 2 end else Delimiter = '@FM' end If Tokens _EQC "SETTING" then CounterVar = Tokens NextToken += 2 end NewLine = '' // Make UTF-8 compatible (thanks Matt Crozier) NewLine<-1> = 'SRP_Precompiler_LoopStack@<-1> = SRP_Precompiler_LoopPos@:@VM:SRP_Precompiler_LoopLen@;' NewLine<-1> = 'SRP_Precompiler_LoopPos@ = 1;' If Len(CounterVar) then NewLine<-1> = CounterVar:' = 0;' end If SupportsUTF8Ops then NewLine<-1> = 'SRP_Precompiler_LoopLen@ = getByteSize(':ListVar:');' NewLine<-1> = 'Loop;' NewLine<-1> = ElementVar:' = ':ListVar:'[SRP_Precompiler_LoopPos@, "F":':Delimiter:', 1];' NewLine<-1> = 'SRP_Precompiler_LoopPos@ = bCol2() + 1' If Len(CounterVar) then NewLine<-1> = ';':CounterVar:' += 1' end end else NewLine<-1> = 'SRP_Precompiler_LoopLen@ = Len(':ListVar:');' NewLine<-1> = 'Loop;' NewLine<-1> = ElementVar:' = ':ListVar:'[SRP_Precompiler_LoopPos@, "F":':Delimiter:'];' NewLine<-1> = 'SRP_Precompiler_LoopPos@ = Col2() + 1' If Len(CounterVar) then NewLine<-1> = ';':CounterVar:' += 1' end end If Tokens _EQC "UNTIL" OR Tokens _EQC "WHILE" then Pos = IndexC(Line, Tokens, 1) If Pos GT 0 then NewLine := ';':Line[Pos, LenLine] end else NewLine := ';':Field(Tokens, @FM, NextToken, NumTokens) end end GoSub CommitNewLine NextStack<-1> = "FOREACH" NextStackCount += 1 end else NewLines<-1> = Line NextStack<-1> = "FOR" NextStackCount += 1 end // Check for Next statement to match with For-Each loop Case Tokens<1> _EQC "NEXT" AND NextStackCount GT 0 NextData = NextStack[-1, "B":@FM] NextType = NextData<1, 1> NextStack = If Col1() GT 1 then NextStack[1, Col1() - 1] else "" NextStackCount -= 1 Begin Case Case NextType EQ "FOREACH" HasLoops = 1 NewLine = '' NewLine<-1> = 'Until SRP_Precompiler_LoopPos@ GT SRP_Precompiler_LoopLen@;' NewLine<-1> = 'Repeat;' If SupportsUTF8Ops then NewLine<-1> = 'SRP_Precompiler_LoopLen@ = SRP_Precompiler_LoopStack@[-1, "B":@VM, 1];' NewLine<-1> = 'SRP_Precompiler_LoopPos@ = SRP_Precompiler_LoopStack@[bCol1() - 1, "B":@FM, 1];' NewLine<-1> = 'SRP_Precompiler_LoopStack@ = If bCol1() GT 1 then SRP_Precompiler_LoopStack@[1, bCol1() - 1, 1] else ""' end else NewLine<-1> = 'SRP_Precompiler_LoopLen@ = SRP_Precompiler_LoopStack@[-1, "B":@VM];' NewLine<-1> = 'SRP_Precompiler_LoopPos@ = SRP_Precompiler_LoopStack@[Col1() - 1, "B":@FM];' NewLine<-1> = 'SRP_Precompiler_LoopStack@ = If Col1() GT 1 then SRP_Precompiler_LoopStack@[1, Col1() - 1] else ""' end GoSub CommitNewLine Case 1 NewLines<-1> = Line End Case // Check for final return value, we'll use it to make sure it's always assigned Case Tokens<1> _EQC "RETURN" AND Len(ReturnVar) EQ 0 ReturnVar = Tokens<2> If Tokens<3> _EQC "OR" OR Tokens<3> _EQC "ELSE" then NewLines<-1> = 'If Assigned(':ReturnVar:') then Return ':ReturnVar:' else Return ':Tokens<4>:'' end else NewLines<-1> = Line end // Check for GoToEvent Case Tokens<1> _EQC "GOTOEVENT" UsesGoSubList = 1 UsesEventNames = 1 LineFormat = "GOTOEVENT,*,FOR,*,ELSE" GoSub FormatTokens If Tokens<3> _EQC "FOR" then NewLine = '' NewLine<-1> = '%%SRPAUTO_EVENTLIST%%;' NewLine<-1> = 'SRP_Precompiler_EventEvent@ = ':Tokens<2>:';' NewLine<-1> = 'SRP_Precompiler_EventCtrl@ = Field(':Tokens<4>:', ".", 2, 9);' NewLine<-1> = 'SRP_Precompiler_GoSubTarget@ = (If Len(SRP_Precompiler_EventCtrl@) then SRP_Precompiler_EventCtrl@ else "WINDOW"):".":SRP_Precompiler_EventEvent@;' NewLine<-1> = 'Convert @Lower.Case to @Upper.Case in SRP_Precompiler_GoSubTarget@;' NewLine<-1> = 'Locate SRP_Precompiler_GoSubTarget@ in SRP_Precompiler_GoSubList@ using "," setting SRP_Precompiler_GoSubPos@ then' NewLine<-1> = '%%SRPAUTO_EVENTGOSUBLIST%%' If Tokens<5> _EQC "ELSE" then NewLine<-1> = 'else' else NewLine<-1> = 'else NULL' GoSub CommitNewLine end // Check for event Case Tokens<1> _EQC "EVENT" EventName = Tokens<2> EventNames<-1> = EventName If Tokens<3> EQ "(" then ParamList = SRP_String("DetokenizeCode", Field(Tokens, @FM, 3, NumTokens)) GoSub CleanParamList MaxNumParams = Max(MaxNumParams, NumParams) If NumParams GT 0 then InitEventParams = "" For iParam = 1 to NumParams InitEventParams<-1> = Trim(ParamList):' = (If Assigned(Param':iParam:') then Param':iParam:' else "")' Next iParam Convert @FM to ";" in InitEventParams NewLines<-1> = EventName:': | ':InitEventParams end else NewLines<-1> = EventName:':' end end else NewLines<-1> = EventName:':' end // Check for end of event Case Tokens<1> _EQC "END" AND Tokens<2> _EQC "EVENT" NewLines<-1> = 'return' // Check for GoToService Case Tokens<1> _EQC "GOTOSERVICE" UsesGoSubList = 1 Type = "SERVICE" NewLine = '' NewLine<-1> = '%%SRPAUTO_SERVICELIST%%;' NewLine<-1> = 'SRP_Precompiler_GoSubTarget@ = (If Assigned(Service) then Service else "");' NewLine<-1> = 'Convert @Lower.Case to @Upper.Case in SRP_Precompiler_GoSubTarget@;' NewLine<-1> = 'Locate SRP_Precompiler_GoSubTarget@ in SRP_Precompiler_GoSubList@ using "," setting SRP_Precompiler_GoSubPos@ then' NewLine<-1> = '%%SRPAUTO_SERVICEGOSUBLIST%%' If Tokens<2> _EQC "ELSE" then NewLine<-1> = 'else' else NewLine<-1> = 'else NULL' GoSub CommitNewLine // Check for service Case Tokens<1> _EQC "SERVICE" ServicePos += 1 ServiceName = Tokens<2> ServiceNames<-1> = ServiceName If Tokens<3> EQ "(" then ParamList = SRP_String("DetokenizeCode", Field(Tokens, @FM, 3, NumTokens)) GoSub CleanParamList MaxNumParams = Max(MaxNumParams, NumParams) InitServiceParams = "" ReferenceParams = "" For iParam = 1 to NumParams DefaultParamValue = '""' ParamSuffix = "" Param = Trim(ParamList) If Param[1, 4] _EQC "REF " then Param = Trim(Param[5, Len(Param)][1, "="]) ReferenceParams<-1> = Param:@VM:iParam IsRef = Yes$ end else IsRef = No$ end If Index(Param, "=", 1) GT 0 then ParamValue = Trim(Field(Param, "=", 2)) Param = Trim(Field(Param, "=", 1)) If Num(ParamValue) OR ParamValue[1, 1] EQ "'" OR ParamValue[1, 1] EQ '"' OR ParamValue[1, 1] EQ '@' then DefaultParamValue = ParamValue ParamSuffix = " = ":ParamValue end else If Index(ParamValue, "[", 1) then ServiceParamOptions<1, ServicePos, iParam> = ParamValue[1, "["] DefaultParamValue = Trim(ParamValue[Col2() + 1, "]"]) ParamSuffix = " = ":DefaultParamValue end else ServiceParamOptions<1, ServicePos, iParam> = ParamValue end end end else ServiceParamOptions<1, ServicePos, iParam> = "" end If IsRef then ServiceParams<1, ServicePos, iParam> = "Ref ":Param:ParamSuffix end else ServiceParams<1, ServicePos, iParam> = Param:ParamSuffix end InitServiceParams<-1> = Param:' = If Assigned(Param':iParam:') then Param':iParam:' else ':DefaultParamValue Next iParam Convert @FM to ";" in InitServiceParams If Len(Trim(InitServiceParams)) then NewLines<-1> = ServiceName:': | ':InitServiceParams end else NewLines<-1> = ServiceName:':' end Convert @FM to @SVM in ParamList end else NewLines<-1> = ServiceName:':' end // Check for end of service Case Tokens<1> _EQC "END" AND Tokens<2> _EQC "SERVICE" ReturnLine = "" NumParams = DCount(ReferenceParams, @FM) For iParam = 1 to NumParams Param = ReferenceParams ParamNum = ReferenceParams ReturnLine<-1> = 'Param':ParamNum:' = ':Param Next iParam ReturnLine<-1> = 'return' Convert @FM to ";" in ReturnLine NewLines<-1> = ReturnLine // Check for GoToAPI Case Tokens<1> _EQC "GOTOAPI" UsesGoSubList = 1 Type = "API" NewLine = '' NewLine<-1> = '%%SRPAUTO_SERVICELIST%%;' NewLine<-1> = 'SRP_Precompiler_GoSubTarget@ = (If Assigned(API) then API else "");' NewLine<-1> = 'Convert @Lower.Case to @Upper.Case in SRP_Precompiler_GoSubTarget@;' NewLine<-1> = 'Locate SRP_Precompiler_GoSubTarget@ in SRP_Precompiler_GoSubList@ using "," setting SRP_Precompiler_GoSubPos@ then' NewLine<-1> = '%%SRPAUTO_SERVICEGOSUBLIST%%' If Tokens<2> _EQC "ELSE" then NewLine<-1> = 'else' else NewLine<-1> = 'else NULL' GoSub CommitNewLine // Check for service Case Tokens<1> _EQC "API" ServicePos += 1 ServiceName = Tokens<2> ServiceNames<-1> = ServiceName If Tokens<3> EQ "(" then ParamList = SRP_String("DetokenizeCode", Field(Tokens, @FM, 3, NumTokens)) GoSub CleanParamList MaxNumParams = Max(MaxNumParams, NumParams) InitServiceParams = "" ReferenceParams = "" For iParam = 1 to NumParams DefaultParamValue = '""' ParamSuffix = "" Param = Trim(ParamList) If Param[1, 4] _EQC "REF " then Param = Trim(Param[5, Len(Param)][1, "="]) ReferenceParams<-1> = Param:@VM:iParam IsRef = Yes$ end else IsRef = No$ end If Index(Param, "=", 1) GT 0 then ParamValue = Trim(Field(Param, "=", 2)) Param = Trim(Field(Param, "=", 1)) If Num(ParamValue) OR ParamValue[1, 1] EQ "'" OR ParamValue[1, 1] EQ '"' OR ParamValue[1, 1] EQ '@' then DefaultParamValue = ParamValue ParamSuffix = " = ":ParamValue end else If Index(ParamValue, "[", 1) then ServiceParamOptions<1, ServicePos, iParam> = ParamValue[1, "["] DefaultParamValue = Trim(ParamValue[Col2() + 1, "]"]) ParamSuffix = " = ":DefaultParamValue end else ServiceParamOptions<1, ServicePos, iParam> = ParamValue end end end else ServiceParamOptions<1, ServicePos, iParam> = "" end If IsRef then ServiceParams<1, ServicePos, iParam> = "Ref ":Param:ParamSuffix end else ServiceParams<1, ServicePos, iParam> = Param:ParamSuffix end InitServiceParams<-1> = Param:' = If Assigned(Param':iParam:') then Param':iParam:' else ':DefaultParamValue Next iParam Convert @FM to ";" in InitServiceParams If Len(Trim(InitServiceParams)) then NewLines<-1> = ServiceName:': | ':InitServiceParams end else NewLines<-1> = ServiceName:':' end Convert @FM to @SVM in ParamList end else NewLines<-1> = ServiceName:':' end // Check for end of API Case Tokens<1> _EQC "END" AND Tokens<2> _EQC "API" ReturnLine = "" NumParams = DCount(ReferenceParams, @FM) For iParam = 1 to NumParams Param = ReferenceParams ParamNum = ReferenceParams ReturnLine<-1> = 'Param':ParamNum:' = ':Param Next iParam ReturnLine<-1> = 'return' Convert @FM to ";" in ReturnLine NewLines<-1> = ReturnLine // Parameter Options Case Tokens<1> _EQC "OPTIONS" AND Alpha(Tokens<2>[1, 1]) AND Tokens<3> EQ "=" CurrOptionList = "" IsQuoted = No$ FirstItem = Tokens<4> IsQuoted = (FirstItem[1, 1] EQ FirstItem[-1, 1] AND (FirstItem[1, 1] EQ '"' OR FirstItem[1, 1] EQ "'")) For iToken = 4 to NumTokens Token = Trim(Tokens) If Token NE "," then If IsQuoted then CurrOptionList<1, 1, -1> = Token[2, Len(Token) - 2] end else CurrOptionList<1, 1, -1> = Token end end Next iToken OptionNames<1, -1> = Tokens<2> OptionLists<1, -1> = CurrOptionList OptionQuoteFlags<1, -1> = IsQuoted NewLines<-1> = "" // Check for GoToTest Case Tokens<1> _EQC "GOTOTEST" UsesGoSubList = 1 Type = "TEST" NewLine = '' NewLine<-1> = '%%SRPAUTO_SERVICELIST%%;' NewLine<-1> = 'SRP_Precompiler_GoSubTarget@ = (If Assigned(TestName) then TestName else "");' NewLine<-1> = 'Convert @Lower.Case to @Upper.Case in SRP_Precompiler_GoSubTarget@;' NewLine<-1> = 'Locate SRP_Precompiler_GoSubTarget@ in SRP_Precompiler_GoSubList@ using "," setting SRP_Precompiler_GoSubPos@ then' NewLine<-1> = '%%SRPAUTO_SERVICEGOSUBLIST%%' GoSub CommitNewLine // Check for test Case Tokens<1> _EQC "TEST" ServicePos += 1 ServiceName = Tokens<2> ServiceNames<-1> = ServiceName TestLineNumbers<-1> = iLine NewLines<-1> = ServiceName:':' // Check for end of test Case Tokens<1> _EQC "END" AND Tokens<2> _EQC "TEST" NewLines<-1> = 'return' // Check for Assert statement Case Tokens<1> _EQC "ASSERT" LineFormat = "ASSERT,*,EQUALS,*,USING,*" GoSub FormatTokens AssertExpression = Tokens<2> If Tokens<3> _EQC "EQUALS" then UsesTestResult = 1 UsesEncoding = 1 Expected = Tokens<4> If Expected[1, 1] EQ '\' AND Expected[-1, 1] EQ '\' then ExpectedFormatted = '"':Expected[2, Len(Expected) - 2]:'"' WasHex = 1 end else ExpectedFormatted = Expected WasHex = 0 end NewLine = 'SRP_Precompiler_TestResult@ = (':AssertExpression:');' If Tokens<5> _EQC "USING" then Format = Tokens<6> If WasHex then NewLine<-1> = 'If SRP_Precompiler_TestResult@ NE ':Expected:' then' end else NewLine<-1> = 'If SRP_Precompiler_TestResult@ NE IConv(':Expected:', ':Format:') then' end NewLine<-1> = ReturnVar:' = BASE64ENCODE(SRP_Precompiler_TestResult@):@FM:':iLine:':@FM:BASE64ENCODE(':ExpectedFormatted:'):@FM:':Format:';' end else NewLine<-1> = 'If SRP_Precompiler_TestResult@ NE (':Expected:') then' NewLine<-1> = ReturnVar:' = BASE64ENCODE(SRP_Precompiler_TestResult@):@FM:':iLine:':@FM:BASE64ENCODE(':ExpectedFormatted:');' end NewLine<-1> = 'return' end else AssertCapture = AssertExpression Swap '"' with '":':"'":'"':"'":':"' in AssertCapture NewLine = 'If Not(':AssertExpression:') then' NewLine<-1> = ReturnVar:' = "':AssertCapture:'":@FM:':iLine:';' NewLine<-1> = 'return' end GoSub CommitNewLine // Check for unpacking syntax Case Tokens<1> _EQC "(" NewLine = "" Success = 0 Done = 0 Delim = '@FM' NextPos = If SupportsUTF8Ops then 'bCol2() + 1' else 'Col2() + 1' For iToken = 2 to NumTokens Until Done VarName = Tokens Pos = If iToken EQ 2 then 1 else NextPos If VarName _EQC 'Null' OR VarName EQ '_' OR VarName EQ ',' then UsesUnpackSkip = 1 NewLine<-1> = 'SRP_Precompiler_UnpackSkip@ = %UNPACKTARGET%[':Pos:',%UNPACKDELIM%];' If Varname EQ ',' then iToken -= 1 end else NewLine<-1> = VarName:' = %UNPACKTARGET%[':Pos:',%UNPACKDELIM%];' end NextToken = Tokens If NextToken EQ ',' then iToken += 1 end else if NextToken EQ ')' then iToken += 1 Done = 1 end else Done = 1 end Next iToken If Tokens EQ "using" then Delim = Tokens iToken += 2 end If Tokens EQ '=' then iToken += 1 If iToken = NumTokens then Swap "%UNPACKTARGET%" with Tokens in NewLine end else UnpackExpression = SRP_String("DetokenizeCode", Field(Tokens, @FM, iToken, NumTokens)) NewLine = 'SRP_Precompiler_UnpackTarget@ = ':UnpackExpression:';':@FM:NewLine Swap "%UNPACKTARGET%" with 'SRP_Precompiler_UnpackTarget@' in NewLine UsesUnpackTarget = 1 end Success = 1 end If Success then If SupportsUTF8Ops then Swap "%UNPACKDELIM%" with Delim:', 1' in NewLine end else Swap "%UNPACKDELIM%" with Delim in NewLine end end else NewLine = Line end GoSub CommitNewLine // This directive is used by SRP Editor. The Precompiler just strips it away Case Tokens<1> _EQC "#" AND Tokens<2> _EQC "WINDOW" AND NumTokens EQ 3 NewLines<-1> = "" // Otherwise, keep the line as is Case 1 NewLines<-1> = Line End Case Next iLine // New code Routine = NewLines // Insert the event names GoSubListVar = 'SRP_Precompiler_GoSubList@' GoSubNames = EventNames GoSubPlaceholders = "%%SRPAUTO_EVENTLIST%%":@FM:"%%SRPAUTO_EVENTGOSUBLIST%%" If Len(EventNames) then GoSub CreateGoSubList end else GoSub RemoveGoSubList end // Insert the service names GoSubListVar = 'SRP_Precompiler_GoSubList@' GoSubNames = ServiceNames GoSubPlaceholders = "%%SRPAUTO_SERVICELIST%%":@FM:"%%SRPAUTO_SERVICEGOSUBLIST%%" If Len(ServiceNames) then GoSub CreateGoSubList end else GoSub RemoveGoSubList end // Insert the API names * GoSubListVar = 'SRP_Precompiler_GoSubList@' * GoSubNames = APINames * GoSubPlaceholders = "%%SRPAUTO_APILIST%%":@FM:"%%SRPAUTO_APIGOSUBLIST%%" * If Len(APINames) then * GoSub CreateGoSubList * end else * GoSub RemoveGoSubList * end // Insert Auto params If AutoParamsNeeded then NumParams = Max(1, MaxNumParams) ParamList = "" For iParam = 1 to NumParams ParamList<-1> = "Param":iParam Next iParam Convert @FM to "," in ParamList Swap "%%AUTOPARAMLIST%%" with ParamList in Routine end // Insert commons Vars = '' If HasLoops then Vars<-1> = 'SRP_Precompiler_LoopPos@':@FM:'SRP_Precompiler_LoopLen@':@FM:'SRP_Precompiler_LoopStack@' end If UsesGoSubList then Vars<-1> = 'SRP_Precompiler_GoSubTarget@':@FM:'SRP_Precompiler_GoSubList@':@FM:'SRP_Precompiler_GoSubPos@' end If UsesEventNames then Vars<-1> = 'SRP_Precompiler_EventEvent@':@FM:'SRP_Precompiler_EventCtrl@' end If UsesTestResult then Vars<-1> = 'SRP_Precompiler_TestResult@' end If UsesUnpackTarget then Vars<-1> = 'SRP_Precompiler_UnpackTarget@' end If UsesUnpackSkip then Vars<-1> = 'SRP_Precompiler_UnpackSkip@' end If Len(Vars) then CommonLine = "" If UsesEncoding then CommonLine := "Declare function BASE64ENCODE;" Swap @FM with ', ' in Vars CommonLine := 'Common /SRP_Precompiler_':CasedProcName:'/ ':Vars Swap "%%SRPAUTO_COMMON%%" with CommonLine in Routine end else Swap "%%SRPAUTO_COMMON%%" with "" in Routine end // Only save the metadata if we had at least one occurence of "SERVICES_SIGNATURE" // AND if we not currently inside of BLINT Locate "BLINT" in RetStack() using @FM setting DummyPos else Open "SYSENV" to hTable then // Store the service metadata Common /SRP_EDITOR_PRECOMPILER_HELPERS/ Frame@, ID@ If Len(ID@) then AppName = ID@[1, "*"] ProcName = ID@[-1, "B*"] end else AppName = @AppID<1> ProcName = ProgName end // If it's a TEST, then register it If Type EQ "TEST" then Call SRP_Editor_UnitTest_Services("Register", "SRP_EDITOR", CasedProcName, ServiceNames, TestLineNumbers, AppName) end else Convert @FM to @VM in ServiceNames Record = Type:@FM:DefaultParams:@FM:ServiceParamPos:@FM:Param1Pos:@FM:ServiceNamesQuoted:@FM:ParamOptions:@FM:ServiceNames:@FM:ServiceParams:@FM:ServiceParamOptions:@FM:OptionNames:@FM:OptionLists:@FM:OptionQuoteFlags If AppName EQ "SYSPROG" then Key = "SRP_EDITOR_METADATA*":ProcName end else Key = "SRP_EDITOR_METADATA*":ProcName:"*":AppName end If Len(Type) then Write Record to hTable, Key else NULL If Len(Frame@) then Call Send_Message(Frame@:".OLE_EDITOR", "OLE.MetaDataRequestedResponse", ProcName, Record) end end else Delete hTable, Key else NULL If Len(Frame@) then Call Send_Message(Frame@:".OLE_EDITOR", "OLE.RemoveMetaData", ProcName) end end end end end return ParseLine: // Uses: [in]Line, [out]Tokens, [out]NumTokens LenLine = Len(Line) Tokens = SRP_String("TokenizeCode", Line, "None", No$, ParseState) NumTokens = DCount(Tokens, @FM) GoSub IsAssignmentOrMethod return CommitNewLine: // Uses: [in]NewLine, [in]NewLines If ProgName = "__TEST" then Swap @FM with \0D0A\ in NewLine end else Convert @FM to " " in NewLine end NewLines<-1> = NewLine return CleanParamList: // Uses: [in]ParamList, [out]NumParams Swap ", " with @FM in ParamList Convert ",()" to @FM in ParamList * ParamList = SRP_Array("Clean", Trim(ParamList)) ParamList = SRP_Clean_Array(Trim(ParamList), @FM) NumParams = DCount(ParamList, @FM) return CreateGoSubList: // Uses: [in] GoSubListVar, [in] GoSubNames, [in] GoSubPlaceholders GoSubNamesLines = '' GoSubNamesLine = GoSubListVar:' = "' NumGoSubNames = DCount(GoSubNames, @FM) If NumGoSubNames GT 0 then For iGoSubName = 1 to NumGoSubNames GoSubName = GoSubNames Convert @Lower.Case to @Upper.Case in GoSubName If Len(GoSubNamesLine) + Len(GoSubName) > 200 then GoSubNamesLine[-1, 1] = ',"' If ProgName = "__TEST" then GoSubNamesLines<-1> = GoSubNamesLine:';':\0D0A\ end else GoSubNamesLines<-1> = GoSubNamesLine:';' end GoSubNamesLine = GoSubListVar:' := "' end GoSubNamesLine := GoSubName:',' Next iGoSubName GoSubNamesLine[-1, 1] = '"' end else GoSubNamesLine := '"' end GoSubNamesLines<-1> = GoSubNamesLine Convert @FM to " " in GoSubNamesLines Swap GoSubPlaceholders<1> with GoSubNamesLines in Routine NumGoSubNames = DCount(GoSubNames, @FM) NumChunks = Int(NumGoSubNames / 255) + 1 If NumChunks EQ 1 then Swap @FM with ", " in GoSubNames Swap GoSubPlaceholders<2> with GoSubNames in Routine end else Stmt = "Begin Case; " For i = 1 to NumChunks Temp = Field(GoSubNames, @FM, ((i - 1) * 255) + 1, 255) Swap @FM with ", " in Temp If i EQ NumChunks then Stmt := "Case 1; On SRP_Precompiler_GoSubPos@ GoSub ":Temp:"; " end else Stmt := "Case SRP_Precompiler_GoSubPos@ LE ":(i * 255):"; On SRP_Precompiler_GoSubPos@ GoSub ":Temp:"; " end Next i Stmt := "End Case" Swap GoSubPlaceholders<2> with Stmt in Routine end Return RemoveGoSubList: // Uses: [in] GoSubListVar, [in] GoSubNames, [in] GoSubPlaceholders PlaceholderPos = Index(Routine, GoSubPlaceholders<1>, 1) If PlaceholderPos GT 0 then LenToDelete = Len(Routine[PlaceholderPos, @FM]) Routine[PlaceholderPos, LenToDelete] = "If 1 then" end Return IsAssignmentOrMethod: // Uses: [in]Tokens, [in]NumTokens, [out]IsAssignmentOrMethod Locate Tokens<2> in "= := += -=" using " " setting Pos then IsAssignmentOrMethod = Yes$ end else If Trim(Tokens<2>)[1, 1] EQ "(" then IsAssignmentOrMethod = Yes$ end else IsAssignmentOrMethod = No$ end end return FormatTokens: // Uses: [in] LineFormat, [in\out] Tokens, [in\out] NumTokens // We are going to merge some tokens so more complication expressions can be supported. // We do this by merging everything between required keywords, as defined in LineFormat FormatValid = Yes$ NumFormatItems = DCount(LineFormat, ",") For iItem = 1 to NumFormatItems while FormatValid CurrKeyword = Field(LineFormat, ",", iItem, 1) If CurrKeyword NE "*" AND iItem GT 1 then Done = No$ Loop While iItem LE NumTokens CurrToken = Field(Tokens, @FM, iItem, 1) Convert @Lower.Case to @Upper.Case in CurrToken Locate CurrToken in CurrKeyword using "|" setting FormatPos then Done = Yes$ end else Tokens[Col1(), 1] = @VM NumTokens -= 1 end Until Done Repeat end Next iItem // Now de-tokenize each field NumTokens = DCount(Tokens, @FM) For iToken = 1 to NumTokens Tokens = SRP_String("DetokenizeCode", Tokens, @VM) Next iToken return