884 lines
37 KiB
Plaintext
884 lines
37 KiB
Plaintext
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<iLine>
|
|
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<NextToken> _EQC "USING" then
|
|
Delimiter = Tokens<NextToken + 1>
|
|
NextToken += 2
|
|
end else
|
|
Delimiter = '@FM'
|
|
end
|
|
If Tokens<NextToken> _EQC "SETTING" then
|
|
CounterVar = Tokens<NextToken + 1>
|
|
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<NextToken> _EQC "UNTIL" OR Tokens<NextToken> _EQC "WHILE" then
|
|
Pos = IndexC(Line, Tokens<NextToken>, 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<iParam>):' = (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<iParam>)
|
|
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<iParam, 1>
|
|
ParamNum = ReferenceParams<iParam, 2>
|
|
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<iParam>)
|
|
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<iParam, 1>
|
|
ParamNum = ReferenceParams<iParam, 2>
|
|
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<iToken>)
|
|
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<iToken>
|
|
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<iToken + 1>
|
|
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<iToken> EQ "using" then
|
|
Delim = Tokens<iToken + 1>
|
|
iToken += 2
|
|
end
|
|
If Tokens<iToken> EQ '=' then
|
|
iToken += 1
|
|
If iToken = NumTokens then
|
|
Swap "%UNPACKTARGET%" with Tokens<iToken> 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<iGoSubName>
|
|
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<iToken> = SRP_String("DetokenizeCode", Tokens<iToken>, @VM)
|
|
Next iToken
|
|
|
|
return
|