1247 lines
36 KiB
ObjectPascal
1247 lines
36 KiB
ObjectPascal
////////////////////////////////////////////////////////////////////////////
|
|
// PaxCompiler
|
|
// Site: http://www.paxcompiler.com
|
|
// Author: Alexander Baranovsky (paxscript@gmail.com)
|
|
// ========================================================================
|
|
// Copyright (c) Alexander Baranovsky, 2006-2014. All rights reserved.
|
|
// Code Version: 4.2
|
|
// ========================================================================
|
|
// Unit: PAXCOMP_JS_CONV.pas
|
|
// ========================================================================
|
|
////////////////////////////////////////////////////////////////////////////
|
|
|
|
{$I PaxCompiler.def}
|
|
unit PAXCOMP_JS_CONV;
|
|
interface
|
|
uses {$I uses.def}
|
|
SysUtils,
|
|
Classes,
|
|
PAXCOMP_CONSTANTS,
|
|
PAXCOMP_TYPES,
|
|
PAXCOMP_SYS,
|
|
PAXCOMP_KERNEL,
|
|
PAXCOMP_BYTECODE,
|
|
PAXCOMP_BASESYMBOL_TABLE,
|
|
PAXCOMP_SYMBOL_TABLE,
|
|
PAXCOMP_SYMBOL_REC,
|
|
PAXCOMP_EMIT,
|
|
PAXCOMP_JavaScript,
|
|
PaxCompiler, PaxProgram, PaxRegister, PaxBasicLanguage;
|
|
const
|
|
HOST_INSTANCE = 'HostInstance';
|
|
type
|
|
TJSConverter = class
|
|
private
|
|
Kernel: TKernel;
|
|
Code: TCode;
|
|
CR: TCodeRec;
|
|
SymbolTable: TSymbolTable;
|
|
|
|
fResult: TStringList;
|
|
|
|
indent: Integer;
|
|
indent_delta: Integer;
|
|
|
|
used_labels: TIntegerList;
|
|
PushOperators: TIntegerList;
|
|
|
|
EmitList: array of TEmitProc;
|
|
|
|
saved_names: TAssocStrings;
|
|
|
|
procedure SaveUnusedLabels;
|
|
function IsTempName(Id: Integer): Boolean;
|
|
function GetName(Id: Integer): String;
|
|
function GetLabelName(Id: Integer): String;
|
|
function GetSelfName(Id: Integer): String;
|
|
function GetSymbolRec(Id: Integer): TSymbolRec;
|
|
procedure EmitNothing;
|
|
procedure CreateEmitProcList;
|
|
procedure Emit(const S: String);
|
|
|
|
procedure EmitOP_SEPARATOR;
|
|
procedure EmitOP_ASSIGN;
|
|
|
|
procedure EmitOP_ADD;
|
|
procedure EmitOP_SUB;
|
|
procedure EmitOP_MULT;
|
|
procedure EmitOP_DIV;
|
|
procedure EmitOP_IDIV;
|
|
procedure EmitOP_MOD;
|
|
procedure EmitOP_AND;
|
|
procedure EmitOP_OR;
|
|
procedure EmitOP_SHL;
|
|
procedure EmitOP_SHR;
|
|
|
|
procedure EmitOP_GT;
|
|
procedure EmitOP_GE;
|
|
procedure EmitOP_LT;
|
|
procedure EmitOP_LE;
|
|
procedure EmitOP_EQ;
|
|
procedure EmitOP_NE;
|
|
procedure EmitOP_GO_FALSE;
|
|
procedure EmitOP_GO_TRUE;
|
|
procedure EmitOP_GO;
|
|
procedure EmitOP_EXIT;
|
|
procedure EmitOP_LABEL;
|
|
procedure EmitOP_PRINT_EX;
|
|
procedure EmitOP_INIT_SUB;
|
|
procedure EmitOP_END_SUB;
|
|
procedure EmitOP_CALL;
|
|
procedure EmitOP_ELEM;
|
|
procedure EmitOP_DECLARE_LOCAL_VAR;
|
|
|
|
procedure EmitOP_SET_PROP;
|
|
procedure EmitOP_GET_PROP;
|
|
procedure EmitOP_XXX_FROM_XXX;
|
|
|
|
procedure EmitOP_TRY_ON;
|
|
procedure EmitOP_TRY_OFF;
|
|
procedure EmitOP_FINALLY;
|
|
|
|
procedure RaiseError(const Message: string; params: array of Const); overload;
|
|
procedure RaiseError; overload;
|
|
|
|
public
|
|
constructor Create(compiler: TPaxCompiler);
|
|
destructor Destroy; override;
|
|
procedure GenJavaScript(const ModuleName: String);
|
|
property JSCode: TStringList read fResult;
|
|
end;
|
|
|
|
implementation
|
|
|
|
constructor TJSConverter.Create(compiler: TPaxCompiler);
|
|
begin
|
|
inherited Create;
|
|
Kernel := TKernel(compiler.GetKernelPtr);
|
|
Code := Kernel.Code;
|
|
SymbolTable := Kernel.SymbolTable;
|
|
fResult := TStringList.Create;
|
|
used_labels := TIntegerList.Create;
|
|
indent_delta := 2;
|
|
|
|
saved_names := TAssocStrings.Create;
|
|
|
|
CreateEmitProcList;
|
|
|
|
PushOperators := TIntegerList.Create;
|
|
|
|
with PushOperators do
|
|
begin
|
|
Add(OP_PUSH_ADDRESS);
|
|
Add(OP_PUSH_STRUCTURE);
|
|
Add(OP_PUSH_SET);
|
|
|
|
Add(OP_PUSH_BYTE_IMM);
|
|
Add(OP_PUSH_BYTE);
|
|
Add(OP_PUSH_WORD_IMM);
|
|
Add(OP_PUSH_WORD);
|
|
Add(OP_PUSH_CARDINAL_IMM);
|
|
Add(OP_PUSH_CARDINAL);
|
|
Add(OP_PUSH_SMALLINT_IMM);
|
|
Add(OP_PUSH_SMALLINT);
|
|
Add(OP_PUSH_SHORTINT_IMM);
|
|
Add(OP_PUSH_SHORTINT);
|
|
Add(OP_PUSH_INT_IMM);
|
|
Add(OP_PUSH_INT);
|
|
Add(OP_PUSH_DOUBLE);
|
|
Add(OP_PUSH_CURRENCY);
|
|
Add(OP_PUSH_SINGLE);
|
|
Add(OP_PUSH_EXTENDED);
|
|
Add(OP_PUSH_ANSISTRING);
|
|
Add(OP_PUSH_SHORTSTRING);
|
|
Add(OP_PUSH_WIDESTRING);
|
|
Add(OP_PUSH_UNICSTRING);
|
|
Add(OP_PUSH_PANSICHAR_IMM);
|
|
Add(OP_PUSH_PWIDECHAR_IMM);
|
|
Add(OP_PUSH_DYNARRAY);
|
|
Add(OP_PUSH_OPENARRAY);
|
|
Add(OP_PUSH_INT64);
|
|
Add(OP_PUSH_DATA);
|
|
Add(OP_PUSH_EVENT);
|
|
end;
|
|
|
|
end;
|
|
|
|
destructor TJSConverter.Destroy;
|
|
begin
|
|
FreeAndNil(fResult);
|
|
FreeAndNil(used_labels);
|
|
FreeAndNil(PushOperators);
|
|
FreeAndNil(saved_names);
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJSConverter.EmitNothing;
|
|
begin
|
|
end;
|
|
|
|
procedure TJSConverter.CreateEmitProcList;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetLength(EmitList, - OP_DUMMY);
|
|
|
|
for I:=0 to Length(EmitList) - 1 do
|
|
EmitList[I] := EmitNothing;
|
|
|
|
EmitList[ - OP_SEPARATOR ] := EmitOP_SEPARATOR;
|
|
//assign
|
|
EmitList[ - OP_ASSIGN ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_BYTE_I ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_BYTE_M ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_WORD_I ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_WORD_M ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_CARDINAL_I ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_CARDINAL_M ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_SMALLINT_I ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_SMALLINT_M ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_SHORTINT_I ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_SHORTINT_M ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_INT_I ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_INT_M ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_DOUBLE ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_CURRENCY ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_EVENT ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_SINGLE ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_EXTENDED ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_PANSICHAR ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_PWIDECHAR ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_INT64 ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_INTERFACE ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_ANSISTRING ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_SHORTSTRING ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_WIDESTRING ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_UNICSTRING ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_VARIANT ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_OLEVARIANT ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_CLASS ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_TVarRec ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_RECORD ] := EmitOP_ASSIGN;
|
|
EmitList[ - OP_ASSIGN_ARRAY ] := EmitOP_ASSIGN;
|
|
//add
|
|
EmitList[ - OP_ADD_ANSISTRING ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_SHORTSTRING ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_WIDESTRING ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_UNICSTRING ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_STRING ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_VARIANT ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_INT_MI ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_INT_MM ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_INT64 ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_CURRENCY ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_DOUBLE ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_SINGLE ] := EmitOP_ADD;
|
|
EmitList[ - OP_ADD_EXTENDED ] := EmitOP_ADD;
|
|
//sub
|
|
EmitList[ - OP_SUB_VARIANT ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_INT_MI ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_INT_MM ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_INT64 ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_CURRENCY ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_DOUBLE ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_SINGLE ] := EmitOP_SUB;
|
|
EmitList[ - OP_SUB_EXTENDED ] := EmitOP_SUB;
|
|
//mult
|
|
EmitList[ - OP_MULT_VARIANT ] := EmitOP_MULT;
|
|
EmitList[ - OP_IMUL_INT_MI ] := EmitOP_MULT;
|
|
EmitList[ - OP_IMUL_INT_MM ] := EmitOP_MULT;
|
|
EmitList[ - OP_MULT_INT64 ] := EmitOP_MULT;
|
|
EmitList[ - OP_MUL_CURRENCY ] := EmitOP_MULT;
|
|
EmitList[ - OP_MUL_DOUBLE ] := EmitOP_MULT;
|
|
EmitList[ - OP_MUL_SINGLE ] := EmitOP_MULT;
|
|
EmitList[ - OP_MUL_EXTENDED ] := EmitOP_MULT;
|
|
//div
|
|
EmitList[ - OP_DIV_VARIANT ] := EmitOP_DIV;
|
|
EmitList[ - OP_DIV_CURRENCY ] := EmitOP_DIV;
|
|
EmitList[ - OP_DIV_DOUBLE ] := EmitOP_DIV;
|
|
EmitList[ - OP_DIV_SINGLE ] := EmitOP_DIV;
|
|
EmitList[ - OP_DIV_EXTENDED ] := EmitOP_DIV;
|
|
//idiv
|
|
EmitList[ - OP_IDIV_VARIANT ] := EmitOP_IDIV;
|
|
EmitList[ - OP_IDIV_INT64 ] := EmitOP_IDIV;
|
|
EmitList[ - OP_IDIV_INT_MI ] := EmitOP_IDIV;
|
|
EmitList[ - OP_IDIV_INT_MM] := EmitOP_IDIV;
|
|
EmitList[ - OP_IDIV_INT_IM ] := EmitOP_IDIV;
|
|
//mod
|
|
EmitList[ - OP_MOD_VARIANT ] := EmitOP_MOD;
|
|
EmitList[ - OP_MOD_INT64 ] := EmitOP_MOD;
|
|
EmitList[ - OP_MOD_INT_MI ] := EmitOP_MOD;
|
|
EmitList[ - OP_MOD_INT_MM] := EmitOP_MOD;
|
|
EmitList[ - OP_MOD_INT_IM ] := EmitOP_MOD;
|
|
//and
|
|
EmitList[ - OP_AND_VARIANT ] := EmitOP_AND;
|
|
EmitList[ - OP_AND_INT64 ] := EmitOP_AND;
|
|
EmitList[ - OP_AND_INT_MI ] := EmitOP_AND;
|
|
EmitList[ - OP_AND_INT_MM] := EmitOP_AND;
|
|
//or
|
|
EmitList[ - OP_OR_VARIANT ] := EmitOP_OR;
|
|
EmitList[ - OP_OR_INT64 ] := EmitOP_OR;
|
|
EmitList[ - OP_OR_INT_MI ] := EmitOP_OR;
|
|
EmitList[ - OP_OR_INT_MM] := EmitOP_OR;
|
|
//shl
|
|
EmitList[ - OP_SHL_VARIANT ] := EmitOP_SHL;
|
|
EmitList[ - OP_SHL_INT64 ] := EmitOP_SHL;
|
|
EmitList[ - OP_SHL_INT_MI ] := EmitOP_SHL;
|
|
EmitList[ - OP_SHL_INT_MM] := EmitOP_SHL;
|
|
//shr
|
|
EmitList[ - OP_SHR_VARIANT ] := EmitOP_SHR;
|
|
EmitList[ - OP_SHR_INT64 ] := EmitOP_SHR;
|
|
EmitList[ - OP_SHR_INT_MI ] := EmitOP_SHR;
|
|
EmitList[ - OP_SHR_INT_MM] := EmitOP_SHR;
|
|
//gt
|
|
EmitList[ - OP_GT_ANSISTRING ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_SHORTSTRING ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_WIDESTRING ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_UNICSTRING ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_VARIANT ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_INT_MI ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_INT_MM ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_INT64 ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_CURRENCY ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_DOUBLE ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_SINGLE ] := EmitOP_GT;
|
|
EmitList[ - OP_GT_EXTENDED ] := EmitOP_GT;
|
|
//ge
|
|
EmitList[ - OP_GE_ANSISTRING ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_SHORTSTRING ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_WIDESTRING ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_UNICSTRING ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_VARIANT ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_INT_MI ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_INT_MM ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_INT64 ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_CURRENCY ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_DOUBLE ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_SINGLE ] := EmitOP_GE;
|
|
EmitList[ - OP_GE_EXTENDED ] := EmitOP_GE;
|
|
//lt
|
|
EmitList[ - OP_LT_ANSISTRING ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_SHORTSTRING ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_WIDESTRING ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_UNICSTRING ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_VARIANT ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_INT_MI ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_INT_MM ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_INT64 ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_CURRENCY ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_DOUBLE ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_SINGLE ] := EmitOP_LT;
|
|
EmitList[ - OP_LT_EXTENDED ] := EmitOP_LT;
|
|
//le
|
|
EmitList[ - OP_LE_ANSISTRING ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_SHORTSTRING ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_WIDESTRING ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_UNICSTRING ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_VARIANT ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_INT_MI ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_INT_MM ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_INT64 ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_CURRENCY ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_DOUBLE ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_SINGLE ] := EmitOP_LE;
|
|
EmitList[ - OP_LE_EXTENDED ] := EmitOP_LE;
|
|
//eq
|
|
EmitList[ - OP_EQ_ANSISTRING ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_SHORTSTRING ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_WIDESTRING ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_UNICSTRING ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_VARIANT ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_INT_MI ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_INT_MM ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_INT64 ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_CURRENCY ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_DOUBLE ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_SINGLE ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_EXTENDED ] := EmitOP_EQ;
|
|
EmitList[ - OP_EQ_STRUCT ] := EmitOP_EQ;
|
|
//ne
|
|
EmitList[ - OP_NE_ANSISTRING ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_SHORTSTRING ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_WIDESTRING ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_UNICSTRING ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_VARIANT ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_INT_MI ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_INT_MM ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_INT64 ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_CURRENCY ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_DOUBLE ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_SINGLE ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_EXTENDED ] := EmitOP_NE;
|
|
EmitList[ - OP_NE_STRUCT ] := EmitOP_EQ;
|
|
|
|
EmitList[ - OP_GO_FALSE ] := EmitOP_GO_FALSE;
|
|
EmitList[ - OP_GO_TRUE ] := EmitOP_GO_TRUE;
|
|
EmitList[ - OP_GO ] := EmitOP_GO;
|
|
EmitList[ - OP_EXIT ] := EmitOP_EXIT;
|
|
EmitList[ - OP_LABEL ] := EmitOP_LABEL;
|
|
EmitList[ - OP_PRINT_EX ] := EmitOP_PRINT_EX;
|
|
EmitList[ - OP_INIT_SUB ] := EmitOP_INIT_SUB;
|
|
EmitList[ - OP_END_SUB ] := EmitOP_END_SUB;
|
|
EmitList[ - OP_CALL ] := EmitOP_CALL;
|
|
EmitList[ - OP_CALL_DEFAULT_CONSTRUCTOR ] := EmitOP_CALL;
|
|
EmitList[ - OP_ELEM ] := EmitOP_ELEM;
|
|
EmitList[ - OP_DECLARE_LOCAL_VAR ] := EmitOP_DECLARE_LOCAL_VAR;
|
|
|
|
EmitList[ - OP_SET_UNICSTR_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_DRTTI_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_ANSISTR_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_WIDESTR_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_ORD_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_SET_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_FLOAT_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_VARIANT_PROP ] := EmitOP_SET_PROP;
|
|
EmitList[ - OP_SET_INT64_PROP ] := EmitOP_SET_PROP;
|
|
|
|
EmitList[ - OP_GET_UNICSTR_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_DRTTI_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_ANSISTR_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_WIDESTR_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_ORD_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_SET_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_FLOAT_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_VARIANT_PROP ] := EmitOP_GET_PROP;
|
|
EmitList[ - OP_GET_INT64_PROP ] := EmitOP_GET_PROP;
|
|
|
|
EmitList[ - OP_UNICSTRING_FROM_PWIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VAR_FROM_TVALUE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_CURRENCY_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_CURRENCY_FROM_INT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_CURRENCY_FROM_REAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_INT_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_BYTE_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WORD_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_CARDINAL_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SMALLINT_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTINT_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_PANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_PWIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_ANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_PANSICHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_PWIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_ANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_WIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_ANSISTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_WIDESTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_WIDESTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_UNICSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_SHORTSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_PANSICHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_PWIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_ANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_WIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_WIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_WIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_ANSISTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_ANSISTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_SHORTSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_UNICSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_SHORTSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_WIDESTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_UNICSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_PANSICHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_PWIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_ANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_WIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_WIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_INTERFACE_FROM_CLASS ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_PANSICHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_PWIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_ANSISTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_WIDESTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_UNICSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_SHORTSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_ANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_WIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_WIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_INT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_BYTE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_BOOL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_WORD ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_CARDINAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_SMALLINT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_SHORTINT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_DOUBLE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_CURRENCY ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_SINGLE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_EXTENDED ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_VARIANT_FROM_INTERFACE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_PANSICHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_PWIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_ANSISTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_WIDESTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_UNICSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_SHORTSTRING ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_ANSICHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_WIDECHAR ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_WIDECHAR_LITERAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_INT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_INT64 ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_BYTE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_BOOL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_WORD ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_CARDINAL ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_SMALLINT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_SHORTINT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_DOUBLE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_CURRENCY ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_SINGLE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_EXTENDED ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_OLEVARIANT_FROM_INTERFACE ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSICHAR_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDECHAR_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_ANSISTRING_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WIDESTRING_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_UNICSTRING_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTSTRING_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_DOUBLE_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_CURRENCY_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SINGLE_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_EXTENDED_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_INT64_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_INT_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_BYTE_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WORD_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_CARDINAL_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_BOOL_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_BYTEBOOL_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_WORDBOOL_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_LONGBOOL_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SMALLINT_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
EmitList[ - OP_SHORTINT_FROM_VARIANT ] := EmitOP_XXX_FROM_XXX;
|
|
|
|
EmitList[ - OP_TRY_ON ] := EmitOP_TRY_ON;
|
|
EmitList[ - OP_TRY_OFF ] := EmitOP_TRY_OFF;
|
|
EmitList[ - OP_FINALLY ] := EmitOP_FINALLY;
|
|
|
|
end;
|
|
|
|
procedure TJSConverter.Emit(const S: String);
|
|
begin
|
|
if indent >= 0 then
|
|
fResult.Add(Space(indent) + S)
|
|
else
|
|
RaiseError;
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_ASSIGN;
|
|
var
|
|
S1, S2: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
|
|
if IsTempName(CR.Arg1) then
|
|
saved_names.Add(S1, S2)
|
|
else
|
|
Emit(S1 + ' = ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_XXX_FROM_XXX;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
saved_names.Add(S1, S2);
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_SET_PROP;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(S1 + '.' + S2 + ' = ' + SR + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_GET_PROP;
|
|
var
|
|
S, S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
|
|
S := S1 + '.' + S2;
|
|
saved_names.Add(SR, S);
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_ADD;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' + ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_SUB;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' - ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_MULT;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' * ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_DIV;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' / ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_IDIV;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' / ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_MOD;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' % ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_AND;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' && ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_OR;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' || ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_SHL;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' << ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_SHR;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' >> ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_GT;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
|
|
if IsTempName(CR.Res) then
|
|
saved_names.Add(SR, '(' + S1 + ' > ' + S2 + ')')
|
|
else
|
|
Emit(SR + ' = ' + S1 + ' > ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_GE;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
|
|
if IsTempName(CR.Res) then
|
|
saved_names.Add(SR, '(' + S1 + ' >= ' + S2 + ')')
|
|
else
|
|
Emit(SR + ' = ' + S1 + ' >= ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_LT;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
if IsTempName(CR.Res) then
|
|
saved_names.Add(SR, '(' + S1 + ' < ' + S2 + ')')
|
|
else
|
|
Emit(SR + ' = ' + S1 + ' < ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_LE;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
|
|
if IsTempName(CR.Res) then
|
|
saved_names.Add(SR, '(' + S1 + ' <= ' + S2 + ')')
|
|
else
|
|
Emit(SR + ' = ' + S1 + ' <= ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_EQ;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' == ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_NE;
|
|
var
|
|
S1, S2, SR: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
SR := GetName(CR.Res);
|
|
Emit(SR + ' = ' + S1 + ' < ' + S2 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_GO_FALSE;
|
|
var
|
|
S1, S2: String;
|
|
begin
|
|
S1 := GetLabelName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
Emit('if ( !' + S2 + ' ) goto ' + S1 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_GO_TRUE;
|
|
var
|
|
S1, S2: String;
|
|
begin
|
|
if Code[Code.N - 1].Op = OP_COND_RAISE then
|
|
Exit;
|
|
|
|
S1 := GetLabelName(CR.Arg1);
|
|
S2 := GetName(CR.Arg2);
|
|
Emit('if ( ' + S2 + ' ) goto ' + S1 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_GO;
|
|
var
|
|
S1: String;
|
|
I, Op: Integer;
|
|
ok: Boolean;
|
|
CI: TCodeRec;
|
|
begin
|
|
Op := Code[Code.N+1].Op;
|
|
if (Op = OP_BEGIN_SUB) or
|
|
(Op = OP_BEGIN_RECORD_TYPE) or
|
|
(Op = OP_BEGIN_CLASS_TYPE) then
|
|
begin
|
|
I := used_labels.IndexOf(CR.Arg1);
|
|
if I >= 0 then
|
|
used_labels.RemoveAt(I);
|
|
Exit;
|
|
end;
|
|
|
|
ok := false;
|
|
for I := Code.N + 1 to Code.Card do
|
|
begin
|
|
CI := Code[I];
|
|
Op := CI.Op;
|
|
|
|
if Op = OP_LABEL then
|
|
if CI.Arg1 = CR.Arg1 then
|
|
break;
|
|
|
|
if not (
|
|
(Op = OP_LABEL) or
|
|
(Op = OP_SEPARATOR) or
|
|
(Op = OP_STMT) or
|
|
(Op = OP_SET_CODE_LINE)
|
|
) then
|
|
begin
|
|
ok := true;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
if not ok then
|
|
begin
|
|
I := used_labels.IndexOf(CR.Arg1);
|
|
if I >= 0 then
|
|
used_labels.RemoveAt(I);
|
|
Exit;
|
|
end;
|
|
|
|
S1 := GetLabelName(CR.Arg1);
|
|
Emit('goto ' + S1 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_EXIT;
|
|
begin
|
|
if CR.Op = OP_GO then
|
|
EmitOP_GO
|
|
else
|
|
RaiseError;
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_LABEL;
|
|
var
|
|
S1: String;
|
|
begin
|
|
if used_labels.IndexOf(CR.Arg1) = -1 then
|
|
Exit;
|
|
|
|
S1 := GetLabelName(CR.Arg1);
|
|
Emit(S1 + ' :');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_PRINT_EX;
|
|
var
|
|
S1: String;
|
|
begin
|
|
S1 := GetName(CR.Arg1);
|
|
Emit('print ' + S1 + ';');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_INIT_SUB;
|
|
var
|
|
SubId, ParamCount, ParamId, SelfId, TypeId, I: Integer;
|
|
S, S1, S2, SubName, ParamName: String;
|
|
begin
|
|
SubId := CR.Arg1;
|
|
SubName := GetName(SubId);
|
|
ParamCount := SymbolTable[SubId].Count;
|
|
SelfId := SymbolTable.GetSelfId(SubId);
|
|
|
|
S := 'function ' + SubName + '(';
|
|
|
|
for I := 0 to ParamCount - 1 do
|
|
begin
|
|
ParamId := SymbolTable.GetParamId(SubId, I);
|
|
ParamName := GetSymbolRec(ParamId).Name;
|
|
S := S + ParamName;
|
|
if I < ParamCount - 1 then
|
|
S := S + ',';
|
|
end;
|
|
S := S + ')';
|
|
Emit(S);
|
|
Emit('{');
|
|
Inc(indent, indent_delta);
|
|
|
|
if GetSymbolRec(SubId).Kind = kindCONSTRUCTOR then
|
|
begin
|
|
Emit(GetSelfName(SelfId) + ' = new Object();');
|
|
TypeId := GetSymbolRec(SubId).Level;
|
|
for I := TypeId + 1 to SymbolTable.Card do
|
|
if SymbolTable[I].Level = TypeId then
|
|
if SymbolTable[I].Kind in [KindSUB, KindDESTRUCTOR] then
|
|
begin
|
|
S1 := SymbolTable[I].Name;
|
|
if S1 = '' then
|
|
S1 := GetName(I);
|
|
S2 := GetName(I);
|
|
Emit(GetSelfName(SelfId) + '.' + S1 + ' = ' + S2 + ';');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_END_SUB;
|
|
var
|
|
SubId, ResultId, SelfId: Integer;
|
|
begin
|
|
SubId := CR.Arg1;
|
|
ResultId := SymbolTable.GetResultId(SubId);
|
|
|
|
if GetSymbolRec(SubId).Kind = kindCONSTRUCTOR then
|
|
begin
|
|
SelfId := SymbolTable.GetSelfId(SubId);
|
|
Emit('return ' + GetSelfName(SelfId) + ';');
|
|
end
|
|
else if not (GetSymbolRec(ResultId).FinalTypeId in [0, typeVOID]) then
|
|
Emit('return ' + GetName(ResultId) + ';');
|
|
|
|
Dec(indent, indent_delta);
|
|
Emit('}');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_CALL;
|
|
var
|
|
S: String;
|
|
SubId, NP, I, J, K, ParamId, TypeId, InstanceId, ClassRefId: Integer;
|
|
ParamIds: array[0..100] of Integer;
|
|
begin
|
|
SubId := CR.Arg1;
|
|
NP := CR.Arg2;
|
|
I := Code.N;
|
|
K := 0;
|
|
InstanceId := 0;
|
|
ClassRefId := 0;
|
|
repeat
|
|
Dec(I);
|
|
if Code[I].Op = OP_BEGIN_CALL then
|
|
if Code[I].Arg1 = SubId then
|
|
break;
|
|
if Code[I].Res = SubId then
|
|
begin
|
|
if PushOperators.IndexOf(Code[I].Op) >= 0 then
|
|
begin
|
|
J := Code[I].Arg2;
|
|
ParamIds[J] := Code[I].Arg1;
|
|
Inc(K);
|
|
if K = NP then
|
|
break;
|
|
end
|
|
else if Code[I].Op = OP_PUSH_INST then
|
|
InstanceId := Code[I].Arg1
|
|
else if Code[I].Op = OP_PUSH_CLSREF then
|
|
ClassRefId := Code[I].Arg1;
|
|
end;
|
|
until false;
|
|
|
|
if K <> NP then
|
|
RaiseError;
|
|
|
|
S := GetName(SubId);
|
|
if StrEql('Implicit', S) then
|
|
begin
|
|
S := '';
|
|
end
|
|
else
|
|
S := S + '(';
|
|
|
|
if GetSymbolRec(SubId).Kind = kindCONSTRUCTOR then
|
|
begin
|
|
TypeId := GetSymbolRec(SubId).TypeID;
|
|
if ClassRefId <> 0 then
|
|
TypeId := GetSymbolRec(ClassRefId + 1).PatternId;
|
|
if GetSymbolRec(SubId).Host then
|
|
S := 'new ' + GetSymbolRec(TypeId).Name + '(';
|
|
end
|
|
else if GetSymbolRec(SubId).Kind = kindDESTRUCTOR then
|
|
begin
|
|
S := 'delete this;';
|
|
Emit(S);
|
|
Exit;
|
|
end
|
|
else if InstanceId <> 0 then
|
|
begin
|
|
TypeId := GetSymbolRec(InstanceId).TypeID;
|
|
if GetSymbolRec(SubId).Host and (not GetSymbolRec(TypeId).Host) then
|
|
S := GetName(InstanceId) + '.' + HOST_INSTANCE + '.' + S
|
|
else
|
|
S := GetName(InstanceId) + '.' + S;
|
|
end;
|
|
|
|
for I := 0 to NP - 1 do
|
|
begin
|
|
ParamId := ParamIds[I];
|
|
S := S + GetName(ParamId);
|
|
if I < NP - 1 then
|
|
S := S + ',';
|
|
end;
|
|
|
|
if StrEql('Implicit', GetName(SubId)) then
|
|
S := S + ';'
|
|
else
|
|
S := S + ');';
|
|
|
|
if InstanceId <> 0 then
|
|
if GetSymbolRec(SubId).Kind = kindCONSTRUCTOR then
|
|
if GetSymbolRec(InstanceId).FinalTypeId = typeRECORD then
|
|
begin
|
|
S := GetName(InstanceId) + ' = ' + S;
|
|
Emit(S);
|
|
Exit;
|
|
end;
|
|
|
|
if CR.Res <> 0 then
|
|
if GetSymbolRec(CR.Res).FinalTypeId <> typeVOID then
|
|
S := GetName(CR.Res) + ' = ' + S;
|
|
if Code[Code.N + 1].Op = OP_UPDATE_INSTANCE then
|
|
S := 'this.' + HOST_INSTANCE + ' = ' + S;
|
|
Emit(S);
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_ELEM;
|
|
var
|
|
S, Index, Res: String;
|
|
begin
|
|
S := GetName(CR.Arg1);
|
|
Index := GetName(CR.Arg2);
|
|
S := S + '[' + Index + ']';
|
|
Res := GetName(CR.Res);
|
|
saved_names.Add(Res, S);
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_DECLARE_LOCAL_VAR;
|
|
var
|
|
S: String;
|
|
begin
|
|
S := GetName(CR.Arg2);
|
|
if GetSymbolRec(CR.Arg2).IsFWArrayVar then
|
|
S := 'var ' + S + ' = new Array();'
|
|
else
|
|
S := 'var ' + S + ';';
|
|
Emit(S);
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_TRY_ON;
|
|
begin
|
|
Emit('try');
|
|
Emit('{');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_TRY_OFF;
|
|
begin
|
|
Emit('}');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_FINALLY;
|
|
begin
|
|
Emit('}');
|
|
Emit('finally');
|
|
Emit('{');
|
|
end;
|
|
|
|
procedure TJSConverter.EmitOP_SEPARATOR;
|
|
var
|
|
S: String;
|
|
begin
|
|
S := Code.GetSourceLine(Code.N);
|
|
Emit('// ' + S);
|
|
end;
|
|
|
|
procedure TJSConverter.GenJavaScript(const ModuleName: String);
|
|
var
|
|
I, I1, I2, Op: Integer;
|
|
S: String;
|
|
ModuleId: Integer;
|
|
ok: Boolean;
|
|
begin
|
|
ModuleId := kernel.Modules.IndexOf(ModuleName);
|
|
if ModuleId = -1 then
|
|
RaiseError(errModuleNotFound, []);
|
|
|
|
SaveUnusedLabels;
|
|
Code.Optimization2;
|
|
|
|
S := '';
|
|
|
|
I1 := 0;
|
|
I2 := 0;
|
|
ok := false;
|
|
for I := 1 to Code.Card do
|
|
begin
|
|
CR := Code[I];
|
|
if CR.Op = OP_BEGIN_MODULE then
|
|
begin
|
|
if CR.Arg1 = ModuleId then
|
|
begin
|
|
I1 := I;
|
|
ok := true;
|
|
end;
|
|
end
|
|
else if CR.Op = OP_END_MODULE then
|
|
begin
|
|
if CR.Arg1 = ModuleId then
|
|
begin
|
|
I2 := I;
|
|
break;
|
|
end;
|
|
end
|
|
else if ok and (CR.Op = OP_BEGIN_USING) then
|
|
begin
|
|
if Cr.Arg1 > 0 then
|
|
S := S + GetSymbolRec(CR.Arg1).Name + ',';
|
|
end;
|
|
end;
|
|
|
|
if S <> '' then
|
|
begin
|
|
S[SHigh(S)] := ';';
|
|
Emit('using ' + S);
|
|
end;
|
|
|
|
for I := I1 to I2 do
|
|
begin
|
|
CR := Code[I];
|
|
Op := CR.Op;
|
|
Code.N := I;
|
|
|
|
EmitList[-Op];
|
|
end;
|
|
end;
|
|
|
|
procedure TJSConverter.RaiseError(const Message: string; params: array of Const);
|
|
begin
|
|
kernel.RaiseError(Message, params);
|
|
end;
|
|
|
|
procedure TJSConverter.RaiseError;
|
|
begin
|
|
RaiseError(errInternalError, []);
|
|
end;
|
|
|
|
function TJSConverter.GetLabelName(Id: Integer): String;
|
|
begin
|
|
result := 'label_' + IntToStr(Id);
|
|
end;
|
|
|
|
function TJSConverter.GetSelfName(Id: Integer): String;
|
|
begin
|
|
result := 'this';
|
|
end;
|
|
|
|
function TJSConverter.GetName(Id: Integer): String;
|
|
var
|
|
OwnerId, LevelId, I: Integer;
|
|
begin
|
|
result := SymbolTable[Id].Name;
|
|
|
|
if IsTempName(Id) then
|
|
begin
|
|
I := saved_names.Keys.IndexOf(result);
|
|
if I >= 0 then
|
|
begin
|
|
result := saved_names.Values[I];
|
|
saved_names.RemoveAt(I);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
if IsValidName(result) then
|
|
begin
|
|
if SymbolTable[Id].Kind = KindCONST then
|
|
begin
|
|
result := SymbolTable.ValueStr(Id);
|
|
Exit;
|
|
end;
|
|
|
|
if result = 'Me' then
|
|
result := 'this';
|
|
OwnerId := GetSymbolRec(Id).OwnerId;
|
|
if OwnerId > 0 then
|
|
result := GetName(OwnerId) + '.' + result
|
|
else if GetSymbolRec(Id).Kind in [kindCONSTRUCTOR, kindDESTRUCTOR] then
|
|
begin
|
|
LevelId := GetSymbolRec(Id).Level;
|
|
result := GetName(LevelId) + '_' + result
|
|
end
|
|
else if GetSymbolRec(Id).IsMethod then
|
|
begin
|
|
if not GetSymbolRec(Id).Host then
|
|
begin
|
|
LevelId := GetSymbolRec(Id).Level;
|
|
result := GetName(LevelId) + '_' + result;
|
|
end;
|
|
end;
|
|
|
|
Exit;
|
|
end;
|
|
if SymbolTable[Id].Kind = KindCONST then
|
|
begin
|
|
result := SymbolTable.ValueStr(Id);
|
|
if SymbolTable[Id].FinaltypeId in CharTypes then
|
|
result := '"' + result + '"'
|
|
else if SymbolTable[Id].FinaltypeId in StringTypes then
|
|
result := '"' + result + '"'
|
|
else if SymbolTable[Id].HasPAnsiCharType then
|
|
result := '"' + result + '"'
|
|
else if SymbolTable[Id].HasPWideCharType then
|
|
result := '"' + result + '"';
|
|
Exit;
|
|
end;
|
|
result := 'temp_' + IntToStr(Id);
|
|
|
|
I := saved_names.Keys.IndexOf(result);
|
|
if I >= 0 then
|
|
begin
|
|
result := saved_names.Values[I];
|
|
saved_names.RemoveAt(I);
|
|
end;
|
|
end;
|
|
|
|
function TJSConverter.IsTempName(Id: Integer): Boolean;
|
|
var
|
|
S: String;
|
|
PatternId: Integer;
|
|
begin
|
|
S := GetSymbolRec(Id).Name;
|
|
result := (S = '') or (S = '@');
|
|
if not result then
|
|
if GetSymbolRec(Id).Kind = KindVAR then
|
|
begin
|
|
PatternId := GetSymbolRec(Id).PatternId;
|
|
if PatternId > 0 then
|
|
result := GetSymbolRec(PatternId).Kind = KindPROP;
|
|
end;
|
|
end;
|
|
|
|
function TJSConverter.GetSymbolRec(Id: Integer): TSymbolRec;
|
|
begin
|
|
result := SymbolTable[Id];
|
|
end;
|
|
|
|
procedure TJSConverter.SaveUnusedLabels;
|
|
var
|
|
I, Op: Integer;
|
|
begin
|
|
for I := 1 to Code.Card do
|
|
begin
|
|
Op := Code[I].Op;
|
|
if (Op = OP_GO) or
|
|
(Op = OP_GO_FALSE) or
|
|
(Op = OP_GO_TRUE) or
|
|
(Op = OP_GO_TRUE_BOOL) or
|
|
(Op = OP_GO_FALSE_BOOL) then
|
|
used_labels.Add(Code[I].Arg1);
|
|
end;
|
|
end;
|
|
|
|
end.
|