📄 cs2.pas
字号:
3 = /
4 = DIV
5 = MOD
6 = AND
7 = SHR
8 = SHL
9 = +
10 = -
11 = OR
12 = XOR
13 = =
14 = >
15 = <
16 = <>
17 = <=
18 = >=
}
CajVariant: PCajVariant;
end;
function TCs2PascalScript.Calc(Vars: PVariableManager; res: PCajVariant; StopOn:
TCs2TokenId): Boolean;
{ Calculate an expression }
var
Items: TifList;
PreCalc: string;
temp4: PCajVariant;
Work: PCajSmallCalculation;
function ChrToStr(s: string): Char;
{Turn a char intto a string}
begin
Delete(s, 1, 1); {First char : #}
ChrToStr := Chr(StrToInt(s));
end;
function PString(s: string): string;
{ remove the ' from the strings}
begin
s := Copy(s, 2, Length(s) - 2);
PString := s;
end;
function DoPrecalc: Boolean;
{Pre calculate (- not +)}
begin
DoPrecalc := True;
while Length(Precalc) > 0 do begin
if precalc[1] = '-' then
begin
if not DoMinus(Work^.CajVariant) then
begin
RunError(ETypeMismatch);
Exit;
end;
end else if precalc[1] = '|' then
begin
if not DoNot(Work^.CajVariant) then
begin
RunError(ETypeMismatch);
Exit;
end;
end else if precalc[1] = '+' then
begin
{plus has no effect}
end else
begin
DoPreCalc := False;
Exit;
end;
Delete(PreCalc, 1, 1);
end;
end;
procedure DisposeList;
{ Dispose the items }
var
i: Integer;
p: PCajSmallCalculation;
begin
for i := 0 to Items.Count - 1 do begin
p := items.GetItem(i);
if p^.TType = 0 then
DestroyCajVariant(p^.CajVariant);
Dispose(p);
end;
Items.Destroy;
end;
function ParseString: string;
{ Parse a string }
var
temp3: string;
begin
temp3 := '';
while (Parser^.CurrTokenId = CSTI_String) or (Parser^.CurrTokenId =
CSTI_Char) do begin
if Parser^.CurrTokenId = CSTI_String then
begin
temp3 := temp3 + PString(GetToken(Parser));
NextNoJunk(Parser);
if Parser^.CurrTokenId = CSTI_String then
temp3 := temp3 + #39;
end {if}
else
begin
temp3 := temp3 + ChrToStr(GetToken(Parser));
NextnoJunk(parser);
end; {else if}
end; {while}
ParseString := temp3;
end;
procedure Calculate;
{ Calculate the full expression }
var
l: PCajSmallCalculation;
i: LongInt;
begin
i := 0;
while i < (items.count - 1) div 2 do begin
l := PCajSmallCalculation(items.GetItem(i * 2 + 1));
if (l^.TType >= 2) and (l^.TType <= 8) then
begin
case l^.TType of
2: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtMul)
then
RunError(ETypeMismatch);
3: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtDiv)
then
RunError(ETypeMismatch);
4: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtIntDiv)
then
RunError(ETypeMismatch);
5: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtIntMod)
then
RunError(ETypeMismatch);
6: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtAnd)
then
RunError(ETypeMismatch);
7: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtShr)
then
RunError(ETypeMismatch);
8: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtShl)
then
RunError(ETypeMismatch);
end;
if ErrorCode <> 0 then
Exit;
l := PCajSmallCalculation(items.GetItem(i * 2 + 2));
DestroycajVariant(l^.CajVariant);
Dispose(l);
Items.Remove(l);
l := PCajSmallCalculation(items.GetItem(i * 2 + 1));
Dispose(l);
Items.Remove(l);
end else Inc(i);
end;
i := 0;
while i < (items.count - 1) div 2 do begin
l := PCajSmallCalculation(items
.GetItem(i * 2 + 1));
if (l^.TType >= 9) and (l^.TType <= 12) then
begin
case l^.TType of
9: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtPlus)
then
RunError(ETypeMismatch);
10: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtMinus)
then
RunError(ETypeMismatch);
11: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtOr)
then
RunError(ETypeMismatch);
12: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtXor)
then
RunError(ETypeMismatch);
end;
if ErrorCode <> 0 then
Exit;
l := PCajSmallCalculation(items.GetItem(i * 2 + 2));
DestroycajVariant(l^.CajVariant);
Dispose(l);
Items.Remove(l);
l := PCajSmallCalculation(items
.GetItem(i * 2 + 1));
Dispose(l);
Items.Remove(l);
end else Inc(i);
end;
i := 0;
while i < (items.count - 1) div 2 do begin
l := PCajSmallCalculation(items
.GetItem(i * 2 + 1));
if (l^.TType >= 13) and (l^.TType <= 18) then
begin
case l^.TType of
13: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtEqual)
then
RunError(ETypeMismatch);
14: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtGreater)
then
RunError(ETypeMismatch);
15: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtLess)
then
RunError(ETypeMismatch);
16: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtNotEqual)
then
RunError(ETypeMismatch);
17: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtLessEqual)
then
RunError(ETypeMismatch);
18: if not Perform(PCajSmallCalculation(items.GetItem(i * 2))^.
CajVariant, PCajSmallCalculation(items.GetItem(i * 2 + 2))
^.CajVariant, PtGreaterEqual)
then
RunError(ETypeMismatch);
end;
if ErrorCode <> 0 then
Exit;
l := PCajSmallCalculation(items.GetItem(i * 2 + 2));
DestroycajVariant(l^.CajVariant);
Dispose(l);
Items.Remove(l);
l := PCajSmallCalculation(items.GetItem(i * 2 + 1));
Dispose(l);
Items.Remove(l);
end else Inc(i);
end;
end;
begin
Items.Create;
Calc := False;
Res := GetVarLink(res);
while True do begin
if Parser^.CurrTokenId = StopOn then
Break;
case Parser^.CurrTokenId of
CSTII_Else,
CSTII_To,
CSTII_DownTo,
CSTII_do,
CSTI_Semicolon,
CSTII_End,
CSTI_Comma,
CSTI_CloseRound:
begin
Break;
end; {Csti_Else...}
CSTI_EOF:
begin
RunError(EUnexpectedEndOfFile);
DisposeList;
Exit;
end; {CSTI_Eof}
CSTI_SyntaxError,
CSTI_CommentEOFError,
CSTI_CharError:
begin
RunError(ESyntaxError);
DisposeList;
Exit;
end; {Csti_SyntaxError...}
CSTI_StringError:
begin
RunError(EStringError);
DisposeList;
Exit;
end; {csti_Stringerror}
end; {case}
if (Items.Count and $1) = 0 then
begin
PreCalc := '';
while (Parser^.CurrTokenId = CSTI_Minus) or
(Parser^.CurrTokenId = CSTII_Not) or
(Parser^.CurrTokenId = CSTI_Plus)
do begin
if (Parser^.CurrTokenId = CSTI_Minus) then
PreCalc := PreCalc + '-';
if (Parser^.CurrTokenId = CSTII_Not) then
PreCalc := PreCalc + '|';
if (Parser^.CurrTokenId = CSTI_Plus) then
PreCalc := PreCalc + '+';
NextNoJunk(Parser);
end; {While}
New(Work);
case Parser^.CurrTokenId of
CSTI_OpenRound:
begin
NextNoJunk(Parser);
Work^.CajVariant := CreateCajVariant(CSV_Var, 0);
Work^.CajVariant^.Cv_Var := nil;
Work^.TType := 0;
if not Calc(vars, Work^.CajVariant, CSTI_CloseRound) then
begin
DestroyCajVariant(Work^.CajVariant);
Dispose(Work);
DisposeList;
Exit;
end; {if}
if not DoPreCalc then
begin
DestroyCajVariant(Work^.CajVariant);
Dispose(Work);
DisposeList;
Exit;
end; {if}
NextNoJunk(Parser);
Items.Add(Work);
end; {CSTI_OpenRound}
CSTI_Identifier:
begin
if Assigned(vars) and (Vm_Find(Vars, FastUppercase(GetToken(Parser)))
<> -1) then
begin
Temp4 := GetVarLink(Vm_Get(Vars, Vm_Find(Vars,
FastUppercase(GetToken(Parser)))));
if not CalcArrayInt(Vars, Temp4) then
Exit;
NextNoJunk(Parser);
Work^.CajVariant := CreateCajVariant(Temp4^.VType, 0);
Work^.TType := 0;
if not PerForm(Work^.CajVariant, Temp4, ptSet) then
begin
DestroyCajVariant(Work^.CajVariant);
Dispose(Work);
DisposeList;
Exit;
end; {if}
end {if}
else if Vm_Find(Variables, FastUppercase(GetToken(Parser))) <> -1
then
begin
Temp4 := GetVarLink(Vm_Get(Variables,
Vm_Find(Variables, FastUppercase(GetToken(Parser)))));
if not CalcArrayInt(Vars, Temp4) then
Exit;
NextNoJunk(Parser);
Work^.CajVariant := CreateCajVariant(Temp4^.VType, 0);
Work^.TType := 0;
if not PerForm(Work^.CajVariant, Temp4, ptSet) then
begin
DestroyCajVariant(Work^.CajVariant);
Dispose(Work);
DisposeList;
Exit;
end; {if}
end {if}
else if PM_Find(Procedures, FastUpperCase(GetToken(Parser))) <> -1
then
begin
Temp4 := DoProc(vars, False);
if Temp4 = nil then
begin
Dispose(Work);
DisposeList;
Exit;
end; {if}
Work^.CajVariant := CreateCajVariant(Temp4^.VType, 0);
Work^.TType := 0;
PerForm(Work^.CajVariant, Temp4, ptSet);
end {else if}
else if PM_Find(InternalProcedures, FastUpperCase(GetToken(Parser)))
<> -1 then
begin
Temp4 := DoProc(vars, True);
if ErrorCode <> ENoError then
begin
Dispose(Work);
DisposeList;
Exit;
end; {if}
Work^.CajVariant := CreateCajVariant(Temp4^.VType, 0);
Work^.TType := 0;
PerForm(Work^.CajVariant, Temp4, ptSet);
end {else if}
else
begin
RunError(EUnknownIdentifier);
Dispose(Work);
DisposeList;
Exit;
end; {else else if}
Items.Add(Work);
end; {CSTI_Identifier}
CSTI_Integer:
begin
if ((Res^.VType >= csv_SByte) and (Res^.VType <= Csv_SInt32)) or
((res^.VType >= csv_Real) and (res^.vtype <= csv_comp)) then
Work^.CajVariant := CreateCajVariant(res^.VType, 0)
else
Work^.CajVariant := CreateCajVariant(csv_SInt32, 0);
Work^.TType := 0;
if IsRealType(work^.CajVariant) then
SetReal(Work^.CajVariant, StrToInt(GetToken(Parser)))
else
SetInteger(Work^.CajVariant, StrToInt(GetToken(Parser)));
if not DoPreCalc then
begin
DestroyCajVariant(Work^.CajVariant);
Dispose(Work);
DisposeList;
Exit;
end; {if}
NextNoJunk(Parser);
Items.Add(Work);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -