pax_javascript.pas

来自「Delphi脚本控件」· PAS 代码 · 共 2,775 行 · 第 1/5 页

    SymbolTable.Position[SubID] := SymbolTable.Position[LeftSideID]
  else
    SymbolTable.Position[SubID] := SymbolTable.Position[ClassID];

  result := SubID;

  Name[SubID] := Name[ClassID];
  LevelStack.PushSub(SubID, CurrClassID, ml);

  ResID := NewVar;
  NewVar;

  Match('(');
  DeclareSwitch := true;
  Call_SCANNER;
  ParamCount := 0;
  if not IsCurrText(')') then
  repeat
    Inc(ParamCount);
    ParamID := Parse_Ident;

    if IsCurrText('=') then
    begin
      TempCard := SymbolTable.Card;
      Call_SCANNER;
      ValID := Parse_AssignmentExpression;
      with TPaxBaseScripter(Scripter) do
        DefaultParameterList.AddParameter(SubID, ParamID,
                                          SymbolTable.VariantValue[ValID]);
      SymbolTable.EraseTail(TempCard);
    end;

    if IsCurrText(',') then
      Call_SCANNER
    else
      Break;
  until false;
  DeclareSwitch := false;
  Match(')');

  Kind[SubID] := KindSUB;
  Count[SubID] := ParamCount;
  Next[SubID] := ResID;
  TypeSub[SubID] := tsConstructor;
  if Code.Prog[Code.Card].OP = OP_SEPARATOR then
    Value[SubID] := Code.Card
  else
    Value[SubID] := Code.Card + 1;

  Name[CurrThisID] := 'this';
  if LeftSideClassID > 0 then
     TypeID[CurrThisID] := LeftSideClassID
  else
     TypeID[CurrThisID] := ClassID;

  if TPAXJavaScriptScanner(Scanner).UsesIdent('arguments') then
  begin

    for I:=ParamCount + 1 to MaxArg do
    begin
      ID1 := NewVar;
      Name[ID1] := '_' + IntToStr(I);
    end;

    ArgumentsID := NewVar;
    Name[ArgumentsID] := 'arguments';

    CreateArguments;

  end;

{
  if TPAXJavaScriptScanner(Scanner).UsesIdent('this') then
  begin
 //     29   Line     5    this = base.Function();                :20009
//     32     CREATE REF      this[20011]                 1   Function[20013]
//     33           CALL  Function[20013]                 0           $$20014
//     34             :=      this[20011]           $$20014       this[20011]

    ID1 := NewVar;
    ID2 := NewVar;
    Name[ID1] := 'Function';
    GenRef(CurrThisID, maMyBase, ID1);
    Gen(OP_CALL, ID1, 0, ID2);
    Gen(OP_ASSIGN, CurrThisID, ID2, CurrThisID);
  end;
}

  Call_SCANNER;
  Match('{');
  Gen(OP_DECLARE_OFF, 0, 0, 0);

  Parse_Block;

  GenDestroyLocalVars;

  Gen(OP_RET, 0, 0, 0);
  SetLabelHere(L);
  Gen(OP_SAVE_RESULT, ClassID, 0, 0);

  if TPaxBaseScripter(Scripter).EvalCount > 0 then
    Gen(OP_ASSIGN, PrototypeID, FunctionObjectID, PrototypeID)
  else
  begin
    ID1 := NewVar;
    Name[ID1] := 'Function';
    SymbolTable.Level[ID1] := -1;
    Gen(OP_EVAL_WITH, 0, 0, ID1);
    ID2 := NewVar;
    Gen(OP_CREATE_OBJECT, ID1, 0, ID2);
    Gen(OP_CREATE_REF, ID2, 0, ID1);
    Gen(OP_CALL, ID1, 0, ID1);
    Gen(OP_ASSIGN, PrototypeID, ID1, PrototypeID);
  end;

  ID1 := NewField('constructor');
  Gen(OP_CREATE_REF, PrototypeID, 0, ID1);
  Gen(OP_ASSIGN, ID1, ClassID, ID1);

  LevelStack.Pop;
  LevelStack.Pop;

  LinkVariables(SubID, false);

  Call_SCANNER;
end;

procedure TPaxJavaScriptParser.Parse_ReturnStmt;
var
  ResID: Integer;
begin
  // match "return"

  ResID := SymbolTable.GetResultID(CurrLevel);

  Call_SCANNER;

  if not IsCurrText(';') then
      Gen(OP_ASSIGN_RESULT, ResID, Parse_Expression, ResID);

  Gen(OP_RETURN, 0, 0, 0);
end;

procedure TPaxJavaScriptParser.Parse_HaltStmt;
begin
  // match "halt"
  Call_SCANNER;
  if not IsCurrText(';') then
    Call_SCANNER;
  Gen(OP_HALT_GLOBAL, 0, 0, 0);
end;

procedure TPaxJavaScriptParser.Parse_SwitchStmt;

procedure Match(const S: String);
begin
  Self.Match(S);
  Call_SCANNER;
end;

var
  lg, l_default, bool_id, expr_id, case_expr_id, lf, l_skip, I, N1, N2: Integer;
  lt: TPaxStack;
  n_skips: TPaxIds;
begin
	lg := NewLabel();
	l_default := NewLabel();

	lt := TPaxStack.Create;
  n_skips := TPaxIds.Create(true);

	bool_id := NewVar();
	Gen(OP_ASSIGN, bool_id, symboltable.IDTRUE, bool_id);
  EntryStack.Push(lg, 0, StatementLabel);

	Match('switch');
	Match('(');
	expr_id := Parse_Expression();
	Match(')');
	Match('{'); // parse switch block

  repeat // parse switch sections

    repeat // parse switch labels
      if (IsCurrText('case')) then
      begin
        Match('case');

        lt.Push(NewLabel());
        case_expr_id := Parse_Expression();
        Gen(OP_EQ, expr_id, case_expr_id, bool_id);
        Gen(OP_GO_TRUE, lt.Top(), bool_id, 0);
      end
      else if (IsCurrText('default')) then
      begin
        Match('default');
        SetLabelHere(l_default);
        Gen(OP_ASSIGN, bool_id, symboltable.IDTRUE, bool_id);
      end
      else
        break; //switch labels
      Match(':');
    until false;

    while (lt.Card > 0) do
      SetLabelHere(lt.Pop());

    lf := NewLabel();
    Gen(OP_GO_FALSE, lf, bool_id, 0);

    // parse statement list
    repeat
      if (IsCurrText('case')) then
        break;
      if (IsCurrText('default')) then
        break;
      if (IsCurrText('}')) then
        break;

      l_skip := NewLabel();
      SetLabelHere(l_skip);
      Parse_Statement;
      Gen(OP_GO, l_skip, 0, 0);
      n_skips.Add(Code.Card);

    until false;
    SetLabelHere(lf);

    if (IsCurrText('}')) then
      break;
  until false;

	EntryStack.Pop();
	SetLabelHere(lg);
	Match('}');

  if n_skips.Count >= 2 then
  for I:=0 to n_skips.Count - 2 do
  begin
    N1 := n_skips[I];
    N2 := n_skips[I+1];
    Code.Prog[N1].Arg1 := Code.Prog[N2].Arg1;
  end;
  N1 := n_skips[n_skips.Count - 1];
  Code.Prog[N1].Op := OP_NOP;

  lt.Free;
  n_skips.Free;
end;

procedure TPaxJavaScriptParser.Parse_WithStmt;
var
  ID, ID2: Integer;
begin
  // match "with"
  Call_SCANNER;
  Match('(');
  Call_SCANNER;
  ID := Parse_Expression;
  if IsCallOperator then
  begin
    ID2 := NewVar;
    Gen(OP_ASSIGN, ID2, ID, ID2);
    Gen(OP_BEGIN_WITH, WithStack.Push(ID2), 0, 0);
  end
  else
    Gen(OP_BEGIN_WITH, WithStack.Push(ID), 0, 0);
  Match(')');

  Call_SCANNER;
  Parse_Statement;

  Gen(OP_END_WITH, 0, 0, 0);
  WithStack.Pop;
end;

procedure TPaxJavaScriptParser.Parse_ThrowStmt;
var
  ID: Integer;
begin
  // match "throw"

  Call_SCANNER;

  if IsCurrText(';') then
  begin
    ID := 0;
    Call_SCANNER;
  end
  else
  begin
    ID := Parse_Expression;
  end;
  Gen(OP_THROW, ID, 0, 0);
end;

procedure TPaxJavaScriptParser.Parse_TryStmt;
var
  L, LTRY, ID: Integer;
begin
  // match "try"

  LTRY := NewLabel;
  Gen(OP_TRY_ON, LTRY, 0, 0);

  Call_SCANNER;
  Parse_Block;
  Call_SCANNER;

  L := NewLabel;
  Gen(OP_GO, L, 0, 0);

  if  not IsCurrText('catch') or IsCurrText('finally') then
    Match('catch');

  while IsCurrText('catch') do
  begin
    Call_SCANNER;
    Match('(');
    DeclareSwitch := true;
    Call_SCANNER;
    ID := Parse_Ident;
    Gen(OP_CATCH, ID, 0, 0);
    DeclareSwitch := false;
    Match(')');

    CurrClassRec.AddField(ID, [modSTATIC]);

    Call_SCANNER;
    Parse_Block;
    Call_SCANNER;

    Gen(OP_DISCARD_ERROR, 0, 0, 0);
  end;

  SetLabelHere(L);

  if IsCurrText('finally') then
  begin
    Gen(OP_FINALLY, 0, 0, 0);
    Call_SCANNER;
    Parse_Block;
    Call_SCANNER;
    Gen(OP_EXIT_ON_ERROR, 0, 0, 0);
  end;

  SetLabelHere(LTRY);
  Gen(OP_TRY_OFF, 0, 0, 0);
end;

function TPaxJavaScriptParser.Parse_VarStmt(IsField: Boolean;
                                            ml: TPAXModifierList;
                                            IsLoopVar: Boolean = false): Integer;
begin
  DeclareSwitch := true;

  DuplicateVars := true;
  Call_SCANNER;
  DuplicateVars := false;

  result := Parse_VariableDeclaration(IsField, ml, IsLoopVar);

  while IsCurrText(',') do
  begin
    DeclareSwitch := true;

    Call_SCANNER;
    result := Parse_VariableDeclaration(IsField, ml, IsLoopVar);
  end;

  DeclareSwitch := false;
end;

function TPaxJavaScriptParser.Parse_VariableDeclaration(IsField: Boolean;
                                                        ml: TPAXModifierList;
                                                        IsLoopVar: Boolean = false): Integer;
var
  ID, ArrID, Vars: Integer;
  MemberRec: TPAXMemberRec;
  S: String;
begin
  MemberRec := nil;

  result := Parse_Ident;

  if IsField then
    MemberRec := CurrClassRec.AddField(result, ml)
  else if (CurrClassID > 0) and (CurrSubID = 0) then
    CurrClassRec.AddField(result, ml + [modSTATIC])
  else if CurrSubID > 0 then
  begin
    S := SymbolTable.Name[result];
    SymbolTable.DecCard;
    ID := SymbolTable.LookUpID(S, CurrSubId);
    SymbolTable.IncCard;
    if ID > 0 then
    begin
      if ID <> result then
        SymbolTable.Name[result] := '';
      result := ID;
    end
    else
    SymbolTable.SetLocal(result);

    LocalVars.Add(result);
  end;

  if IsCurrText('[') then
  begin
    if MemberRec <> nil then
      MemberRec.InitN := LastCodeLine;

    DeclareSwitch := false;
    Call_SCANNER;
    ArrID := 0;
    Gen(OP_CREATE_ARRAY, result, Parse_ArgumentList(ArrID, Vars), 0);

    if MemberRec <> nil then
       Gen(OP_HALT, 0, 0, 0);

    Match(']');
    Call_SCANNER;
  end
  else if IsCurrText('=') then
  begin
    Gen(OP_NOP, 0, 0, 0);

    if (MemberRec <> nil) and (not IsLoopVar) then
      MemberRec.InitN := LastCodeLine;

    DeclareSwitch := false;
    Call_SCANNER;

    LeftSideID := result;

    ID := Parse_AssignmentExpression;

    if ID = UndefinedID then
      Gen(OP_DESTROY_INTF, result, 0, 0);

    Gen(OP_ASSIGN, result, ID, result);
    if (MemberRec <> nil) and (not IsLoopVar) then
       Gen(OP_HALT, 0, 0, 0);

    TempObjectList.Clear;
  end;
end;

procedure TPaxJavaScriptParser.Parse_ExpressionStmt;
begin
  Gen(OP_SAVE_RESULT, Parse_Expression, 0, 0);
end;

procedure TPaxJavaScriptParser.Parse_StmtList;
begin
  repeat
    if CurrToken.ID = SP_POINT then
      Exit
    else if CurrToken.ID = SP_EOF then
      Exit
    else
      Parse_Statement;
  until false;
  IsExecutable := true;
  Gen(OP_SKIP, 0, 0, 0);
  IsExecutable := false;
end;

procedure TPaxJavaScriptParser.Parse_SourceElements;
begin
  repeat
    if CurrToken.ID = SP_POINT then
      Exit
    else if CurrToken.ID = SP_EOF then
      Exit
    else
      Parse_Statement;
  until false;
end;

procedure TPaxJavaScriptParser.CreateGlobalObjects;
var
  ID: Integer;
begin
  ID := NewVar;
  Name[ID] := 'Function';
  SymbolTable.Level[ID] := -1;
  Gen(OP_EVAL_WITH, 0, 0, ID);
  FunctionObjectID := NewVar;
  Gen(OP_CREATE_OBJECT, ID, 0, FunctionObjectID);
  Gen(OP_CREATE_REF, FunctionObjectID, 0, ID);
  Gen(OP_CALL, ID, 0, ID);
  Gen(OP_ASSIGN, FunctionObjectID, ID, FunctionObjectID);
end;

procedure TPaxJavaScriptParser.GenDestroyLocalVars;
var
  I, J, ID, SubID: Integer;
//  ok: Boolean;
begin
  SubID := LevelStack.Top;
  for I := LocalVars.Count - 1 downto 0 do
  begin
    ID := LocalVars[I];
    if SymbolTable.Level[ID] = SubID then
    if SymbolTable.GetResultID(SubId) <> ID then
    begin
//      ok := false;
      for J:=1 to Code.Card do
        if (Code.Prog[J].Op = OP_ASSIGN_RESULT) and (Code.Prog[J].Arg2 = ID) then
        begin
//          ok := true;
          break;
        end;

//      if not ok then
//        Gen(OP_DESTROY_OBJECT, ID, 0, 0);
        
      LocalVars.Delete(I);
    end;
  end;
end;


procedure TPaxJavaScriptParser.Parse_Program;
begin
  if CurrToken.ID = SP_EOF then
    Exit;

  if DeclareVariables then
    Gen(OP_DECLARE_ON, 0, 0, 0)
  else
    Gen(OP_DECLARE_OFF, 0, 0, 0);

  if VBArrays then
    Gen(OP_VBARRAYS_ON, 0, 0, 0)
  else
    Gen(OP_VBARRAYS_OFF, 0, 0, 0);

  Gen(OP_UPCASE_OFF, 0, 0, 0);
  Gen(OP_JS_OPERS_ON, 0, 0, 0);

  if ZeroBasedStrings then
    Gen(OP_ZERO_BASED_STRINGS_ON, 0, 0, 0)
  else
    Gen(OP_ZERO_BASED_STRINGS_OFF, 0, 0, 0);

  CreateGlobalObjects;

  Parse_SourceElements;
end;

end.