{
Этот исходный текст является частью Продвинутого векторного транслятора.
Copyright © 2017 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit BuildFTr;
{$MODE DELPHI,EXTENDEDSYNTAX ON}
interface
uses
Lang, Utils, IOStream, TranIntf, TranType, TranTree, BuildLex, BuildNms;
{$ASMMODE INTEL,CALLING REGISTER,INLINE ON,GOTO ON}
{$H+,I-,J-,M-,Q-,R-,T-}
type
BuilderNode = interface;
TranslatorBuilderNode = class;
TranslatorTreeBuilder = class;
BuilderNode = interface(SyntaxNode) ['{2187DBA7-8D82-42DE-95E7-6B43015BBA94}']
procedure setOptimized(optimized: boolean);
procedure setAssignedLabelNumber(assignedLabelNumber: int);
procedure setLabelName(const labelName: UnicodeString);
function isOptimized(): boolean;
function getAssignedLabelNumber(): int;
function getLabelName(): UnicodeString;
property optimized: boolean read isOptimized write setOptimized;
property assignedLabelNumber: int read getAssignedLabelNumber write setAssignedLabelNumber;
property labelName: UnicodeString read getLabelName write setLabelName;
end;
TranslatorBuilderNode = class(TranslatorSyntaxNode, BuilderNode)
public
constructor create(); override;
function toString(): AnsiString; override;
procedure clearData(); override;
procedure setOptimized(optimized: boolean); virtual;
procedure setAssignedLabelNumber(assignedLabelNumber: int); virtual;
procedure setLabelName(const labelName: UnicodeString); virtual;
function isOptimized(): boolean; virtual;
function getAssignedLabelNumber(): int; virtual;
function getLabelName(): UnicodeString; virtual;
strict private
optimized: boolean;
assignedLabelNumber: int;
labelName: UnicodeString;
end;
TranslatorTreeBuilder = class(TranslatorNamespacesBuilder, BuilderOfTrees)
public
const NULL = 0;
{ function bounds }// Компилируем ли этот вид узла? o – всегда, x – никогда, # – не всегда.
const FUNCTION_START = 1; // { o
const FUNCTION_RETURN = 2; // } o
{ operators }
const OPERATOR_EMPTY = 100; // ; x
const OPERATOR_LABEL = 101; // label: <оператор> x
const OPERATOR_BLOCK = 102; // {<операторы>} x
const OPERATOR_VARIABLE = 103; // <тип> имя = <выражение>; #
const OPERATOR_DISPOSE = 104; // dispose <выражение>; o
const OPERATOR_WITH = 105; // with(<выражение>) <оператор> x
const OPERATOR_TRY_CATCH = 106; // try {<операторы>} catch(<исключение>) {<операторы>} x
const OPERATOR_TRY_FINALLY = 107; // try {<операторы>} finally {<операторы>} x
const OPERATOR_BREAK = 108; // break <метка>; o
const OPERATOR_CONTINUE = 109; // continue <метка>; o
const OPERATOR_IF = 110; // if(<выражение>) <оператор> else <оператор> x
const OPERATOR_SWITCH = 111; // switch(<выражение>) {case <выражение>: <операторы>} o
const OPERATOR_DO = 112; // for(<выражение>; <выражение>; <выражение>) <оператор>x
const OPERATOR_FOR = 113; // while(<выражение>) <оператор> x
const OPERATOR_WHILE = 114; // do <оператор> while(<выражение>); x
const OPERATOR_THROW = 115; // throw <исключение>; o
const OPERATOR_RETURN = 116; // return <выражение>; o
const TF_OPERATOR_RETURN = 117; // try { return <выражение>; } finally o
{ operator's blocks }
const BLOCK_WITH = 200; // with variable o
const BLOCK_CATCH = 201; // catch x
const BLOCK_FINALLY_START = 202; // finally begin x
const BLOCK_FINALLY_RETURN = 203; // finally return o
const BLOCK_CASE = 204; // case x
const BLOCK_DEFAULT = 205; // default x
{ expression's pieces }
const EXPR_VALUE_NULL = 300; // null o
const EXPR_VALUE_BOOLEAN = 301; // false..true #
const EXPR_VALUE_INT = 302; // 0x80000000..0x7fffffff o
const EXPR_VALUE_LONG = 303; // 0x8000000000000000L..0x7fffffffffffffffL o
const EXPR_VALUE_ULTRA = 304; // new ultra { int, int, int, int } o
const EXPR_VALUE_REAL = 307; // ±целая.дробнаяE±порядок(F, D, R) o
const EXPR_VALUE_XVECTOR = 308; // new xvector { float, float, float, float } o
const EXPR_VALUE_STRING = 311; // "строка" o
const EXPR_LOCAL_VARIABLE = 320; // <локальная переменная> #
const EXPR_GLOBAL_VARIABLE = 322; // <глобальная переменная> #
const EXPR_GLOBAL_FUNCTION = 323; // <глобальная функция> #
{ expression's new operations }
const EXPR_NEW_STRUCT = 350; // new <структура> {…} o
const EXPR_NEW_ARRAY_BY_ELEMENTS = 351; // new <тип> {…} o
const EXPR_NEW_ARRAY_BY_LENGTH = 352; // new <тип>[<выражение>] o
const EXPR_NEW_ULTRA = 353; // new ultra {…} o
const EXPR_NEW_XVECTOR = 356; // new xvector {…} o
const EXPR_FIELD_ASSIGN = 359; // поле=… o
const EXPR_ARRAY_ASSIGN = 360; // [индекс]=… o
{ expression's operations }
const EXPR_CALL = 400; // x(y) o
const EXPR_ARRAY = 401; // x[y] #
const EXPR_COMPOUND = 402; // x[y] o
const EXPR_FIELD = 403; // x.поле #
const EXPR_INCR_POST = 404; // x++ o
const EXPR_DECR_POST = 405; // x-- o
const EXPR_TYPE_CAST = 406; // (<тип>) x #
const EXPR_SNOTB = 407; // ~x o
const EXPR_SNOTL = 408; // !x x
const EXPR_SNEG = 409; // -x o
const EXPR_INCR_PRED = 410; // ++x o
const EXPR_DECR_PRED = 411; // --x o
const EXPR_QPACKUS = 412; // @@@@x o
const EXPR_QUNPCKL = 413; // ####x o
const EXPR_QUNPCKH = 414; // ^^^^x o
const EXPR_QNEG = 415; // ----x o
const EXPR_OPACKUS = 416; // @@..@@x o
const EXPR_OUNPCKL = 417; // ##..##x o
const EXPR_OUNPCKH = 418; // ^^..^^x o
const EXPR_ONEG = 419; // --..--x o
const EXPR_SMULL = 420; // x * y o
const EXPR_SDIVS = 421; // x / y o
const EXPR_SREMS = 422; // x % y o
const EXPR_SDIVU = 423; // x // y o
const EXPR_SREMU = 424; // x %% y o
const EXPR_QMULL = 425; // x **** y o
const EXPR_QMULH = 426; // x ***^ y o
const EXPR_QMULHS = 427; // x ***| y o
const EXPR_QDIV = 428; // x //// y o
const EXPR_OMULL = 429; // x **..** y o
const EXPR_OMULH = 430; // x **..*^ y o
const EXPR_OMULHS = 431; // x **..*| y o
const EXPR_SADD = 432; // x + y o
const EXPR_SSUB = 433; // x - y o
const EXPR_QADD = 434; // x ++++ y o
const EXPR_QADDS = 435; // x +++| y o
const EXPR_QADDUS = 436; // x +++# y o
const EXPR_QSUB = 437; // x ---- y o
const EXPR_QSUBS = 438; // x ---| y o
const EXPR_QSUBUS = 439; // x ---# y o
const EXPR_OADD = 440; // x ++..++ y o
const EXPR_OADDS = 441; // x ++..+| y o
const EXPR_OADDUS = 442; // x ++..+# y o
const EXPR_OSUB = 443; // x --..-- y o
const EXPR_OSUBS = 444; // x --..-| y o
const EXPR_OSUBUS = 445; // x --..-# y o
const EXPR_SSLL = 446; // x << y o
const EXPR_SSRA = 447; // x >> y o
const EXPR_SSRL = 448; // x >>> y o
const EXPR_QSLL = 449; // x <<<< y o
const EXPR_QSRA = 450; // x >>>> y o
const EXPR_QSRL = 451; // x >>>>> y o
const EXPR_OSLL = 452; // x <<..<< y o
const EXPR_OSRA = 453; // x >>..>> y o
const EXPR_OSRL = 454; // x >>..>>> y o
const EXPR_SGT = 455; // x > y o
const EXPR_SGE = 456; // x >= y o
const EXPR_SLT = 457; // x < y o
const EXPR_SLE = 458; // x <= y o
const EXPR_QGT = 459; // x >>|| y o
const EXPR_QGE = 460; // x >=|| y o
const EXPR_QLT = 461; // x <<|| y o
const EXPR_QLE = 462; // x <=|| y o
const EXPR_OGT = 463; // x >>|..| y o
const EXPR_OGE = 464; // x >=|..| y o
const EXPR_OLT = 465; // x <<|..| y o
const EXPR_OLE = 466; // x <=|..| y o
const EXPR_SEQ = 467; // x == y o
const EXPR_SNE = 468; // x != y o
const EXPR_QEQ = 469; // x ==|| y o
const EXPR_QNE = 470; // x !=|| y o
const EXPR_OEQ = 471; // x ==|..| y o
const EXPR_ONE = 472; // x !=|..| y o
const EXPR_SANDB = 473; // x & y o
const EXPR_SXORB = 474; // x ^ y o
const EXPR_SORB = 475; // x | y o
const EXPR_SANDL = 476; // x && y x
const EXPR_SORL = 477; // x || y x
const EXPR_QUESTION = 550; // x ? y : z x
const EXPR_SEQ_NULL = 551; // x == null o
const EXPR_SNE_NULL = 552; // x != null o
const EXPR_SZR_TEST = 553; // (x & y) == 0 o
const EXPR_SNZ_TEST = 554; // (x & y) != 0 o
{ expression's assignments (must be between 600 and 699) }
const ASSIGN = 605; // x = y o
const ASSIGN_SMULL = 619; // x *= y o
const ASSIGN_SDIVS = 620; // x /= y o
const ASSIGN_SREMS = 621; // x %= y o
const ASSIGN_SDIVU = 622; // x //= y o
const ASSIGN_SREMU = 623; // x %%= y o
const ASSIGN_QMULL = 624; // x ****= y o
const ASSIGN_QMULH = 625; // x ***^= y o
const ASSIGN_QMULHS = 626; // x ***|= y o
const ASSIGN_QDIV = 627; // x ////= y o
const ASSIGN_OMULL = 628; // x **..**= y o
const ASSIGN_OMULH = 629; // x **..*^= y o
const ASSIGN_OMULHS = 630; // x **..*|= y o
const ASSIGN_SADD = 631; // x += y o
const ASSIGN_SSUB = 632; // x -= y o
const ASSIGN_QADD = 633; // x ++++= y o
const ASSIGN_QADDS = 634; // x +++|= y o
const ASSIGN_QADDUS = 635; // x +++#= y o
const ASSIGN_QSUB = 636; // x ----= y o
const ASSIGN_QSUBS = 637; // x ---|= y o
const ASSIGN_QSUBUS = 638; // x ---#= y o
const ASSIGN_OADD = 639; // x ++..++= y o
const ASSIGN_OADDS = 640; // x ++..+|= y o
const ASSIGN_OADDUS = 641; // x ++..+#= y o
const ASSIGN_OSUB = 642; // x --..--= y o
const ASSIGN_OSUBS = 643; // x --..-|= y o
const ASSIGN_OSUBUS = 644; // x --..-#= y o
const ASSIGN_SSLL = 645; // x <<= y o
const ASSIGN_SSRA = 646; // x >>= y o
const ASSIGN_SSRL = 647; // x >>>= y o
const ASSIGN_QSLL = 648; // x <<<<= y o
const ASSIGN_QSRA = 649; // x >>>>= y o
const ASSIGN_QSRL = 650; // x >>>>>= y o
const ASSIGN_OSLL = 651; // x <<..<<= y o
const ASSIGN_OSRA = 652; // x >>..>>= y o
const ASSIGN_OSRL = 653; // x >>..>>>= y o
const ASSIGN_QGT = 658; // x >>||= y o
const ASSIGN_QGE = 659; // x >=||= y o
const ASSIGN_QLT = 660; // x <<||= y o
const ASSIGN_QLE = 661; // x <=||= y o
const ASSIGN_OGT = 662; // x >>|..|= y o
const ASSIGN_OGE = 663; // x >=|..|= y o
const ASSIGN_OLT = 664; // x <<|..|= y o
const ASSIGN_OLE = 665; // x <=|..|= y o
const ASSIGN_QEQ = 668; // x ==||= y o
const ASSIGN_QNE = 669; // x !=||= y o
const ASSIGN_OEQ = 670; // x ==|..|= y o
const ASSIGN_ONE = 671; // x !=|..|= y o
const ASSIGN_SANDB = 672; // x &= y o
const ASSIGN_SXORB = 673; // x ^= y o
const ASSIGN_SORB = 674; // x |= y o
{ jumps }
const JUMP = 900; // jump o
const TF_JUMP = 916; // try { jump } finally o
{ вспомогательные методы }
class function isNodeValueAssign(value: int): boolean;
class function getTypeKind(theType: TypeDescriptor): int;
class function ultraToXVector(const value: ultra): xvector;
class function xvectorToUltra(const value: xvector): ultra;
class function getArrayOfParents(node: Node): Node_Array1d;
class function getCommonParent(node1, node2: Node): Node;
strict private
class function insertTypeCast(node: SyntaxNode; cast: TypeDescriptor): SyntaxNode;
class function getNodeWithMinLabelNumber(node, next: SyntaxNode): SyntaxNode;
class function findLocalVariable(const name: UnicodeString;
parent: SyntaxNode): LocalVariable;
public
constructor create(operandSize, extension: int);
function buildSyntaxTree(forFunction: GlobalFunction): Tree; virtual;
protected
function possibleAssign(dstType, srcType: TypeDescriptor;
srcAsoc: _Interface): boolean; overload; virtual;
strict private { секция построения дерева }
currWithVarNum: int;
arrayLengthField: StructureField;
function parseExprPost(lexemes: Lexer; position: int; parent, child: SyntaxNode): int;
function parseExprNew(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprElem(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprPref(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprMult(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprAdd(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprShift(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprRel(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprEqual(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprBAnd(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprBXor(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprBOr(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprLAnd(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprLOr(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprCond(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseExprAssign(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseLocalVar(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseDispose(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseWith(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseTry(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseBreak(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseContinue(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseIf(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseSwitch(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseDo(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseFor(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseWhile(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseThrow(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseReturn(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseOpBlock(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseOperator(lexemes: Lexer; position: int; parent: SyntaxNode): int;
function parseStatement(lexemes: Lexer; position: int; parent: SyntaxNode;
raisesExceptionIfEmpty: boolean): int;
function parseForExpr(lexemes: Lexer; position: int; parent: SyntaxNode;
expressionOnly: boolean): int;
function parseIdentifier(lexemes: Lexer; position: int; parent: SyntaxNode): NamedObject;
strict private { секция связывания узлов }
procedure optimizeJumps(tree: SyntaxTree; touchReturn: boolean);
procedure numerateNodes(node: SyntaxNode);
procedure placeJumpsInExpression(node: SyntaxNode);
procedure placeJumpsInBoolean(node, goIfTrue, goIfFalse: SyntaxNode);
function placeJumpsInOperator(node, next: SyntaxNode): SyntaxNode;
function insertInitializations(root: SyntaxNode): SyntaxNode;
strict private { секция анализа дерева }
function isReachable(node: SyntaxNode): boolean;
function isReturnTo(last: SyntaxNode): boolean;
function hasLinksTo(node: SyntaxNode): boolean;
end;
resourcestring
msgExpectedStatement = 'Ожидается оператор.';
msgExpectedKeywordWhile = 'Ожидается ключевое слово "while".';
msgExpectedKeywordCatchFinally = 'Ожидается ключевое слово "catch" или "finally".';
msgExpectedAssignOrCall = 'Ожидается оператор "присвоить" или вызов функции.';
msgSwitchCaseValueAlreadyPresent = 'Это значение метки "case" уже встречалось.';
msgSwitchDefaultAlreadyPresent = 'Метка "default" уже встречалась.';
msgBreakLabelNotFound = 'Меточный оператор "break": метка не найдена.';
msgBreakUnlabeledNotAllowed = 'Безметочный оператор "break" может быть ' +
'только внутри блоков "do", "for", "while" и "switch".';
msgContinueLabelNotFound = 'Меточный оператор "continue": метка не найдена.';
msgContinueLabeledNotAllowed = 'Меточный оператор "continue" допустим, только если этой ' +
'меткой помечен блок "do", "for" или "while".';
msgContinueUnlabeledNotAllowed = 'Безметочный оператор "continue" может быть ' +
'только внутри блоков "do", "for" и "while".';
msgFinallyBreakNotAllowed = 'Операторы "break", "continue" и "return" ' +
'недопустимы, если они означают выход из блока "finally".';
msgFinallyTryNotAllowed = 'Оператор "try" недопустим внутри блока "finally".';
msgTypeMustBeArray = 'Тип выражения должен быть массивом.';
msgTypeMustBeStruct = 'Тип выражения должен быть структурой.';
msgTypeMustBeFunction = 'Тип выражения должен быть функциональным.';
msgTypeMustBeAvailableForNew = 'Тип выражения должен быть подходящим для создания ' +
'операцией "new".';
msgOperationApplicableOnlyToVar = 'Эта операция применима только к переменным, ' +
'полям структур и ячейкам массива.';
msgLengthMustInFirstSquareBrackets = 'Длина массива должна быть указана только в первых ' +
'квадратных скобках.';
msgCannotAssignToNull = 'Нельзя присвоить значению "null" что-либо.';
msgDetectedUnreachableCode = 'Обнаружен недостижимый код.';
msgFunctionShouldReturnValue = 'Функция должна возвращать значение или ' +
'генерировать исключение.';
implementation
type
FoundObject = interface;
TranslatorFoundObject = class;
FoundObject = interface(StructureField) ['{2187DBA7-8D82-42DE-95E7-6B43015BBA95}']
function getFoundIn(): LocalVariable;
function getBaseObject(): StructureField;
property foundIn: LocalVariable read getFoundIn;
property baseObject: StructureField read getBaseObject;
end;
TranslatorFoundObject = class(RefCountInterfacedObject, NamedObject, NameAndType,
StructureField, FoundObject)
public
constructor create(foundIn: LocalVariable; baseObject: StructureField);
function toString(): AnsiString; override;
procedure setDeclarePosition(declarePosition: int); virtual;
procedure setStartPosition(startPosition: int); virtual;
function getDeclarePosition(): int; virtual;
function getStartPosition(): int; virtual;
function getName(): UnicodeString; virtual;
function getDataType(): TypeDescriptor; virtual;
function isPublic(): boolean; virtual;
function getOffset(): int; virtual;
function getOwner(): TypeStructure; virtual;
function getFoundIn(): LocalVariable; virtual;
function getBaseObject(): StructureField; virtual;
strict private
foundIn: LocalVariable;
baseObject: StructureField;
end;
{ TranslatorBuilderNode }
constructor TranslatorBuilderNode.create();
begin
inherited create();
self.assignedLabelNumber := -1;
self.labelName := '';
end;
function TranslatorBuilderNode.toString(): AnsiString;
var
compiledLabelNumber: int;
assignedLabelNumber: int;
position: int;
lineNumber: int;
charNumber: int;
value: int;
kind: int;
dataType: TypeDescriptor;
associate: _Interface;
goAlwaysToNode: SyntaxNode;
goIfTrueToNode: SyntaxNode;
goIfFalseToNode: SyntaxNode;
labelName: UnicodeString;
s: AnsiString;
stream: Output;
node: BuilderNode;
ival: int;
lval: long;
uval: ultra;
rval: real;
xval: xvector;
begin
compiledLabelNumber := getLabelNumber();
assignedLabelNumber := getAssignedLabelNumber();
position := getPosition();
if position >= 0 then with (getOwner() as SyntaxTree).lexemes do begin
lineNumber := getLine(position);
charNumber := getChar(position);
end else begin
lineNumber := 0;
charNumber := 0;
end;
value := getValue();
dataType := getDataType();
associate := getAssociate();
goAlwaysToNode := getGoAlwaysToNode();
goIfTrueToNode := getGoIfTrueToNode();
goIfFalseToNode := getGoIfFalseToNode();
labelName := getLabelName();
stream := ByteArrayStream.create();
if compiledLabelNumber >= 0 then begin
s := 'C' + intToString(compiledLabelNumber) + #$20;
end else begin
s := '';
end;
if assignedLabelNumber >= 0 then begin
s := s + '.L.' + intToString(assignedLabelNumber);
end else begin
s := s + '$' + intToHexString(getHashCode());
end;
stream.write(stringToByteArray(s));
if (lineNumber >= 1) and (charNumber >= 1) then begin
stream.write(stringToByteArray(' (' +
intToString(lineNumber) + ':' +
intToString(charNumber) + ')'));
end;
case value of
TranslatorTreeBuilder.NULL:
s := '<null>';
TranslatorTreeBuilder.FUNCTION_START:
s := '{';
TranslatorTreeBuilder.FUNCTION_RETURN:
s := '}';
TranslatorTreeBuilder.OPERATOR_EMPTY:
s := ';';
TranslatorTreeBuilder.OPERATOR_LABEL:
s := '';
TranslatorTreeBuilder.OPERATOR_BLOCK:
s := '{…}';
TranslatorTreeBuilder.OPERATOR_VARIABLE:
s := 'declare var';
TranslatorTreeBuilder.OPERATOR_DISPOSE:
s := 'dispose';
TranslatorTreeBuilder.OPERATOR_WITH:
s := 'with';
TranslatorTreeBuilder.OPERATOR_TRY_CATCH:
s := 'try…catch';
TranslatorTreeBuilder.OPERATOR_TRY_FINALLY:
s := 'try…finally';
TranslatorTreeBuilder.OPERATOR_BREAK:
s := 'break';
TranslatorTreeBuilder.OPERATOR_CONTINUE:
s := 'continue';
TranslatorTreeBuilder.OPERATOR_IF:
s := 'if';
TranslatorTreeBuilder.OPERATOR_SWITCH:
s := 'switch';
TranslatorTreeBuilder.OPERATOR_FOR:
s := 'for';
TranslatorTreeBuilder.OPERATOR_WHILE:
s := 'while';
TranslatorTreeBuilder.OPERATOR_DO:
s := 'do';
TranslatorTreeBuilder.OPERATOR_THROW:
s := 'throw';
TranslatorTreeBuilder.OPERATOR_RETURN:
s := 'return';
TranslatorTreeBuilder.TF_OPERATOR_RETURN:
s := 'return finally';
TranslatorTreeBuilder.BLOCK_WITH:
s := 'with var';
TranslatorTreeBuilder.BLOCK_CATCH:
s := 'catch';
TranslatorTreeBuilder.BLOCK_FINALLY_START:
s := 'finally';
TranslatorTreeBuilder.BLOCK_FINALLY_RETURN:
s := 'finally return';
TranslatorTreeBuilder.BLOCK_CASE:
s := 'case';
TranslatorTreeBuilder.BLOCK_DEFAULT:
s := 'default';
TranslatorTreeBuilder.EXPR_VALUE_NULL:
s := 'null';
TranslatorTreeBuilder.EXPR_VALUE_BOOLEAN:
s := 'boolean value';
TranslatorTreeBuilder.EXPR_VALUE_INT:
s := 'int value';
TranslatorTreeBuilder.EXPR_VALUE_LONG:
s := 'long value';
TranslatorTreeBuilder.EXPR_VALUE_ULTRA:
s := 'ultra value';
TranslatorTreeBuilder.EXPR_VALUE_REAL:
s := 'real value';
TranslatorTreeBuilder.EXPR_VALUE_XVECTOR:
s := 'xvector value';
TranslatorTreeBuilder.EXPR_VALUE_STRING:
s := 'char[] value';
TranslatorTreeBuilder.EXPR_LOCAL_VARIABLE:
s := 'local var';
TranslatorTreeBuilder.EXPR_GLOBAL_VARIABLE:
s := 'global var';
TranslatorTreeBuilder.EXPR_GLOBAL_FUNCTION:
s := 'global function';
TranslatorTreeBuilder.EXPR_NEW_STRUCT:
s := 'new struct';
TranslatorTreeBuilder.EXPR_NEW_ARRAY_BY_ELEMENTS:
s := 'new array[] {…}';
TranslatorTreeBuilder.EXPR_NEW_ARRAY_BY_LENGTH:
s := 'new array[…]';
TranslatorTreeBuilder.EXPR_NEW_ULTRA:
s := 'new ultra';
TranslatorTreeBuilder.EXPR_NEW_XVECTOR:
s := 'new xvector';
TranslatorTreeBuilder.EXPR_FIELD_ASSIGN:
s := 'field=';
TranslatorTreeBuilder.EXPR_ARRAY_ASSIGN:
s := '[' + intToString(getIndex()) + ']=';
TranslatorTreeBuilder.EXPR_CALL:
s := 'f(x)';
TranslatorTreeBuilder.EXPR_ARRAY:
s := 'a[i]';
TranslatorTreeBuilder.EXPR_COMPOUND:
s := 'с[i]';
TranslatorTreeBuilder.EXPR_FIELD:
s := '.field';
TranslatorTreeBuilder.EXPR_INCR_POST:
s := 'x++';
TranslatorTreeBuilder.EXPR_DECR_POST:
s := 'x--';
TranslatorTreeBuilder.EXPR_TYPE_CAST:
s := 'type cast';
TranslatorTreeBuilder.EXPR_SNOTB:
s := '~';
TranslatorTreeBuilder.EXPR_SNOTL:
s := '!';
TranslatorTreeBuilder.EXPR_SNEG:
s := '-x';
TranslatorTreeBuilder.EXPR_INCR_PRED:
s := '++x';
TranslatorTreeBuilder.EXPR_DECR_PRED:
s := '--x';
TranslatorTreeBuilder.EXPR_QPACKUS:
s := '@@@@';
TranslatorTreeBuilder.EXPR_QUNPCKL:
s := '####';
TranslatorTreeBuilder.EXPR_QUNPCKH:
s := '^^^^';
TranslatorTreeBuilder.EXPR_QNEG:
s := '----x';
TranslatorTreeBuilder.EXPR_OPACKUS:
s := '@@..@@';
TranslatorTreeBuilder.EXPR_OUNPCKL:
s := '##..##';
TranslatorTreeBuilder.EXPR_OUNPCKH:
s := '^^..^^';
TranslatorTreeBuilder.EXPR_ONEG:
s := '--..--x';
TranslatorTreeBuilder.EXPR_SMULL:
s := '*';
TranslatorTreeBuilder.EXPR_SDIVS:
s := '/';
TranslatorTreeBuilder.EXPR_SREMS:
s := '%';
TranslatorTreeBuilder.EXPR_SDIVU:
s := '//';
TranslatorTreeBuilder.EXPR_SREMU:
s := '%%';
TranslatorTreeBuilder.EXPR_QMULL:
s := '****';
TranslatorTreeBuilder.EXPR_QMULH:
s := '***^';
TranslatorTreeBuilder.EXPR_QMULHS:
s := '***|';
TranslatorTreeBuilder.EXPR_QDIV:
s := '////';
TranslatorTreeBuilder.EXPR_OMULL:
s := '**..**';
TranslatorTreeBuilder.EXPR_OMULH:
s := '**..*^';
TranslatorTreeBuilder.EXPR_OMULHS:
s := '**..*|';
TranslatorTreeBuilder.EXPR_SADD:
s := '+';
TranslatorTreeBuilder.EXPR_SSUB:
s := '-';
TranslatorTreeBuilder.EXPR_QADD:
s := '++++';
TranslatorTreeBuilder.EXPR_QADDS:
s := '+++|';
TranslatorTreeBuilder.EXPR_QADDUS:
s := '+++#';
TranslatorTreeBuilder.EXPR_QSUB:
s := '----';
TranslatorTreeBuilder.EXPR_QSUBS:
s := '---|';
TranslatorTreeBuilder.EXPR_QSUBUS:
s := '---#';
TranslatorTreeBuilder.EXPR_OADD:
s := '++..++';
TranslatorTreeBuilder.EXPR_OADDS:
s := '++..+|';
TranslatorTreeBuilder.EXPR_OADDUS:
s := '++..+#';
TranslatorTreeBuilder.EXPR_OSUB:
s := '--..--';
TranslatorTreeBuilder.EXPR_OSUBS:
s := '--..-|';
TranslatorTreeBuilder.EXPR_OSUBUS:
s := '--..-#';
TranslatorTreeBuilder.EXPR_SSLL:
s := '<<';
TranslatorTreeBuilder.EXPR_SSRA:
s := '>>';
TranslatorTreeBuilder.EXPR_SSRL:
s := '>>>';
TranslatorTreeBuilder.EXPR_QSLL:
s := '<<<<';
TranslatorTreeBuilder.EXPR_QSRA:
s := '>>>>';
TranslatorTreeBuilder.EXPR_QSRL:
s := '>>>>>';
TranslatorTreeBuilder.EXPR_OSLL:
s := '<<..<<';
TranslatorTreeBuilder.EXPR_OSRA:
s := '>>..>>';
TranslatorTreeBuilder.EXPR_OSRL:
s := '>>..>>>';
TranslatorTreeBuilder.EXPR_SGT:
s := '>';
TranslatorTreeBuilder.EXPR_SGE:
s := '>=';
TranslatorTreeBuilder.EXPR_SLT:
s := '<';
TranslatorTreeBuilder.EXPR_SLE:
s := '<=';
TranslatorTreeBuilder.EXPR_QGT:
s := '>>||';
TranslatorTreeBuilder.EXPR_QGE:
s := '>=||';
TranslatorTreeBuilder.EXPR_QLT:
s := '<<||';
TranslatorTreeBuilder.EXPR_QLE:
s := '<=||';
TranslatorTreeBuilder.EXPR_OGT:
s := '>>|..|';
TranslatorTreeBuilder.EXPR_OGE:
s := '>=|..|';
TranslatorTreeBuilder.EXPR_OLT:
s := '<<|..|';
TranslatorTreeBuilder.EXPR_OLE:
s := '<=|..|';
TranslatorTreeBuilder.EXPR_SEQ:
s := '==';
TranslatorTreeBuilder.EXPR_SNE:
s := '!=';
TranslatorTreeBuilder.EXPR_QEQ:
s := '==||';
TranslatorTreeBuilder.EXPR_QNE:
s := '!=||';
TranslatorTreeBuilder.EXPR_OEQ:
s := '==|..|';
TranslatorTreeBuilder.EXPR_ONE:
s := '!=|..|';
TranslatorTreeBuilder.EXPR_SANDB:
s := '&';
TranslatorTreeBuilder.EXPR_SXORB:
s := '^';
TranslatorTreeBuilder.EXPR_SORB:
s := '|';
TranslatorTreeBuilder.EXPR_SANDL:
s := '&&';
TranslatorTreeBuilder.EXPR_SORL:
s := '||';
TranslatorTreeBuilder.EXPR_QUESTION:
s := '?:';
TranslatorTreeBuilder.EXPR_SEQ_NULL:
s := 'x == null';
TranslatorTreeBuilder.EXPR_SNE_NULL:
s := 'x != null';
TranslatorTreeBuilder.EXPR_SZR_TEST:
s := '& == 0';
TranslatorTreeBuilder.EXPR_SNZ_TEST:
s := '& != 0';
TranslatorTreeBuilder.ASSIGN:
s := '=';
TranslatorTreeBuilder.ASSIGN_SMULL:
s := '*=';
TranslatorTreeBuilder.ASSIGN_SDIVS:
s := '/=';
TranslatorTreeBuilder.ASSIGN_SREMS:
s := '%=';
TranslatorTreeBuilder.ASSIGN_SDIVU:
s := '//=';
TranslatorTreeBuilder.ASSIGN_SREMU:
s := '%%=';
TranslatorTreeBuilder.ASSIGN_QMULL:
s := '****=';
TranslatorTreeBuilder.ASSIGN_QMULH:
s := '***^=';
TranslatorTreeBuilder.ASSIGN_QMULHS:
s := '***|=';
TranslatorTreeBuilder.ASSIGN_QDIV:
s := '////=';
TranslatorTreeBuilder.ASSIGN_OMULL:
s := '**..**=';
TranslatorTreeBuilder.ASSIGN_OMULH:
s := '**..*^=';
TranslatorTreeBuilder.ASSIGN_OMULHS:
s := '**..*|=';
TranslatorTreeBuilder.ASSIGN_SADD:
s := '+=';
TranslatorTreeBuilder.ASSIGN_SSUB:
s := '-=';
TranslatorTreeBuilder.ASSIGN_QADD:
s := '++++=';
TranslatorTreeBuilder.ASSIGN_QADDS:
s := '+++|=';
TranslatorTreeBuilder.ASSIGN_QADDUS:
s := '+++#=';
TranslatorTreeBuilder.ASSIGN_QSUB:
s := '----=';
TranslatorTreeBuilder.ASSIGN_QSUBS:
s := '---|=';
TranslatorTreeBuilder.ASSIGN_QSUBUS:
s := '---#=';
TranslatorTreeBuilder.ASSIGN_OADD:
s := '++..++=';
TranslatorTreeBuilder.ASSIGN_OADDS:
s := '++..+|=';
TranslatorTreeBuilder.ASSIGN_OADDUS:
s := '++..+#=';
TranslatorTreeBuilder.ASSIGN_OSUB:
s := '--..--=';
TranslatorTreeBuilder.ASSIGN_OSUBS:
s := '--..-|=';
TranslatorTreeBuilder.ASSIGN_OSUBUS:
s := '--..-#=';
TranslatorTreeBuilder.ASSIGN_SSLL:
s := '<<=';
TranslatorTreeBuilder.ASSIGN_SSRA:
s := '>>=';
TranslatorTreeBuilder.ASSIGN_SSRL:
s := '>>>=';
TranslatorTreeBuilder.ASSIGN_QSLL:
s := '<<<<=';
TranslatorTreeBuilder.ASSIGN_QSRA:
s := '>>>>=';
TranslatorTreeBuilder.ASSIGN_QSRL:
s := '>>>>>=';
TranslatorTreeBuilder.ASSIGN_OSLL:
s := '<<..<<=';
TranslatorTreeBuilder.ASSIGN_OSRA:
s := '>>..>>=';
TranslatorTreeBuilder.ASSIGN_OSRL:
s := '>>..>>>=';
TranslatorTreeBuilder.ASSIGN_QGT:
s := '>>||=';
TranslatorTreeBuilder.ASSIGN_QGE:
s := '>=||=';
TranslatorTreeBuilder.ASSIGN_QLT:
s := '<<||=';
TranslatorTreeBuilder.ASSIGN_QLE:
s := '<=||=';
TranslatorTreeBuilder.ASSIGN_OGT:
s := '>>|..|=';
TranslatorTreeBuilder.ASSIGN_OGE:
s := '>=|..|=';
TranslatorTreeBuilder.ASSIGN_OLT:
s := '<<|..|=';
TranslatorTreeBuilder.ASSIGN_OLE:
s := '<=|..|=';
TranslatorTreeBuilder.ASSIGN_QEQ:
s := '==||=';
TranslatorTreeBuilder.ASSIGN_QNE:
s := '!=||=';
TranslatorTreeBuilder.ASSIGN_OEQ:
s := '==|..|=';
TranslatorTreeBuilder.ASSIGN_ONE:
s := '!=|..|=';
TranslatorTreeBuilder.ASSIGN_SANDB:
s := '&=';
TranslatorTreeBuilder.ASSIGN_SXORB:
s := '^=';
TranslatorTreeBuilder.ASSIGN_SORB:
s := '|=';
TranslatorTreeBuilder.JUMP:
s := 'jump';
TranslatorTreeBuilder.TF_JUMP:
s := 'jump finally';
else
s := '<unknown>';
end;
if length(labelName) > 0 then begin
stream.write(stringToByteArray(#$20 + stringToUTF8(labelName) + ': ' + s));
end else begin
stream.write(stringToByteArray(#$20 + s));
end;
if (dataType <> nil) or (associate <> nil) then begin
stream.write(stringToByteArray(' (type='));
if dataType <> nil then begin
kind := dataType.kind;
s := dataType.toString();
end else begin
kind := -1;
s := 'null';
end;
stream.write(stringToByteArray(s + ', asoc='));
if associate <> nil then begin
s := '(' + (associate as TObject).getClass().getSimpleName() + ') ';
if associate is BuilderNode then begin
node := associate as BuilderNode;
compiledLabelNumber := node.labelNumber;
assignedLabelNumber := node.assignedLabelNumber;
if compiledLabelNumber >= 0 then begin
s := s + 'C' + intToString(compiledLabelNumber) + #$20;
end;
if assignedLabelNumber >= 0 then begin
s := s + '.L.' + intToString(assignedLabelNumber);
end else begin
s := s + '$' + intToHexString(node.getHashCode());
end;
end else
if (kind = TranslatorType.KIND_BOOLEAN) and (associate is BooleanAsObject) then begin
if (associate as BooleanAsObject).booleanValue() = true then begin
s := s + 'true';
end else begin
s := s + 'false';
end;
end else
if ((kind = TranslatorType.KIND_CHAR) or (kind = TranslatorType.KIND_BYTE) or
(kind = TranslatorType.KIND_SHORT) or (kind = TranslatorType.KIND_INT)) and
(associate is IntegerAsObject) then begin
ival := (associate as IntegerAsObject).intValue();
s := s + intToString(ival) + ' [' + intToHexString(ival) + ']';
end else
if (kind = TranslatorType.KIND_LONG) and (associate is LongAsObject) then begin
lval := (associate as LongAsObject).longValue();
s := s + longToString(lval) + 'L [' + longToHexString(lval) + ']';
end else
if (kind = TranslatorType.KIND_ULTRA) and (associate is UltraAsObject) then begin
uval := (associate as UltraAsObject).ultraValue();
s := s + 'new ultra { ' +
intToString(uval.ints[0]) + ', ' + intToString(uval.ints[1]) + ', ' +
intToString(uval.ints[2]) + ', ' + intToString(uval.ints[3]) + ' } [' +
intToHexString(uval.ints[3]) + #$20 + intToHexString(uval.ints[2]) + #$20 +
intToHexString(uval.ints[1]) + #$20 + intToHexString(uval.ints[0]) + ']';
end else
if (kind = TranslatorType.KIND_FLOAT) and (associate is FloatAsObject) then begin
rval := (associate as FloatAsObject).floatValue();
with RealValueRepresenter.create(RealValueRepresenter.FLOAT_SIGNIFICAND_DIGITS,
RealValueRepresenter.FLOAT_ORDER_DIGITS) do begin
try
s := s + toString(rval) + 'F [' +
intToHexString(floatToIntBits(rval)) + ']';
finally
free();
end;
end;
end else
if (kind = TranslatorType.KIND_DOUBLE) and (associate is DoubleAsObject) then begin
rval := (associate as DoubleAsObject).doubleValue();
with RealValueRepresenter.create(RealValueRepresenter.DOUBLE_SIGNIFICAND_DIGITS,
RealValueRepresenter.DOUBLE_ORDER_DIGITS) do begin
try
s := s + toString(rval) + 'D [' +
longToHexString(doubleToLongBits(rval)) + ']';
finally
free();
end;
end;
end else
if (kind = TranslatorType.KIND_REAL) and (associate is RealAsObject) then begin
rval := (associate as RealAsObject).realValue();
s := s + realToString(rval) + 'R [' +
shortToHexString(realExtractExponent(rval)) + #$20 +
longToHexString(realExtractSignificand(rval)) + ']';
end else
if (kind = TranslatorType.KIND_XVECTOR) and (associate is XVectorAsObject) then begin
xval := (associate as XVectorAsObject).xvectorValue();
with RealValueRepresenter.create(RealValueRepresenter.FLOAT_SIGNIFICAND_DIGITS,
RealValueRepresenter.FLOAT_ORDER_DIGITS) do begin
try
s := s + 'new xvector { ' +
toString(xval.floats[0]) + 'F, ' +
toString(xval.floats[1]) + 'F, ' +
toString(xval.floats[2]) + 'F, ' +
toString(xval.floats[3]) + 'F } [' +
intToHexString(floatToIntBits(xval.floats[3])) + #$20 +
intToHexString(floatToIntBits(xval.floats[2])) + #$20 +
intToHexString(floatToIntBits(xval.floats[1])) + #$20 +
intToHexString(floatToIntBits(xval.floats[0])) + ']';
finally
free();
end;
end;
end else
if (kind = TranslatorType.KIND_ARRAY) and
(associate is UnicodeStringAsObject) then begin
s := s + '"' + stringToUTF8(
(associate as UnicodeStringAsObject).unicodeStringValue()) + '"';
end else begin
s := s + associate.toString();
end;
end else begin
s := 'null';
end;
stream.write(stringToByteArray(s + ')'));
end;
if (goIfTrueToNode <> nil) or (goIfFalseToNode <> nil) then begin
stream.write(stringToByteArray(' (ifTrue→'));
if goIfTrueToNode <> nil then begin
node := goIfTrueToNode as BuilderNode;
compiledLabelNumber := node.labelNumber;
assignedLabelNumber := node.assignedLabelNumber;
if compiledLabelNumber >= 0 then begin
s := 'C' + intToString(compiledLabelNumber) + #$20;
end else begin
s := '';
end;
if assignedLabelNumber >= 0 then begin
s := s + '.L.' + intToString(assignedLabelNumber);
end else begin
s := s + '$' + intToHexString(node.getHashCode());
end;
end else begin
s := 'null';
end;
stream.write(stringToByteArray(s + ', ifFalse→'));
if goIfFalseToNode <> nil then begin
node := goIfFalseToNode as BuilderNode;
compiledLabelNumber := node.labelNumber;
assignedLabelNumber := node.assignedLabelNumber;
if compiledLabelNumber >= 0 then begin
s := 'C' + intToString(compiledLabelNumber) + #$20;
end else begin
s := '';
end;
if assignedLabelNumber >= 0 then begin
s := s + '.L.' + intToString(assignedLabelNumber);
end else begin
s := s + '$' + intToHexString(node.getHashCode());
end;
end else begin
s := 'null';
end;
stream.write(stringToByteArray(s + ')'));
end else
if goAlwaysToNode <> nil then begin
stream.write(stringToByteArray(' (always→'));
node := goAlwaysToNode as BuilderNode;
compiledLabelNumber := node.labelNumber;
assignedLabelNumber := node.assignedLabelNumber;
if compiledLabelNumber >= 0 then begin
s := 'C' + intToString(compiledLabelNumber) + #$20;
end else begin
s := '';
end;
if assignedLabelNumber >= 0 then begin
s := s + '.L.' + intToString(assignedLabelNumber);
end else begin
s := s + '$' + intToHexString(node.getHashCode());
end;
stream.write(stringToByteArray(s + ')'));
end;
result := stream.toString();
end;
procedure TranslatorBuilderNode.clearData();
begin
inherited clearData();
optimized := false;
assignedLabelNumber := -1;
labelName := '';
end;
procedure TranslatorBuilderNode.setOptimized(optimized: boolean);
begin
self.optimized := optimized;
end;
procedure TranslatorBuilderNode.setAssignedLabelNumber(assignedLabelNumber: int);
begin
self.assignedLabelNumber := assignedLabelNumber;
end;
procedure TranslatorBuilderNode.setLabelName(const labelName: UnicodeString);
begin
self.labelName := labelName;
end;
function TranslatorBuilderNode.isOptimized(): boolean;
begin
result := optimized;
end;
function TranslatorBuilderNode.getAssignedLabelNumber(): int;
begin
result := assignedLabelNumber;
end;
function TranslatorBuilderNode.getLabelName(): UnicodeString;
begin
result := labelName;
end;
{ TranslatorTreeBuilder }
class function TranslatorTreeBuilder.isNodeValueAssign(value: int): boolean;
begin
case value of
EXPR_INCR_POST, EXPR_DECR_POST, EXPR_INCR_PRED, EXPR_DECR_PRED, 600..699:
result := true;
else
result := false;
end;
end;
class function TranslatorTreeBuilder.getTypeKind(theType: TypeDescriptor): int;
begin
if theType = nil then begin
result := -1;
end else begin
result := theType.kind;
end;
end;
class function TranslatorTreeBuilder.ultraToXVector(const value: ultra): xvector;
begin
result := ((TranslatorLocalConstantUltra.create(nil, value)) as
GlobalConstant).getXVectorValue();
end;
class function TranslatorTreeBuilder.xvectorToUltra(const value: xvector): ultra;
begin
result := ((TranslatorLocalConstantXVector.create(nil, value)) as
GlobalConstant).getUltraValue();
end;
class function TranslatorTreeBuilder.getArrayOfParents(node: Node): Node_Array1d;
var
c: int;
pstack: Stack;
begin
pstack := Stack.create();
try
repeat
node := node.parent as Node;
if node = nil then begin
break;
end;
pstack.push(node);
until false;
c := pstack.size();
result := Node_Array1d(Interface_Array1d_create(c));
pstack.copyInto(Interface_Array1d(result));
finally
pstack.free();
end;
end;
class function TranslatorTreeBuilder.getCommonParent(node1, node2: Node): Node;
var
i1: int;
i2: int;
parents1: Node_Array1d;
parents2: Node_Array1d;
begin
parents1 := getArrayOfParents(node1);
parents2 := getArrayOfParents(node2);
i1 := length(parents1) - 1;
i2 := length(parents2) - 1;
if (i1 < 0) or (i2 < 0) or (parents1[i1] <> parents2[i2]) then begin
result := nil;
exit;
end;
repeat
dec(i1);
dec(i2);
if i1 < 0 then begin
result := parents1[0];
break;
end;
if i2 < 0 then begin
result := parents2[0];
break;
end;
if parents1[i1] <> parents2[i2] then begin
result := parents1[i1 + 1];
break;
end;
until false;
end;
class function TranslatorTreeBuilder.insertTypeCast(node: SyntaxNode;
cast: TypeDescriptor): SyntaxNode;
begin
result := node;
case node.value of
EXPR_VALUE_NULL:
node.dataType := cast;
EXPR_VALUE_BOOLEAN: ;
EXPR_VALUE_INT:
case cast.kind of
TranslatorType.KIND_CHAR:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as IntegerAsObject).intValue() and $ffff);
TranslatorType.KIND_BYTE:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as IntegerAsObject).byteValue());
TranslatorType.KIND_SHORT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as IntegerAsObject).shortValue());
TranslatorType.KIND_INT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as IntegerAsObject).intValue());
TranslatorType.KIND_LONG:
node.setDataAssociate(node.position, EXPR_VALUE_LONG, cast, int64(
(node.associate as IntegerAsObject).intValue()));
TranslatorType.KIND_ULTRA:
node.setDataAssociate(node.position, EXPR_VALUE_ULTRA, cast, ultraBuild(0,
(node.associate as IntegerAsObject).intValue()));
TranslatorType.KIND_FLOAT:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, realToFloat(intToReal(
(node.associate as IntegerAsObject).intValue())));
TranslatorType.KIND_DOUBLE:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, realToDouble(intToReal(
(node.associate as IntegerAsObject).intValue())));
TranslatorType.KIND_REAL:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, intToReal(
(node.associate as IntegerAsObject).intValue()));
TranslatorType.KIND_XVECTOR:
node.setDataAssociate(node.position, EXPR_VALUE_XVECTOR, cast, xvectorBuild(0, 0, 0,
(node.associate as IntegerAsObject).intValue()));
end;
EXPR_VALUE_LONG:
case cast.kind of
TranslatorType.KIND_CHAR:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as LongAsObject).intValue() and $ffff);
TranslatorType.KIND_BYTE:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as LongAsObject).byteValue());
TranslatorType.KIND_SHORT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as LongAsObject).shortValue());
TranslatorType.KIND_INT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as LongAsObject).intValue());
TranslatorType.KIND_LONG:
node.setDataAssociate(node.position, EXPR_VALUE_LONG, cast,
(node.associate as LongAsObject).longValue());
TranslatorType.KIND_ULTRA:
node.setDataAssociate(node.position, EXPR_VALUE_ULTRA, cast, ultraBuild(0,
(node.associate as LongAsObject).longValue()));
TranslatorType.KIND_FLOAT:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, realToFloat(longToReal(
(node.associate as LongAsObject).longValue())));
TranslatorType.KIND_DOUBLE:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, realToDouble(longToReal(
(node.associate as LongAsObject).longValue())));
TranslatorType.KIND_REAL:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, longToReal(
(node.associate as LongAsObject).longValue()));
TranslatorType.KIND_XVECTOR:
node.setDataAssociate(node.position, EXPR_VALUE_XVECTOR, cast, xvectorBuild(0, 0, 0,
(node.associate as LongAsObject).longValue()));
end;
EXPR_VALUE_ULTRA:
case cast.kind of
TranslatorType.KIND_CHAR:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as UltraAsObject).intValue() and $ffff);
TranslatorType.KIND_BYTE:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as UltraAsObject).byteValue());
TranslatorType.KIND_SHORT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as UltraAsObject).shortValue());
TranslatorType.KIND_INT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as UltraAsObject).intValue());
TranslatorType.KIND_LONG:
node.setDataAssociate(node.position, EXPR_VALUE_LONG, cast,
(node.associate as UltraAsObject).longValue());
TranslatorType.KIND_ULTRA:
node.setDataAssociate(node.position, EXPR_VALUE_ULTRA, cast,
(node.associate as UltraAsObject).ultraValue());
TranslatorType.KIND_FLOAT:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, realToFloat(longToReal(
(node.associate as UltraAsObject).longValue())));
TranslatorType.KIND_DOUBLE:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, realToDouble(longToReal(
(node.associate as UltraAsObject).longValue())));
TranslatorType.KIND_REAL:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast, longToReal(
(node.associate as UltraAsObject).longValue()));
TranslatorType.KIND_XVECTOR:
node.setDataAssociate(node.position, EXPR_VALUE_XVECTOR, cast, ultraToXVector(
(node.associate as UltraAsObject).ultraValue()));
end;
EXPR_VALUE_REAL:
case cast.kind of
TranslatorType.KIND_CHAR:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as RealAsObject).intValue() and $ffff);
TranslatorType.KIND_BYTE:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as RealAsObject).byteValue());
TranslatorType.KIND_SHORT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as RealAsObject).shortValue());
TranslatorType.KIND_INT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as RealAsObject).intValue());
TranslatorType.KIND_LONG:
node.setDataAssociate(node.position, EXPR_VALUE_LONG, cast,
(node.associate as RealAsObject).longValue());
TranslatorType.KIND_ULTRA:
node.setDataAssociate(node.position, EXPR_VALUE_ULTRA, cast, ultraBuild(0,
(node.associate as RealAsObject).longValue()));
TranslatorType.KIND_FLOAT:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast,
(node.associate as RealAsObject).floatValue());
TranslatorType.KIND_DOUBLE:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast,
(node.associate as RealAsObject).doubleValue());
TranslatorType.KIND_REAL:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast,
(node.associate as RealAsObject).realValue());
TranslatorType.KIND_XVECTOR:
node.setDataAssociate(node.position, EXPR_VALUE_XVECTOR, cast, xvectorBuild(0, 0, 0,
(node.associate as RealAsObject).floatValue()));
end;
EXPR_VALUE_XVECTOR:
case cast.kind of
TranslatorType.KIND_CHAR:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as XVectorAsObject).intValue() and $ffff);
TranslatorType.KIND_BYTE:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as XVectorAsObject).byteValue());
TranslatorType.KIND_SHORT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as XVectorAsObject).shortValue());
TranslatorType.KIND_INT:
node.setDataAssociate(node.position, EXPR_VALUE_INT, cast,
(node.associate as XVectorAsObject).intValue());
TranslatorType.KIND_LONG:
node.setDataAssociate(node.position, EXPR_VALUE_LONG, cast,
(node.associate as XVectorAsObject).longValue());
TranslatorType.KIND_ULTRA:
node.setDataAssociate(node.position, EXPR_VALUE_ULTRA, cast, xvectorToUltra(
(node.associate as XVectorAsObject).xvectorValue()));
TranslatorType.KIND_FLOAT:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast,
(node.associate as XVectorAsObject).floatValue());
TranslatorType.KIND_DOUBLE:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast,
(node.associate as XVectorAsObject).doubleValue());
TranslatorType.KIND_REAL:
node.setDataAssociate(node.position, EXPR_VALUE_REAL, cast,
(node.associate as XVectorAsObject).realValue());
TranslatorType.KIND_XVECTOR:
node.setDataAssociate(node.position, EXPR_VALUE_XVECTOR, cast,
(node.associate as XVectorAsObject).xvectorValue());
end;
else
if (node.dataType as TObject) <> (cast as TObject) then begin
result := node.owner.addNodeBefore(node) as SyntaxNode;
result.setDataAssociate(-1, EXPR_TYPE_CAST, cast, cast);
node.setParent(result, 0);
end;
end;
end;
class function TranslatorTreeBuilder.getNodeWithMinLabelNumber(node, next: SyntaxNode): SyntaxNode;
begin
result := node.getChildWithMinLabelNumber();
if result = nil then begin
result := next;
end;
end;
class function TranslatorTreeBuilder.findLocalVariable(const name: UnicodeString;
parent: SyntaxNode): LocalVariable;
var
i: int;
child: SyntaxNode;
local: LocalVariable;
begin
repeat
for i := parent.getChildrensCount() - 1 downto 0 do begin
child := parent.getChild(i) as SyntaxNode;
case child.value of
OPERATOR_VARIABLE, BLOCK_WITH: begin
local := child.associate as LocalVariable;
if local.name = name then begin
result := local;
exit;
end;
end;
end;
end;
if parent.value = FUNCTION_START then begin
result := (parent.associate as GlobalFunction).functionType.findArgument(name);
if result <> nil then begin
exit;
end;
end;
parent := parent.parent as SyntaxNode;
until parent = nil;
result := nil;
end;
constructor TranslatorTreeBuilder.create(operandSize, extension: int);
var
lengthType: TypePrimitive;
begin
inherited create(operandSize, extension);
if operandSize >= TranslatorType.SIZE_32_BIT then begin
lengthType := typeInt;
end else begin
lengthType := typeShort;
end;
self.arrayLengthField := TranslatorStructureField.create(nil, 0, true, lengthType, 'length');
end;
function TranslatorTreeBuilder.buildSyntaxTree(forFunction: GlobalFunction): Tree;
var
optimized: boolean;
i: int;
c: int;
aln: int;
position: int;
lexemes: Lexer;
nmsp: Namespace;
tree: SyntaxTree;
root: SyntaxNode;
next: SyntaxNode;
last: BuilderNode;
node: BuilderNode;
rtyp: TypeDescriptor;
begin
{ проверка возможности построения }
if forFunction = nil then begin
raise NullPointerException.create(msgNullPointer);
end;
if forFunction.isAssembler() then begin
result := nil;
exit;
end;
{ инициализация переменных }
currWithVarNum := 0;
nmsp := forFunction.owner;
lexemes := nmsp.lexemes;
position := forFunction.startPosition;
{ создание дерева разбора }
tree := TranslatorSyntaxTree.create(lexemes, TranslatorBuilderNode);
root := tree.root as SyntaxNode;
try
{ построение дерева разбора }
root.setDataAssociate(position, FUNCTION_START, nil, forFunction);
if length(nmsp.name) <= 0 then begin
next := insertInitializations(root);
end else begin
next := root;
end;
position := parseOpBlock(lexemes, position + 1, next);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
last := tree.addChildLast(root) as BuilderNode;
last.setDataAssociate(position, FUNCTION_RETURN, nil, nil);
last.optimized := true;
{ нумерация узлов }
tree.assignLabelNumberTo(root);
c := root.getChildrensCount() - 2;
for i := 0 to c do begin
numerateNodes(root.getChild(i) as SyntaxNode);
end;
tree.assignLabelNumberTo(last);
{ расстановка переходов }
next := last;
for i := c downto 0 do begin
next := placeJumpsInOperator(root.getChild(i) as SyntaxNode, next);
end;
{ оптимизация переходов }
optimizeJumps(tree, false);
{ проверка достижимости }
repeat
optimized := false;
for i := tree.getNodesWithLabelNumberCount() - 1 downto 1 do begin
node := tree.getNodeWithLabelNumber(i) as BuilderNode;
if not isReachable(node) then begin
if node.optimized = false then begin
position := node.position;
if position >= 0 then begin
raise CompileError.create(msgDetectedUnreachableCode, lexemes,
position);
end;
end;
node.goAlwaysToNode := nil;
tree.deleteLabelNumber(i);
optimized := true;
end;
end;
until not optimized;
{ проверка обязательного возврата значения функциями }
rtyp := forFunction.functionType.getReturnType();
if (rtyp <> nil) and (rtyp.kind <> TranslatorType.KIND_VOID) and
not isReturnTo(last) then begin
position := last.position;
raise CompileError.create(msgFunctionShouldReturnValue, lexemes, position);
end;
{ оптимизация переходов через return }
optimizeJumps(tree, true);
{ присвоение номеров меток }
c := tree.getNodesWithLabelNumberCount() - 1;
aln := 0;
for i := 1 to c do begin
node := tree.getNodeWithLabelNumber(i) as BuilderNode;
if hasLinksTo(node) then begin
node.assignedLabelNumber := aln;
inc(aln);
end;
end;
except
tree.deleteChildrens(root);
root.clearData();
tree := nil;
raise;
end;
result := tree;
end;
function TranslatorTreeBuilder.possibleAssign(dstType, srcType: TypeDescriptor;
srcAsoc: _Interface): boolean;
var
asocIsLong: boolean;
dstTypeKind: int;
srcTypeKind: int;
srcAsocLong: long;
begin
dstTypeKind := getTypeKind(dstType);
srcTypeKind := getTypeKind(srcType);
asocIsLong := ((
(srcTypeKind = TranslatorType.KIND_CHAR) or
(srcTypeKind = TranslatorType.KIND_BYTE) or
(srcTypeKind = TranslatorType.KIND_SHORT) or
(srcTypeKind = TranslatorType.KIND_INT)) and
(srcAsoc is IntegerAsObject)) or ((
(srcTypeKind = TranslatorType.KIND_LONG)) and
(srcAsoc is LongAsObject));
if asocIsLong then begin
if srcTypeKind = TranslatorType.KIND_LONG then begin
srcAsocLong := (srcAsoc as LongAsObject).longValue();
end else begin
srcAsocLong := (srcAsoc as IntegerAsObject).intValue();
end;
result := (dstType is TypePrimitive) and
(dstType as TypePrimitive).possibleAssignLong(srcAsocLong);
end else begin
result := false;
end;
result := result or (
(srcType <> nil) and srcType.possibleAssignTo(dstType)) or (
(srcType = nil) and (
(dstTypeKind = TranslatorType.KIND_STRUCT) or
(dstTypeKind = TranslatorType.KIND_ARRAY) or
(dstTypeKind = TranslatorType.KIND_FUNC)));
end;
function TranslatorTreeBuilder.parseExprPost(lexemes: Lexer; position: int;
parent, child: SyntaxNode): int;
var
i: int;
count: int;
index: int;
typeKind: int;
typeResu: TypeDescriptor;
typeArgu: TypeDescriptor;
typeArra: TypeArray;
typeFunc: TypeFunction;
typeStru: TypeStructure;
fildAsoc: StructureField;
nodeOper: SyntaxNode;
nodeArgu: SyntaxNode;
nodeAsoc: _Interface;
readNode: SyntaxNode;
readAsoc: _Interface;
where: Namespace;
owner: Tree;
ident: UnicodeString;
begin
nodeArgu := child;
typeResu := nodeArgu.dataType;
owner := parent.owner;
where := ((owner.root as SyntaxNode).associate as GlobalFunction).owner;
repeat
typeKind := getTypeKind(typeResu);
case lexemes.getType(position) of
TranslatorLexer.OPENED_SQUARE_BRACKET: begin
case typeKind of
TranslatorType.KIND_ARRAY: begin
typeArra := typeResu as TypeArray;
typeResu := typeArra.elementType;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_ARRAY, typeResu, nil);
nodeArgu.setParent(nodeOper, 0);
position := parseExprAssign(lexemes, position + 1, nodeOper);
readNode := nodeOper.getChild(1) as SyntaxNode;
if not possibleAssign(typeInt, readNode.dataType, readNode.associate) then begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
raise CompileError.create(msgTypeMustBeShort, lexemes, position);
end else begin
raise CompileError.create(msgTypeMustBeInt, lexemes, position);
end;
end;
if operandSize < TranslatorType.SIZE_32_BIT then begin
insertTypeCast(readNode, typeShort);
end else begin
insertTypeCast(readNode, typeInt);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeInt;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_COMPOUND, typeResu, nil);
nodeArgu.setParent(nodeOper, 0);
position := parseExprAssign(lexemes, position + 1, nodeOper);
readNode := nodeOper.getChild(1) as SyntaxNode;
if not possibleAssign(typeInt, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgTypeMustBeInt, lexemes, position);
end;
readNode := insertTypeCast(readNode, typeInt);
readAsoc := readNode.associate;
if (readNode.value = EXPR_VALUE_INT) and (readAsoc is IntegerAsObject) then begin
index := (readAsoc as IntegerAsObject).intValue();
if (index < 0) or (index > 3) then begin
raise CompileError.create(msgCompoundIndexOutOfBounds, lexemes, position);
end;
nodeAsoc := nodeArgu.associate;
if (nodeArgu.value = EXPR_VALUE_ULTRA) and
(nodeAsoc is UltraAsObject) then begin
nodeOper.setDataAssociate(nodeOper.position, EXPR_VALUE_INT, typeResu,
(nodeAsoc as UltraAsObject).getInt(index));
owner.deleteChildrens(nodeOper);
end;
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResu := typeFloat;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_COMPOUND, typeResu, nil);
nodeArgu.setParent(nodeOper, 0);
position := parseExprAssign(lexemes, position + 1, nodeOper);
readNode := nodeOper.getChild(1) as SyntaxNode;
if not possibleAssign(typeInt, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgTypeMustBeInt, lexemes, position);
end;
readNode := insertTypeCast(readNode, typeInt);
readAsoc := readNode.associate;
if (readNode.value = EXPR_VALUE_INT) and (readAsoc is IntegerAsObject) then begin
index := (readAsoc as IntegerAsObject).intValue();
if (index < 0) or (index > 3) then begin
raise CompileError.create(msgCompoundIndexOutOfBounds, lexemes, position);
end;
nodeAsoc := nodeArgu.associate;
if (nodeArgu.value = EXPR_VALUE_XVECTOR) and
(nodeAsoc is XVectorAsObject) then begin
nodeOper.setDataAssociate(nodeOper.position, EXPR_VALUE_REAL, typeResu,
(nodeAsoc as XVectorAsObject).getFloat(index));
owner.deleteChildrens(nodeOper);
end;
end;
end;
else
raise CompileError.create(msgTypeMustBeArray, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_SQUARE_BRACKET then begin
raise CompileError.create(msgExpectedClosedSquareBracket, lexemes, position);
end;
end;
TranslatorLexer.OPENED_PARENTHESIS: begin
if typeKind <> TranslatorType.KIND_FUNC then begin
raise CompileError.create(msgTypeMustBeFunction, lexemes, position);
end;
typeFunc := typeResu as TypeFunction;
typeResu := typeFunc.getReturnType();
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_CALL, typeResu, nil);
count := typeFunc.getArgumentsCount() - 1;
inc(position);
for i := 0 to count do begin
typeArgu := typeFunc.getArgument(i).dataType;
position := parseExprAssign(lexemes, position, nodeOper);
readNode := nodeOper.getChild(i) as SyntaxNode;
if not possibleAssign(typeArgu, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, position);
end;
insertTypeCast(readNode, typeArgu);
if i < count then begin
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
raise CompileError.create(msgExpectedComma, lexemes, position);
end;
inc(position);
end;
end;
nodeArgu.setParent(nodeOper, count + 1);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
end;
TranslatorLexer.PERIOD: begin
case typeKind of
TranslatorType.KIND_STRUCT: begin
inc(position);
if lexemes.getType(position) <> TranslatorLexer.IDENTIFIER then begin
raise CompileError.create(msgExpectedIdentifierOfField, lexemes, position);
end;
ident := lexemes.getValueUString(position);
typeStru := typeResu as TypeStructure;
fildAsoc := typeStru.findField(ident, true);
if (fildAsoc = nil) or not where.isVisible(fildAsoc) then begin
raise CompileError.create(msgExpectedIdentifierOfField, lexemes, position);
end;
typeResu := fildAsoc.dataType;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_FIELD, typeResu, fildAsoc);
nodeArgu.setParent(nodeOper, 0);
end;
TranslatorType.KIND_ARRAY: begin
inc(position);
if lexemes.getType(position) <> TranslatorLexer.IDENTIFIER then begin
raise CompileError.create(msgExpectedIdentifierOfField, lexemes, position);
end;
ident := lexemes.getValueUString(position);
fildAsoc := arrayLengthField;
if fildAsoc.name <> ident then begin
raise CompileError.create(msgExpectedIdentifierOfField, lexemes, position);
end;
typeResu := fildAsoc.dataType;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_FIELD, typeResu, fildAsoc);
nodeArgu.setParent(nodeOper, 0);
end;
else
raise CompileError.create(msgTypeMustBeStruct, lexemes, position);
end;
end;
TranslatorLexer.INCR: begin
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL: ;
else
raise CompileError.create(msgTypeMustBeNumeric, lexemes, position);
end;
case nodeArgu.value of
EXPR_LOCAL_VARIABLE, EXPR_GLOBAL_VARIABLE, EXPR_ARRAY, EXPR_FIELD: ;
else
raise CompileError.create(msgOperationApplicableOnlyToVar, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_INCR_POST, typeResu, nil);
nodeArgu.setParent(nodeOper, 0);
end;
TranslatorLexer.DECR: begin
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL: ;
else
raise CompileError.create(msgTypeMustBeNumeric, lexemes, position);
end;
case nodeArgu.value of
EXPR_LOCAL_VARIABLE, EXPR_GLOBAL_VARIABLE, EXPR_ARRAY, EXPR_FIELD: ;
else
raise CompileError.create(msgOperationApplicableOnlyToVar, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_DECR_POST, typeResu, nil);
nodeArgu.setParent(nodeOper, 0);
end;
else
break;
end;
inc(position);
nodeArgu := nodeOper;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprNew(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
i: int;
flag: boolean;
newPosition: int;
asgPosition: int;
exprTypeKind: int;
exprNode: SyntaxNode;
exprType: TypeDescriptor;
exprStru: TypeStructure;
fildNode: SyntaxNode;
fildType: TypeDescriptor;
fildAsoc: StructureField;
readNode: SyntaxNode;
where: Namespace;
owner: Tree;
ident: UnicodeString;
begin
owner := parent.owner;
newPosition := position;
inc(position);
where := ((owner.root as SyntaxNode).associate as GlobalFunction).owner;
exprType := tryParseType(where, position);
if exprType = nil then begin
raise CompileError.create(msgExpectedDataType, lexemes, position);
end;
position := stayPosition;
exprTypeKind := exprType.kind;
if lexemes.getType(position) = TranslatorLexer.OPENED_SQUARE_BRACKET then begin
if exprTypeKind = TranslatorType.KIND_ARRAY then begin
raise CompileError.create(msgLengthMustInFirstSquareBrackets, lexemes, position);
end;
if not exprType.isMatchForVariable() then begin
raise CompileError.create(msgTypeNotApplicableToVar, lexemes, position);
end;
exprNode := owner.addChildLast(parent) as SyntaxNode;
exprNode.setDataAssociate(newPosition, EXPR_NEW_ARRAY_BY_LENGTH, nil, nil);
position := parseExprAssign(lexemes, position + 1, exprNode);
readNode := exprNode.getChild(0) as SyntaxNode;
if not possibleAssign(typeInt, readNode.dataType, readNode.associate) then begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
raise CompileError.create(msgTypeMustBeShort, lexemes, position);
end else begin
raise CompileError.create(msgTypeMustBeInt, lexemes, position);
end;
end;
if operandSize < TranslatorType.SIZE_32_BIT then begin
insertTypeCast(readNode, typeShort);
end else begin
insertTypeCast(readNode, typeInt);
end;
repeat
if lexemes.getType(position) <> TranslatorLexer.CLOSED_SQUARE_BRACKET then begin
raise CompileError.create(msgExpectedClosedSquareBracket, lexemes, position);
end;
inc(position);
exprType := getCanonicalType(TranslatorTypeArray.create(operandSize, exprType));
if lexemes.getType(position) <> TranslatorLexer.OPENED_SQUARE_BRACKET then begin
break;
end;
inc(position);
until false;
exprNode.dataType := exprType;
result := position;
exit;
end;
case exprTypeKind of
TranslatorType.KIND_ARRAY: begin
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
inc(position);
exprNode := owner.addChildLast(parent) as SyntaxNode;
exprNode.setDataAssociate(newPosition, EXPR_NEW_ARRAY_BY_ELEMENTS, exprType, nil);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
fildType := (exprType as TypeArray).elementType;
i := 0;
repeat
fildNode := owner.addChildLast(exprNode) as SyntaxNode;
fildNode.setDataAssociate(-1, EXPR_ARRAY_ASSIGN, fildType, nil);
position := parseExprAssign(lexemes, position, fildNode);
readNode := fildNode.getChild(0) as SyntaxNode;
if not possibleAssign(fildType, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, position);
end;
insertTypeCast(readNode, fildType);
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
break;
end;
inc(position);
inc(i);
until false;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
end;
inc(position);
end;
TranslatorType.KIND_STRUCT: begin
exprNode := owner.addChildLast(parent) as SyntaxNode;
exprNode.setDataAssociate(newPosition, EXPR_NEW_STRUCT, exprType, nil);
if lexemes.getType(position) = TranslatorLexer.OPENED_CURLY_BRACKET then begin
inc(position);
exprStru := exprType as TypeStructure;
if lexemes.getType(position) = TranslatorLexer.IDENTIFIER then repeat
ident := lexemes.getValueUString(position);
fildAsoc := exprStru.findField(ident, true);
if (fildAsoc = nil) or not where.isVisible(fildAsoc) then begin
raise CompileError.create(msgExpectedIdentifierOfField, lexemes, position);
end;
fildType := fildAsoc.dataType;
fildNode := owner.addChildLast(exprNode) as SyntaxNode;
fildNode.setDataAssociate(position, EXPR_FIELD_ASSIGN, fildType, fildAsoc);
inc(position);
if lexemes.getType(position) <> TranslatorLexer.ASSIGN then begin
raise CompileError.create(msgExpectedAssign, lexemes, position);
end;
asgPosition := position;
position := parseExprAssign(lexemes, position + 1, fildNode);
readNode := fildNode.getChild(0) as SyntaxNode;
if not possibleAssign(fildType, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, asgPosition);
end;
insertTypeCast(readNode, fildType);
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
break;
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.IDENTIFIER then begin
raise CompileError.create(msgExpectedIdentifierOfField, lexemes, position);
end;
until false;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
inc(position);
end;
end;
TranslatorType.KIND_ULTRA: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgTypeNotSupported, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
inc(position);
exprNode := owner.addChildLast(parent) as SyntaxNode;
exprNode.setDataAssociate(newPosition, EXPR_NEW_ULTRA, exprType, nil);
flag := true;
for i := 0 to 3 do begin
position := parseExprAssign(lexemes, position, exprNode);
readNode := exprNode.getChild(i) as SyntaxNode;
if not possibleAssign(typeInt, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgTypeMustBeInt, lexemes, position);
end;
readNode := insertTypeCast(readNode, typeInt);
if (readNode.value <> EXPR_VALUE_INT) or
not (readNode.associate is IntegerAsObject) then begin
flag := false;
end;
if i < 3 then begin
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
raise CompileError.create(msgExpectedComma, lexemes, position);
end;
inc(position);
end;
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
inc(position);
if flag = true then begin
exprNode.setDataAssociate(newPosition, EXPR_VALUE_ULTRA, exprType, ultraBuild(
((exprNode.getChild(3) as SyntaxNode).associate as IntegerAsObject).intValue(),
((exprNode.getChild(2) as SyntaxNode).associate as IntegerAsObject).intValue(),
((exprNode.getChild(1) as SyntaxNode).associate as IntegerAsObject).intValue(),
((exprNode.getChild(0) as SyntaxNode).associate as IntegerAsObject).intValue()
));
owner.deleteChildrens(exprNode);
end;
end;
TranslatorType.KIND_XVECTOR: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgTypeNotSupported, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
inc(position);
exprNode := owner.addChildLast(parent) as SyntaxNode;
exprNode.setDataAssociate(newPosition, EXPR_NEW_XVECTOR, exprType, nil);
flag := true;
for i := 0 to 3 do begin
position := parseExprAssign(lexemes, position, exprNode);
readNode := exprNode.getChild(i) as SyntaxNode;
if not possibleAssign(typeFloat, readNode.dataType, readNode.associate) then begin
raise CompileError.create(msgTypeMustBeFloat, lexemes, position);
end;
readNode := insertTypeCast(readNode, typeFloat);
if (readNode.value <> EXPR_VALUE_REAL) or
not (readNode.associate is FloatAsObject) then begin
flag := false;
end;
if i < 3 then begin
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
raise CompileError.create(msgExpectedComma, lexemes, position);
end;
inc(position);
end;
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
inc(position);
if flag = true then begin
exprNode.setDataAssociate(newPosition, EXPR_VALUE_XVECTOR, exprType, xvectorBuild(
((exprNode.getChild(3) as SyntaxNode).associate as FloatAsObject).floatValue(),
((exprNode.getChild(2) as SyntaxNode).associate as FloatAsObject).floatValue(),
((exprNode.getChild(1) as SyntaxNode).associate as FloatAsObject).floatValue(),
((exprNode.getChild(0) as SyntaxNode).associate as FloatAsObject).floatValue()
));
owner.deleteChildrens(exprNode);
end;
end;
else
raise CompileError.create(msgTypeMustBeArray, lexemes, position);
end;
result := position;
end;
function TranslatorTreeBuilder.parseExprElem(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
value: int;
child: SyntaxNode;
withv: SyntaxNode;
assoc: _Interface;
local: LocalVariable;
dtype: TypeDescriptor;
owner: Tree;
begin
owner := parent.owner;
case lexemes.getType(position) of
TranslatorLexer.OPENED_PARENTHESIS: begin
position := parseExprAssign(lexemes, position + 1, parent);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
child := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
end;
TranslatorLexer.KW_NULL: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_NULL, nil, nil);
end;
TranslatorLexer.KW_FALSE: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_BOOLEAN, typeBoolean, false);
end;
TranslatorLexer.KW_TRUE: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_BOOLEAN, typeBoolean, true);
end;
TranslatorLexer.KW_NEW: begin
position := parseExprNew(lexemes, position, parent) - 1;
child := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
end;
TranslatorLexer.IDENTIFIER: begin
assoc := parseIdentifier(lexemes, position, parent);
if assoc is GlobalConstant then begin
child := owner.addChildLast(parent) as SyntaxNode;
with assoc as GlobalConstant do begin
dtype := dataType;
case dtype.kind of
TranslatorType.KIND_BOOLEAN:
child.setDataAssociate(position, EXPR_VALUE_BOOLEAN, dtype, booleanValue);
TranslatorType.KIND_CHAR:
child.setDataAssociate(position, EXPR_VALUE_INT, dtype, charValue);
TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT, TranslatorType.KIND_INT:
child.setDataAssociate(position, EXPR_VALUE_INT, dtype, intValue);
TranslatorType.KIND_LONG:
child.setDataAssociate(position, EXPR_VALUE_LONG, dtype, longValue);
TranslatorType.KIND_ULTRA:
child.setDataAssociate(position, EXPR_VALUE_ULTRA, dtype, getUltraValue());
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL:
child.setDataAssociate(position, EXPR_VALUE_REAL, dtype, realValue);
TranslatorType.KIND_XVECTOR:
child.setDataAssociate(position, EXPR_VALUE_XVECTOR, dtype, getXVectorValue());
end;
end;
end else
if assoc is GlobalVariable then begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_GLOBAL_VARIABLE,
(assoc as GlobalVariable).dataType, assoc);
end else
if assoc is GlobalFunction then begin
child := owner.addChildLast(parent) as SyntaxNode;
if not (assoc as GlobalFunction).isInterrupt() then begin
child.setDataAssociate(position, EXPR_GLOBAL_FUNCTION, getCanonicalType(
(assoc as GlobalFunction).functionType), assoc);
end else begin
case operandSize of
TranslatorType.SIZE_16_BIT:
child.setDataAssociate(position, EXPR_GLOBAL_FUNCTION, typeShort, assoc);
TranslatorType.SIZE_32_BIT:
child.setDataAssociate(position, EXPR_GLOBAL_FUNCTION, typeInt, assoc);
TranslatorType.SIZE_64_BIT:
child.setDataAssociate(position, EXPR_GLOBAL_FUNCTION, typeLong, assoc);
end;
end;
end else
if assoc is LocalVariable then begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_LOCAL_VARIABLE,
(assoc as LocalVariable).dataType, assoc);
end else
if assoc is FoundObject then begin
with assoc as FoundObject do begin
local := foundIn;
dtype := baseObject.dataType;
end;
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_FIELD, dtype, assoc);
withv := owner.addChildLast(child) as SyntaxNode;
withv.setDataAssociate(-1, EXPR_LOCAL_VARIABLE, local.dataType, local);
end else begin
raise CompileError.create(msgExpectedIdentifierOfVariable, lexemes, position);
end;
position := stayPosition - 1;
end;
TranslatorLexer.NUM_INT: begin
value := lexemes.getValueInt(position);
if operandSize < TranslatorType.SIZE_32_BIT then begin
if (value < -$8000) or (value > $ffff) then begin
raise CompileError.create(msgTypeNotSupported, lexemes, position);
end;
child := owner.addChildLast(parent) as SyntaxNode;
if value < $8000 then begin
child.setDataAssociate(position, EXPR_VALUE_INT, typeShort, value);
end else begin
child.setDataAssociate(position, EXPR_VALUE_INT, typeChar, value);
end;
end else begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_INT, typeInt, value);
end;
end;
TranslatorLexer.NUM_LONG: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgTypeNotSupported, lexemes, position);
end;
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_LONG, typeLong,
lexemes.getValueLong(position));
end;
TranslatorLexer.NUM_FLOAT: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_REAL, typeFloat,
lexemes.getValueReal(position));
end;
TranslatorLexer.NUM_DOUBLE: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_REAL, typeDouble,
lexemes.getValueReal(position));
end;
TranslatorLexer.NUM_REAL: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_REAL, typeReal,
lexemes.getValueReal(position));
end;
TranslatorLexer.STRING_LITERAL: begin
child := owner.addChildLast(parent) as SyntaxNode;
child.setDataAssociate(position, EXPR_VALUE_STRING, getCanonicalType(
TranslatorTypeArray.create(operandSize, typeChar)),
lexemes.getValueUString(position));
end;
else
raise CompileError.create(msgExpressionError, lexemes, position);
end;
result := parseExprPost(lexemes, position + 1, parent, child);
end;
function TranslatorTreeBuilder.parseExprPref(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
typeKind: int;
tempPosition: int;
currentAction: int;
operations: Stack;
typeResu: TypeDescriptor;
typeCast: TypeDescriptor;
nodeOper: SyntaxNode;
nodeArgu: SyntaxNode;
stackobj: _Interface;
owner: Tree;
begin
owner := parent.owner;
operations := nil;
try
repeat
currentAction := lexemes.getType(position);
case currentAction of
TranslatorLexer.SNOTB, TranslatorLexer.SNOTL,
TranslatorLexer.SPLUS, TranslatorLexer.SMINUS,
TranslatorLexer.INCR, TranslatorLexer.DECR,
TranslatorLexer.QPACKUS, TranslatorLexer.QUNPCKL, TranslatorLexer.QUNPCKH,
TranslatorLexer.QADD, TranslatorLexer.QSUB,
TranslatorLexer.OPACKUS, TranslatorLexer.OUNPCKL, TranslatorLexer.OUNPCKH,
TranslatorLexer.OADD, TranslatorLexer.OSUB: begin
if operations = nil then begin
operations := Stack.create(2);
end;
operations.push(position);
operations.push(currentAction);
end;
TranslatorLexer.OPENED_PARENTHESIS: begin
typeCast := tryParseType(((owner.root as SyntaxNode).associate as
GlobalFunction).owner, position + 1);
tempPosition := stayPosition;
if (typeCast = nil) or (lexemes.getType(tempPosition) <>
TranslatorLexer.CLOSED_PARENTHESIS) then begin
break;
end;
if operations = nil then begin
operations := Stack.create(2);
end;
operations.push(position);
operations.push(typeCast);
position := tempPosition;
end;
else
break;
end;
inc(position);
until false;
result := parseExprElem(lexemes, position, parent);
if operations = nil then begin
exit;
end;
nodeArgu := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeResu := nodeArgu.dataType;
repeat
stackobj := operations.pop();
position := (operations.pop() as IntegerAsObject).intValue();
if stackobj is TypeDescriptor then begin
typeCast := stackobj as TypeDescriptor;
typeKind := typeCast.kind;
if ((typeResu = nil) or not typeResu.possibleCastTo(typeCast)) and (
(typeResu <> nil) or (
(typeKind <> TranslatorType.KIND_STRUCT) and
(typeKind <> TranslatorType.KIND_ARRAY) and
(typeKind <> TranslatorType.KIND_FUNC))) then begin
raise CompileError.create(msgCannotCastToType, lexemes, position);
end;
typeResu := typeCast;
nodeOper := insertTypeCast(nodeArgu, typeCast);
nodeOper.position := position;
nodeArgu := nodeOper;
continue;
end;
typeKind := getTypeKind(typeResu);
case (stackobj as IntegerAsObject).intValue() of
TranslatorLexer.SNOTB: begin
currentAction := EXPR_SNOTB;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeResu := typeShort;
nodeArgu := insertTypeCast(nodeArgu, typeShort);
if nodeArgu.value = EXPR_VALUE_INT then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_INT, typeResu, short(
(nodeArgu.associate as IntegerAsObject).shortValue() xor -1));
continue;
end;
end else begin
typeResu := typeInt;
nodeArgu := insertTypeCast(nodeArgu, typeInt);
if nodeArgu.value = EXPR_VALUE_INT then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_INT, typeResu,
(nodeArgu.associate as IntegerAsObject).intValue() xor (-1));
continue;
end;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu,
(nodeArgu.associate as LongAsObject).longValue() xor (-1));
continue;
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeUltra);
if nodeArgu.value = EXPR_VALUE_ULTRA then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
(nodeArgu.associate as UltraAsObject).ultraValue() xor
ultraBuild(-1, -1));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.SNOTL: begin
currentAction := EXPR_SNOTL;
case typeKind of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArgu := insertTypeCast(nodeArgu, typeBoolean);
if nodeArgu.value = EXPR_VALUE_BOOLEAN then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_BOOLEAN, typeResu,
not (nodeArgu.associate as BooleanAsObject).booleanValue());
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.SPLUS: begin
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeResu := typeShort;
end else begin
typeResu := typeInt;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE,
TranslatorType.KIND_REAL: begin
{ typeResu := typeResu; }
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
nodeArgu := insertTypeCast(nodeArgu, typeResu);
continue;
end;
TranslatorLexer.SMINUS: begin
currentAction := EXPR_SNEG;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeResu := typeShort;
nodeArgu := insertTypeCast(nodeArgu, typeShort);
if nodeArgu.value = EXPR_VALUE_INT then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_INT, typeResu, short(
-(nodeArgu.associate as IntegerAsObject).shortValue()));
continue;
end;
end else begin
typeResu := typeInt;
nodeArgu := insertTypeCast(nodeArgu, typeInt);
if nodeArgu.value = EXPR_VALUE_INT then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_INT, typeResu,
-(nodeArgu.associate as IntegerAsObject).intValue());
continue;
end;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu,
-(nodeArgu.associate as LongAsObject).longValue());
continue;
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE,
TranslatorType.KIND_REAL: begin
{ typeResu := typeResu; }
nodeArgu := insertTypeCast(nodeArgu, typeResu);
if nodeArgu.value = EXPR_VALUE_REAL then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_REAL, typeResu,
-(nodeArgu.associate as RealAsObject).realValue());
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.INCR: begin
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL: ;
else
raise CompileError.create(msgTypeMustBeNumeric, lexemes, position);
end;
case nodeArgu.value of
EXPR_LOCAL_VARIABLE, EXPR_GLOBAL_VARIABLE, EXPR_ARRAY, EXPR_FIELD: ;
else
raise CompileError.create(msgOperationApplicableOnlyToVar, lexemes, position);
end;
currentAction := EXPR_INCR_PRED;
end;
TranslatorLexer.DECR: begin
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL: ;
else
raise CompileError.create(msgTypeMustBeNumeric, lexemes, position);
end;
case nodeArgu.value of
EXPR_LOCAL_VARIABLE, EXPR_GLOBAL_VARIABLE, EXPR_ARRAY, EXPR_FIELD: ;
else
raise CompileError.create(msgOperationApplicableOnlyToVar, lexemes, position);
end;
currentAction := EXPR_DECR_PRED;
end;
TranslatorLexer.QPACKUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_QPACKUS;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeInt;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_INT, typeResu,
mmxPack((nodeArgu.associate as LongAsObject).longValue()));
continue;
end;
end;
TranslatorType.KIND_ULTRA: begin
if extension < EXTENSION_SSE4_1 then begin
raise CompileError.create(msgOperationNotSupportedEX, lexemes, position);
end;
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeUltra);
if nodeArgu.value = EXPR_VALUE_ULTRA then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu,
pack4IntUS((nodeArgu.associate as UltraAsObject).ultraValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.QUNPCKL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_QUNPCKL;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeInt);
if nodeArgu.value = EXPR_VALUE_INT then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu,
mmxUnpackLo((nodeArgu.associate as IntegerAsObject).intValue()));
continue;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
sseiUnpackLo((nodeArgu.associate as LongAsObject).longValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.QUNPCKH: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_QUNPCKH;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeInt);
if nodeArgu.value = EXPR_VALUE_INT then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu,
mmxUnpackHi((nodeArgu.associate as IntegerAsObject).intValue()));
continue;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
sseiUnpackHi((nodeArgu.associate as LongAsObject).longValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.QADD: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeXVector;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
nodeArgu := insertTypeCast(nodeArgu, typeResu);
continue;
end;
TranslatorLexer.QSUB: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_QNEG;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu, mmxSub(0,
(nodeArgu.associate as LongAsObject).longValue()));
continue;
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeUltra);
if nodeArgu.value = EXPR_VALUE_ULTRA then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
sseiSub(ultraBuild(0, 0, 0, 0),
(nodeArgu.associate as UltraAsObject).ultraValue()));
continue;
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeXVector;
nodeArgu := insertTypeCast(nodeArgu, typeXVector);
if nodeArgu.value = EXPR_VALUE_XVECTOR then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_XVECTOR, typeResu,
ssefSub(xvectorBuild(0, 0, 0, 0),
(nodeArgu.associate as XVectorAsObject).xvectorValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.OPACKUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_OPACKUS;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeLong;
nodeArgu := insertTypeCast(nodeArgu, typeUltra);
if nodeArgu.value = EXPR_VALUE_ULTRA then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_LONG, typeResu,
ssesPack((nodeArgu.associate as UltraAsObject).ultraValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.OUNPCKL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_OUNPCKL;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
ssesUnpackLo((nodeArgu.associate as LongAsObject).longValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.OUNPCKH: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_OUNPCKH;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeLong);
if nodeArgu.value = EXPR_VALUE_LONG then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
ssesUnpackHi((nodeArgu.associate as LongAsObject).longValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
TranslatorLexer.OADD: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
nodeArgu := insertTypeCast(nodeArgu, typeResu);
continue;
end;
TranslatorLexer.OSUB: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
currentAction := EXPR_ONEG;
case typeKind of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArgu := insertTypeCast(nodeArgu, typeUltra);
if nodeArgu.value = EXPR_VALUE_ULTRA then begin
nodeArgu.setDataAssociate(position, EXPR_VALUE_ULTRA, typeResu,
ssesSub(ultraBuild(0, 0, 0, 0, 0, 0, 0, 0),
(nodeArgu.associate as UltraAsObject).ultraValue()));
continue;
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
end;
nodeOper := owner.addNodeBefore(nodeArgu) as SyntaxNode;
nodeOper.setDataAssociate(position, currentAction, typeResu, nil);
nodeArgu.setParent(nodeOper, 0);
nodeArgu := nodeOper;
until operations.isEmpty();
finally
operations.free();
end;
end;
function TranslatorTreeBuilder.parseExprMult(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
ival: int;
lval: long;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprPref(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SMULL: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SMULL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() *
(nodeArg2.associate as IntegerAsObject).shortValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() *
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() *
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(
(nodeArg1.associate as FloatAsObject).floatValue() *
(nodeArg2.associate as FloatAsObject).floatValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(
(nodeArg1.associate as DoubleAsObject).doubleValue() *
(nodeArg2.associate as DoubleAsObject).doubleValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
(nodeArg1.associate as RealAsObject).realValue() *
(nodeArg2.associate as RealAsObject).realValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SDIVS: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SDIVS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).shortValue();
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() div ival));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).intValue();
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() div ival);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if nodeArg2.value = EXPR_VALUE_LONG then begin
lval := (nodeArg2.associate as LongAsObject).longValue();
if lval = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
lval := 0;
end;
if (nodeArg1.value = EXPR_VALUE_LONG) and (lval <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() div lval);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(
(nodeArg1.associate as FloatAsObject).floatValue() /
(nodeArg2.associate as FloatAsObject).floatValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(
(nodeArg1.associate as DoubleAsObject).doubleValue() /
(nodeArg2.associate as DoubleAsObject).doubleValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
(nodeArg1.associate as RealAsObject).realValue() /
(nodeArg2.associate as RealAsObject).realValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SREMS: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SREMS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).shortValue();
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() mod ival));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).intValue();
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() mod ival);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if nodeArg2.value = EXPR_VALUE_LONG then begin
lval := (nodeArg2.associate as LongAsObject).longValue();
if lval = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
lval := 0;
end;
if (nodeArg1.value = EXPR_VALUE_LONG) and (lval <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() mod lval);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(realMod(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue())));
owner.deleteChildrens(nodeOper);
end else begin
nodeOper.dataType := typeReal;
nodeOper := insertTypeCast(nodeOper, typeResu);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(realMod(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue())));
owner.deleteChildrens(nodeOper);
end else begin
nodeOper.dataType := typeReal;
nodeOper := insertTypeCast(nodeOper, typeResu);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realMod(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SDIVU: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SDIVU, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).shortValue() and $ffff;
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
((nodeArg1.associate as IntegerAsObject).shortValue() and $ffff) div
ival));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).intValue();
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
intUDiv((nodeArg1.associate as IntegerAsObject).intValue(), ival));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if nodeArg2.value = EXPR_VALUE_LONG then begin
lval := (nodeArg2.associate as LongAsObject).longValue();
if lval = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
lval := 0;
end;
if (nodeArg1.value = EXPR_VALUE_LONG) and (lval <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
longUDiv((nodeArg1.associate as LongAsObject).longValue(), lval));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(
(nodeArg1.associate as FloatAsObject).floatValue() /
(nodeArg2.associate as FloatAsObject).floatValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(
(nodeArg1.associate as DoubleAsObject).doubleValue() /
(nodeArg2.associate as DoubleAsObject).doubleValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
(nodeArg1.associate as RealAsObject).realValue() /
(nodeArg2.associate as RealAsObject).realValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SREMU: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SREMU, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).shortValue() and $ffff;
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
((nodeArg1.associate as IntegerAsObject).shortValue() and $ffff) mod
ival));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if nodeArg2.value = EXPR_VALUE_INT then begin
ival := (nodeArg2.associate as IntegerAsObject).intValue();
if ival = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
ival := 0;
end;
if (nodeArg1.value = EXPR_VALUE_INT) and (ival <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
intUMod((nodeArg1.associate as IntegerAsObject).intValue(), ival));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if nodeArg2.value = EXPR_VALUE_LONG then begin
lval := (nodeArg2.associate as LongAsObject).longValue();
if lval = 0 then begin
raise CompileError.create(msgIntegerDivisionByZero, lexemes, operPosition);
end;
end else begin
lval := 0;
end;
if (nodeArg1.value = EXPR_VALUE_LONG) and (lval <> 0) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
longUMod((nodeArg1.associate as LongAsObject).longValue(), lval));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(realMod(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue())));
owner.deleteChildrens(nodeOper);
end else begin
nodeOper.dataType := typeReal;
nodeOper := insertTypeCast(nodeOper, typeResu);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(realMod(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue())));
owner.deleteChildrens(nodeOper);
end else begin
nodeOper.dataType := typeReal;
nodeOper := insertTypeCast(nodeOper, typeResu);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realMod(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QMULL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QMULL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxMulLo(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiMulLo(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResu := typeXVector;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_XVECTOR, typeResu, ssefMul(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QMULH: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QMULH, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxMulHi(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiMulHi(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QMULHS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QMULHS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxMulHiS(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QDIV: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QDIV, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_XVECTOR: begin
typeResu := typeXVector;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_XVECTOR, typeResu, ssefDiv(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OMULL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OMULL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesMulLo(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OMULH: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OMULH, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesMulHi(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OMULHS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OMULHS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprPref(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesMulHiS(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprAdd(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprMult(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SPLUS: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SADD, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() +
(nodeArg2.associate as IntegerAsObject).shortValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() +
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() +
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(
(nodeArg1.associate as FloatAsObject).floatValue() +
(nodeArg2.associate as FloatAsObject).floatValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(
(nodeArg1.associate as DoubleAsObject).doubleValue() +
(nodeArg2.associate as DoubleAsObject).doubleValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
(nodeArg1.associate as RealAsObject).realValue() +
(nodeArg2.associate as RealAsObject).realValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SMINUS: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SSUB, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() -
(nodeArg2.associate as IntegerAsObject).shortValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() -
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() -
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeFloat;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToFloat(
(nodeArg1.associate as FloatAsObject).floatValue() -
(nodeArg2.associate as FloatAsObject).floatValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeDouble;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
realToDouble(
(nodeArg1.associate as DoubleAsObject).doubleValue() -
(nodeArg2.associate as DoubleAsObject).doubleValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeReal;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResu,
(nodeArg1.associate as RealAsObject).realValue() -
(nodeArg2.associate as RealAsObject).realValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QADD: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QADD, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxAdd(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiAdd(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResu := typeXVector;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_XVECTOR, typeResu, ssefAdd(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QADDS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QADDS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxAddS(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QADDUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QADDUS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxAddUS(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QSUB: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QSUB, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxSub(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiSub(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResu := typeXVector;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_XVECTOR, typeResu, ssefSub(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QSUBS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QSUBS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxSubS(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QSUBUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QSUBUS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxSubUS(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OADD: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OADD, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesAdd(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OADDS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OADDS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesAddS(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OADDUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OADDUS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesAddUS(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OSUB: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OSUB, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesSub(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OSUBS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OSUBS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesSubS(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OSUBUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OSUBUS, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprMult(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesSubUS(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprShift(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprAdd(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SSLL: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SSLL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() shl
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end else begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() shl
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() shl
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SSRA: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SSRA, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, intSar(
(nodeArg1.associate as IntegerAsObject).shortValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end else begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, intSar(
(nodeArg1.associate as IntegerAsObject).intValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, longSar(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SSRL: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SSRL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE,
TranslatorType.KIND_SHORT, TranslatorType.KIND_INT: begin
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short((
(nodeArg1.associate as IntegerAsObject).shortValue() and $ffff) shr
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end else begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() shr
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() shr
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QSLL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QSLL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxShl(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiShl(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QSRA: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QSRA, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxSar(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiSar(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QSRL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QSRL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxShr(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiShr(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OSLL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OSLL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesShl(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OSRA: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OSRA, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesSar(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OSRL: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OSRL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprAdd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
if not possibleAssign(typeInt, typeArg2, nodeArg2.associate) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
case getTypeKind(typeArg1) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesShr(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as IntegerAsObject).intValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprRel(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprShift(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SGT: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SGT, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).shortValue() >
(nodeArg2.associate as IntegerAsObject).shortValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() >
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as LongAsObject).longValue() >
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as FloatAsObject).floatValue(),
(nodeArg2.associate as FloatAsObject).floatValue()) > 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as DoubleAsObject).doubleValue(),
(nodeArg2.associate as DoubleAsObject).doubleValue()) > 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()) > 0);
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SGE: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SGE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).shortValue() >=
(nodeArg2.associate as IntegerAsObject).shortValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() >=
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as LongAsObject).longValue() >=
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as FloatAsObject).floatValue(),
(nodeArg2.associate as FloatAsObject).floatValue()) >= 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as DoubleAsObject).doubleValue(),
(nodeArg2.associate as DoubleAsObject).doubleValue()) >= 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()) >= 0);
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SLT: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SLT, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).shortValue() <
(nodeArg2.associate as IntegerAsObject).shortValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() <
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as LongAsObject).longValue() <
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpg(
(nodeArg1.associate as FloatAsObject).floatValue(),
(nodeArg2.associate as FloatAsObject).floatValue()) < 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpg(
(nodeArg1.associate as DoubleAsObject).doubleValue(),
(nodeArg2.associate as DoubleAsObject).doubleValue()) < 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpg(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()) < 0);
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SLE: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SLE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_SHORT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).shortValue() <=
(nodeArg2.associate as IntegerAsObject).shortValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() <=
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as LongAsObject).longValue() <=
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpg(
(nodeArg1.associate as FloatAsObject).floatValue(),
(nodeArg2.associate as FloatAsObject).floatValue()) <= 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpg(
(nodeArg1.associate as DoubleAsObject).doubleValue(),
(nodeArg2.associate as DoubleAsObject).doubleValue()) <= 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpg(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()) <= 0);
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QGT: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QGT, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxGreate(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiGreate(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssefCmpg(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QGE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QGE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxGreate(
(nodeArg2.associate as LongAsObject).longValue(),
(nodeArg1.associate as LongAsObject).longValue()) xor (-1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiGreate(
(nodeArg2.associate as UltraAsObject).ultraValue(),
(nodeArg1.associate as UltraAsObject).ultraValue()) xor
ultraBuild(-1, -1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssefCmpge(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QLT: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QLT, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxGreate(
(nodeArg2.associate as LongAsObject).longValue(),
(nodeArg1.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiGreate(
(nodeArg2.associate as UltraAsObject).ultraValue(),
(nodeArg1.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssefCmpl(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QLE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QLE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxGreate(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()) xor (-1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiGreate(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()) xor
ultraBuild(-1, -1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssefCmple(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OGT: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OGT, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesGreate(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OGE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OGE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesGreate(
(nodeArg2.associate as UltraAsObject).ultraValue(),
(nodeArg1.associate as UltraAsObject).ultraValue()) xor
ultraBuild(-1, -1));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OLT: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OLT, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesGreate(
(nodeArg2.associate as UltraAsObject).ultraValue(),
(nodeArg1.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OLE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OLE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprShift(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesGreate(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()) xor
ultraBuild(-1, -1));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprEqual(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
typeKind1: int;
typeKind2: int;
nodeVal1: int;
nodeVal2: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprRel(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SEQ: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SEQ, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprRel(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
typeKind1 := getTypeKind(typeArg1);
typeKind2 := getTypeKind(typeArg2);
if ((typeKind1 = TranslatorType.KIND_STRUCT) or
(typeKind1 = TranslatorType.KIND_ARRAY) or
(typeKind1 = TranslatorType.KIND_FUNC)) and (
(typeKind2 = TranslatorType.KIND_STRUCT) or
(typeKind2 = TranslatorType.KIND_ARRAY) or
(typeKind2 = TranslatorType.KIND_FUNC)) and (
typeArg1.possibleAssignTo(typeArg2) or
typeArg2.possibleAssignTo(typeArg1)) then begin
typeResu := typeBoolean;
end else
if (typeKind2 = -1) and (
(typeKind1 = TranslatorType.KIND_STRUCT) or
(typeKind1 = TranslatorType.KIND_ARRAY) or
(typeKind1 = TranslatorType.KIND_FUNC)) then begin
typeResu := typeBoolean;
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SEQ_NULL, typeResu, nil);
end else
if (typeKind1 = -1) and (
(typeKind2 = TranslatorType.KIND_STRUCT) or
(typeKind2 = TranslatorType.KIND_ARRAY) or
(typeKind2 = TranslatorType.KIND_FUNC)) then begin
typeResu := typeBoolean;
owner.deleteNode(nodeArg1);
nodeOper.setDataAssociate(operPosition, EXPR_SEQ_NULL, typeResu, nil);
end else
if (typeKind1 = -1) and (typeKind2 = -1) then begin
typeResu := typeBoolean;
owner.deleteChildrens(nodeOper);
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, true);
end else
case getCommonTypeKind(typeKind1, typeKind2) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() =
(nodeArg2.associate as BooleanAsObject).booleanValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_SHORT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
nodeVal1 := nodeArg1.value;
nodeVal2 := nodeArg2.value;
if (nodeVal1 = EXPR_SANDB) and (nodeVal2 = EXPR_VALUE_INT) and
((nodeArg2.associate as IntegerAsObject).shortValue() = 0) then begin
nodeArg1.getChild(0).setParent(nodeOper, 0);
nodeArg1.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SZR_TEST, typeResu, nil);
end else
if (nodeVal2 = EXPR_SANDB) and (nodeVal1 = EXPR_VALUE_INT) and
((nodeArg1.associate as IntegerAsObject).shortValue() = 0) then begin
nodeArg2.getChild(0).setParent(nodeOper, 0);
nodeArg2.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SZR_TEST, typeResu, nil);
end else
if (nodeVal1 = EXPR_VALUE_INT) and (nodeVal2 = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).shortValue() =
(nodeArg2.associate as IntegerAsObject).shortValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
nodeVal1 := nodeArg1.value;
nodeVal2 := nodeArg2.value;
if (nodeVal1 = EXPR_SANDB) and (nodeVal2 = EXPR_VALUE_INT) and
((nodeArg2.associate as IntegerAsObject).intValue() = 0) then begin
nodeArg1.getChild(0).setParent(nodeOper, 0);
nodeArg1.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SZR_TEST, typeResu, nil);
end else
if (nodeVal2 = EXPR_SANDB) and (nodeVal1 = EXPR_VALUE_INT) and
((nodeArg1.associate as IntegerAsObject).intValue() = 0) then begin
nodeArg2.getChild(0).setParent(nodeOper, 0);
nodeArg2.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SZR_TEST, typeResu, nil);
end else
if (nodeVal1 = EXPR_VALUE_INT) and (nodeVal2 = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() =
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
nodeVal1 := nodeArg1.value;
nodeVal2 := nodeArg2.value;
if (nodeVal1 = EXPR_SANDB) and (nodeVal2 = EXPR_VALUE_LONG) and
((nodeArg2.associate as LongAsObject).longValue() = 0) then begin
nodeArg1.getChild(0).setParent(nodeOper, 0);
nodeArg1.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SZR_TEST, typeResu, nil);
end else
if (nodeVal2 = EXPR_SANDB) and (nodeVal1 = EXPR_VALUE_LONG) and
((nodeArg1.associate as LongAsObject).longValue() = 0) then begin
nodeArg2.getChild(0).setParent(nodeOper, 0);
nodeArg2.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SZR_TEST, typeResu, nil);
end else
if (nodeVal1 = EXPR_VALUE_LONG) and (nodeVal2 = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as LongAsObject).longValue() =
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
ssesPack(ssesShr(sseiEquals(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()), $08)) = (-1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as FloatAsObject).floatValue(),
(nodeArg2.associate as FloatAsObject).floatValue()) = 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as DoubleAsObject).doubleValue(),
(nodeArg2.associate as DoubleAsObject).doubleValue()) = 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()) = 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
ssesPack(ssesShr(ssefCmpe(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()), $08)) = -1);
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.SNE: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SNE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprRel(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
typeKind1 := getTypeKind(typeArg1);
typeKind2 := getTypeKind(typeArg2);
if ((typeKind1 = TranslatorType.KIND_STRUCT) or
(typeKind1 = TranslatorType.KIND_ARRAY) or
(typeKind1 = TranslatorType.KIND_FUNC)) and (
(typeKind2 = TranslatorType.KIND_STRUCT) or
(typeKind2 = TranslatorType.KIND_ARRAY) or
(typeKind2 = TranslatorType.KIND_FUNC)) and (
typeArg1.possibleAssignTo(typeArg2) or
typeArg2.possibleAssignTo(typeArg1)) then begin
typeResu := typeBoolean;
end else
if (typeKind2 = -1) and (
(typeKind1 = TranslatorType.KIND_STRUCT) or
(typeKind1 = TranslatorType.KIND_ARRAY) or
(typeKind1 = TranslatorType.KIND_FUNC)) then begin
typeResu := typeBoolean;
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNE_NULL, typeResu, nil);
end else
if (typeKind1 = -1) and (
(typeKind2 = TranslatorType.KIND_STRUCT) or
(typeKind2 = TranslatorType.KIND_ARRAY) or
(typeKind2 = TranslatorType.KIND_FUNC)) then begin
typeResu := typeBoolean;
owner.deleteNode(nodeArg1);
nodeOper.setDataAssociate(operPosition, EXPR_SNE_NULL, typeResu, nil);
end else
if (typeKind1 = -1) and (typeKind2 = -1) then begin
typeResu := typeBoolean;
owner.deleteChildrens(nodeOper);
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, false);
end else
case getCommonTypeKind(typeKind1, typeKind2) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() <>
(nodeArg2.associate as BooleanAsObject).booleanValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_SHORT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
nodeVal1 := nodeArg1.value;
nodeVal2 := nodeArg2.value;
if (nodeVal1 = EXPR_SANDB) and (nodeVal2 = EXPR_VALUE_INT) and
((nodeArg2.associate as IntegerAsObject).shortValue() = 0) then begin
nodeArg1.getChild(0).setParent(nodeOper, 0);
nodeArg1.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNZ_TEST, typeResu, nil);
end else
if (nodeVal2 = EXPR_SANDB) and (nodeVal1 = EXPR_VALUE_INT) and
((nodeArg1.associate as IntegerAsObject).shortValue() = 0) then begin
nodeArg2.getChild(0).setParent(nodeOper, 0);
nodeArg2.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNZ_TEST, typeResu, nil);
end else
if (nodeVal1 = EXPR_VALUE_INT) and (nodeVal2 = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).shortValue() <>
(nodeArg2.associate as IntegerAsObject).shortValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
nodeVal1 := nodeArg1.value;
nodeVal2 := nodeArg2.value;
if (nodeVal1 = EXPR_SANDB) and (nodeVal2 = EXPR_VALUE_INT) and
((nodeArg2.associate as IntegerAsObject).intValue() = 0) then begin
nodeArg1.getChild(0).setParent(nodeOper, 0);
nodeArg1.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNZ_TEST, typeResu, nil);
end else
if (nodeVal2 = EXPR_SANDB) and (nodeVal1 = EXPR_VALUE_INT) and
((nodeArg1.associate as IntegerAsObject).intValue() = 0) then begin
nodeArg2.getChild(0).setParent(nodeOper, 0);
nodeArg2.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNZ_TEST, typeResu, nil);
end else
if (nodeVal1 = EXPR_VALUE_INT) and (nodeVal2 = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() <>
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
nodeVal1 := nodeArg1.value;
nodeVal2 := nodeArg2.value;
if (nodeVal1 = EXPR_SANDB) and (nodeVal2 = EXPR_VALUE_LONG) and
((nodeArg2.associate as LongAsObject).longValue() = 0) then begin
nodeArg1.getChild(0).setParent(nodeOper, 0);
nodeArg1.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNZ_TEST, typeResu, nil);
end else
if (nodeVal2 = EXPR_SANDB) and (nodeVal1 = EXPR_VALUE_LONG) and
((nodeArg1.associate as LongAsObject).longValue() = 0) then begin
nodeArg2.getChild(0).setParent(nodeOper, 0);
nodeArg2.getChild(0).setParent(nodeOper, 1);
owner.deleteNode(nodeArg1);
owner.deleteNode(nodeArg2);
nodeOper.setDataAssociate(operPosition, EXPR_SNZ_TEST, typeResu, nil);
end else
if (nodeVal1 = EXPR_VALUE_LONG) and (nodeVal2 = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as LongAsObject).longValue() <>
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
ssesPack(ssesShr(sseiEquals(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()), $08)) <> (-1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeFloat);
nodeArg2 := insertTypeCast(nodeArg2, typeFloat);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as FloatAsObject).floatValue(),
(nodeArg2.associate as FloatAsObject).floatValue()) <> 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeDouble);
nodeArg2 := insertTypeCast(nodeArg2, typeDouble);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as DoubleAsObject).doubleValue(),
(nodeArg2.associate as DoubleAsObject).doubleValue()) <> 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_REAL: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeReal);
nodeArg2 := insertTypeCast(nodeArg2, typeReal);
if (nodeArg1.value = EXPR_VALUE_REAL) and
(nodeArg2.value = EXPR_VALUE_REAL) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu, realCmpl(
(nodeArg1.associate as RealAsObject).realValue(),
(nodeArg2.associate as RealAsObject).realValue()) <> 0);
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
ssesPack(ssesShr(ssefCmpe(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()), $08)) <> -1);
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QEQ: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QEQ, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprRel(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxEquals(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiEquals(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssefCmpe(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.QNE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_QNE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprRel(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu, mmxEquals(
(nodeArg1.associate as LongAsObject).longValue(),
(nodeArg2.associate as LongAsObject).longValue()) xor (-1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, sseiEquals(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()) xor
ultraBuild(-1, -1));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_FLOAT, TranslatorType.KIND_XVECTOR: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeXVector);
nodeArg2 := insertTypeCast(nodeArg2, typeXVector);
if (nodeArg1.value = EXPR_VALUE_XVECTOR) and
(nodeArg2.value = EXPR_VALUE_XVECTOR) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssefCmpne(
(nodeArg1.associate as XVectorAsObject).xvectorValue(),
(nodeArg2.associate as XVectorAsObject).xvectorValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.OEQ: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_OEQ, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprRel(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesEquals(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
TranslatorLexer.ONE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_ONE, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprRel(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu, ssesEquals(
(nodeArg1.associate as UltraAsObject).ultraValue(),
(nodeArg2.associate as UltraAsObject).ultraValue()) xor
ultraBuild(-1, -1));
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprBAnd(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprEqual(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SANDB: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SANDB, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprEqual(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
{$BOOLEVAL ON}
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() and
(nodeArg2.associate as BooleanAsObject).booleanValue());
{$BOOLEVAL OFF}
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() and
(nodeArg2.associate as IntegerAsObject).shortValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() and
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() and
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu,
(nodeArg1.associate as UltraAsObject).ultraValue() and
(nodeArg2.associate as UltraAsObject).ultraValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprBXor(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprBAnd(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SXORB: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SXORB, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprBAnd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
{$BOOLEVAL ON}
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() xor
(nodeArg2.associate as BooleanAsObject).booleanValue());
{$BOOLEVAL OFF}
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() xor
(nodeArg2.associate as IntegerAsObject).shortValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() xor
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() xor
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu,
(nodeArg1.associate as UltraAsObject).ultraValue() xor
(nodeArg2.associate as UltraAsObject).ultraValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprBOr(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprBXor(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SORB: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SORB, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprBXor(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
{$BOOLEVAL ON}
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() or
(nodeArg2.associate as BooleanAsObject).booleanValue());
{$BOOLEVAL OFF}
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_SHORT: begin
typeResu := typeShort;
nodeArg1 := insertTypeCast(nodeArg1, typeShort);
nodeArg2 := insertTypeCast(nodeArg2, typeShort);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu, short(
(nodeArg1.associate as IntegerAsObject).shortValue() or
(nodeArg2.associate as IntegerAsObject).shortValue()));
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_INT: begin
typeResu := typeInt;
nodeArg1 := insertTypeCast(nodeArg1, typeInt);
nodeArg2 := insertTypeCast(nodeArg2, typeInt);
if (nodeArg1.value = EXPR_VALUE_INT) and
(nodeArg2.value = EXPR_VALUE_INT) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResu,
(nodeArg1.associate as IntegerAsObject).intValue() or
(nodeArg2.associate as IntegerAsObject).intValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_LONG: begin
typeResu := typeLong;
nodeArg1 := insertTypeCast(nodeArg1, typeLong);
nodeArg2 := insertTypeCast(nodeArg2, typeLong);
if (nodeArg1.value = EXPR_VALUE_LONG) and
(nodeArg2.value = EXPR_VALUE_LONG) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResu,
(nodeArg1.associate as LongAsObject).longValue() or
(nodeArg2.associate as LongAsObject).longValue());
owner.deleteChildrens(nodeOper);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResu := typeUltra;
nodeArg1 := insertTypeCast(nodeArg1, typeUltra);
nodeArg2 := insertTypeCast(nodeArg2, typeUltra);
if (nodeArg1.value = EXPR_VALUE_ULTRA) and
(nodeArg2.value = EXPR_VALUE_ULTRA) then begin
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResu,
(nodeArg1.associate as UltraAsObject).ultraValue() or
(nodeArg2.associate as UltraAsObject).ultraValue());
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprLAnd(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprBOr(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SANDL: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SANDL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprBOr(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
{$BOOLEVAL ON}
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() and
(nodeArg2.associate as BooleanAsObject).booleanValue());
{$BOOLEVAL OFF}
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprLOr(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
nodeOper: SyntaxNode;
nodeArg1: SyntaxNode;
nodeArg2: SyntaxNode;
typeResu: TypeDescriptor;
typeArg1: TypeDescriptor;
typeArg2: TypeDescriptor;
owner: Tree;
begin
position := parseExprLAnd(lexemes, position, parent);
nodeArg1 := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeArg1 := nodeArg1.dataType;
owner := parent.owner;
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.SORL: begin
nodeOper := owner.addNodeBefore(nodeArg1) as SyntaxNode;
nodeOper.setDataAssociate(position, EXPR_SORL, nil, nil);
nodeArg1.setParent(nodeOper, 0);
position := parseExprLAnd(lexemes, position + 1, nodeOper);
nodeArg2 := nodeOper.getChild(1) as SyntaxNode;
typeArg2 := nodeArg2.dataType;
case getCommonTypeKind(getTypeKind(typeArg1), getTypeKind(typeArg2)) of
TranslatorType.KIND_BOOLEAN: begin
typeResu := typeBoolean;
nodeArg1 := insertTypeCast(nodeArg1, typeBoolean);
nodeArg2 := insertTypeCast(nodeArg2, typeBoolean);
if (nodeArg1.value = EXPR_VALUE_BOOLEAN) and
(nodeArg2.value = EXPR_VALUE_BOOLEAN) then begin
{$BOOLEVAL ON}
nodeOper.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResu,
(nodeArg1.associate as BooleanAsObject).booleanValue() or
(nodeArg2.associate as BooleanAsObject).booleanValue());
{$BOOLEVAL OFF}
owner.deleteChildrens(nodeOper);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
end;
else
break;
end;
nodeOper.dataType := typeResu;
nodeArg1 := nodeOper;
typeArg1 := typeResu;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseExprCond(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
{ Искали пасхальные яйца в этом исходном тексте? Вот они! }
var
kindMania: int;
kindDemen: int;
operPosition: int;
colonPosition: int;
seWorld: SyntaxNode;
nodeFring: SyntaxNode;
nodeMania: SyntaxNode;
nodeDemen: SyntaxNode;
typeFring: TypeDescriptor;
typeMania: TypeDescriptor;
typeDemen: TypeDescriptor;
typeResult: TypeDescriptor;
owner: Tree;
begin
position := parseExprLOr(lexemes, position, parent);
if lexemes.getType(position) = TranslatorLexer.QUESTION_MARK then begin
nodeFring := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
typeFring := nodeFring.dataType;
if (typeFring = nil) or (typeFring.kind <> TranslatorType.KIND_BOOLEAN) then begin
raise CompileError.create(msgTypeMustBeBoolean, lexemes, position);
end;
owner := parent.owner;
operPosition := position;
seWorld := owner.addNodeBefore(nodeFring) as SyntaxNode;
seWorld.setDataAssociate(position, EXPR_QUESTION, nil, nil);
nodeFring.setParent(seWorld, 0);
position := parseExprAssign(lexemes, position + 1, seWorld);
if lexemes.getType(position) <> TranslatorLexer.COLON then begin
raise CompileError.create(msgExpectedColon, lexemes, position);
end;
colonPosition := position;
position := parseExprAssign(lexemes, position + 1, seWorld);
nodeMania := seWorld.getChild(1) as SyntaxNode;
nodeDemen := seWorld.getChild(2) as SyntaxNode;
typeMania := nodeMania.dataType;
typeDemen := nodeDemen.dataType;
kindMania := getTypeKind(typeMania);
kindDemen := getTypeKind(typeDemen);
if ((kindMania = TranslatorType.KIND_STRUCT) or
(kindMania = TranslatorType.KIND_ARRAY) or
(kindMania = TranslatorType.KIND_FUNC)) and (
(kindDemen = TranslatorType.KIND_STRUCT) or
(kindDemen = TranslatorType.KIND_ARRAY) or
(kindDemen = TranslatorType.KIND_FUNC)) then begin
if typeDemen.possibleAssignTo(typeMania) then begin
typeResult := typeMania;
end else
if typeMania.possibleAssignTo(typeDemen) then begin
typeResult := typeDemen;
end else begin
raise CompileError.create(msgCannotApplyOperation, lexemes, colonPosition);
end;
end else
if (kindDemen = -1) and (
(kindMania = TranslatorType.KIND_STRUCT) or
(kindMania = TranslatorType.KIND_ARRAY) or
(kindMania = TranslatorType.KIND_FUNC)) then begin
typeResult := typeMania;
end else
if (kindMania = -1) and (
(kindDemen = TranslatorType.KIND_STRUCT) or
(kindDemen = TranslatorType.KIND_ARRAY) or
(kindDemen = TranslatorType.KIND_FUNC)) then begin
typeResult := typeDemen;
end else
if (kindMania = -1) and (kindDemen = -1) then begin
typeResult := nil;
owner.deleteChildrens(seWorld);
seWorld.setDataAssociate(operPosition, EXPR_VALUE_NULL, nil, nil);
end else
case getCommonTypeKind(kindMania, kindDemen) of
TranslatorType.KIND_BOOLEAN: begin
typeResult := typeBoolean;
nodeMania := insertTypeCast(nodeMania, typeBoolean);
nodeDemen := insertTypeCast(nodeDemen, typeBoolean);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_BOOLEAN) and
(nodeDemen.value = EXPR_VALUE_BOOLEAN) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_BOOLEAN, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_SHORT: begin
typeResult := typeShort;
nodeMania := insertTypeCast(nodeMania, typeShort);
nodeDemen := insertTypeCast(nodeDemen, typeShort);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_INT) and
(nodeDemen.value = EXPR_VALUE_INT) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_INT: begin
typeResult := typeInt;
nodeMania := insertTypeCast(nodeMania, typeInt);
nodeDemen := insertTypeCast(nodeDemen, typeInt);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_INT) and
(nodeDemen.value = EXPR_VALUE_INT) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_INT, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_LONG: begin
typeResult := typeLong;
nodeMania := insertTypeCast(nodeMania, typeLong);
nodeDemen := insertTypeCast(nodeDemen, typeLong);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_LONG) and
(nodeDemen.value = EXPR_VALUE_LONG) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_LONG, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_ULTRA: begin
typeResult := typeUltra;
nodeMania := insertTypeCast(nodeMania, typeUltra);
nodeDemen := insertTypeCast(nodeDemen, typeUltra);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_ULTRA) and
(nodeDemen.value = EXPR_VALUE_ULTRA) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_ULTRA, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_FLOAT: begin
typeResult := typeFloat;
nodeMania := insertTypeCast(nodeMania, typeFloat);
nodeDemen := insertTypeCast(nodeDemen, typeFloat);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_REAL) and
(nodeDemen.value = EXPR_VALUE_REAL) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_DOUBLE: begin
typeResult := typeDouble;
nodeMania := insertTypeCast(nodeMania, typeDouble);
nodeDemen := insertTypeCast(nodeDemen, typeDouble);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_REAL) and
(nodeDemen.value = EXPR_VALUE_REAL) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_REAL: begin
typeResult := typeReal;
nodeMania := insertTypeCast(nodeMania, typeReal);
nodeDemen := insertTypeCast(nodeDemen, typeReal);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_REAL) and
(nodeDemen.value = EXPR_VALUE_REAL) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_REAL, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
TranslatorType.KIND_XVECTOR: begin
typeResult := typeXVector;
nodeMania := insertTypeCast(nodeMania, typeXVector);
nodeDemen := insertTypeCast(nodeDemen, typeXVector);
if (nodeFring.value = EXPR_VALUE_BOOLEAN) and
(nodeMania.value = EXPR_VALUE_XVECTOR) and
(nodeDemen.value = EXPR_VALUE_XVECTOR) then begin
if (seWorld.associate as BooleanAsObject).booleanValue() = true then begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_XVECTOR, typeResult,
nodeMania.associate);
end else begin
seWorld.setDataAssociate(operPosition, EXPR_VALUE_XVECTOR, typeResult,
nodeDemen.associate);
end;
owner.deleteChildrens(seWorld);
end;
end;
else
raise CompileError.create(msgCannotApplyOperation, lexemes, operPosition);
end;
seWorld.dataType := typeResult;
end;
result := position;
end;
function TranslatorTreeBuilder.parseExprAssign(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
nodeVal: int;
nodeType: int;
typeKind: int;
operPosition: int;
nodeOper: SyntaxNode;
nodeLeft: SyntaxNode;
nodeRight: SyntaxNode;
typeLeft: TypeDescriptor;
owner: Tree;
begin
position := parseExprCond(lexemes, position, parent);
case lexemes.getType(position) of
TranslatorLexer.ASSIGN:
nodeType := ASSIGN;
TranslatorLexer.ASANDB:
nodeType := ASSIGN_SANDB;
TranslatorLexer.ASORB:
nodeType := ASSIGN_SORB;
TranslatorLexer.ASXORB:
nodeType := ASSIGN_SXORB;
TranslatorLexer.ASMULL:
nodeType := ASSIGN_SMULL;
TranslatorLexer.ASDIVS:
nodeType := ASSIGN_SDIVS;
TranslatorLexer.ASREMS:
nodeType := ASSIGN_SREMS;
TranslatorLexer.ASDIVU:
nodeType := ASSIGN_SDIVU;
TranslatorLexer.ASREMU:
nodeType := ASSIGN_SREMU;
TranslatorLexer.ASPLUS:
nodeType := ASSIGN_SADD;
TranslatorLexer.ASMINUS:
nodeType := ASSIGN_SSUB;
TranslatorLexer.ASSRA:
nodeType := ASSIGN_SSRA;
TranslatorLexer.ASSRL:
nodeType := ASSIGN_SSRL;
TranslatorLexer.ASSLL:
nodeType := ASSIGN_SSLL;
TranslatorLexer.AQMULL:
nodeType := ASSIGN_QMULL;
TranslatorLexer.AQMULH:
nodeType := ASSIGN_QMULH;
TranslatorLexer.AQMULHS:
nodeType := ASSIGN_QMULHS;
TranslatorLexer.AQDIV:
nodeType := ASSIGN_QDIV;
TranslatorLexer.AQADD:
nodeType := ASSIGN_QADD;
TranslatorLexer.AQADDS:
nodeType := ASSIGN_QADDS;
TranslatorLexer.AQADDUS:
nodeType := ASSIGN_QADDUS;
TranslatorLexer.AQSUB:
nodeType := ASSIGN_QSUB;
TranslatorLexer.AQSUBS:
nodeType := ASSIGN_QSUBS;
TranslatorLexer.AQSUBUS:
nodeType := ASSIGN_QSUBUS;
TranslatorLexer.AQSRA:
nodeType := ASSIGN_QSRA;
TranslatorLexer.AQSRL:
nodeType := ASSIGN_QSRL;
TranslatorLexer.AQSLL:
nodeType := ASSIGN_QSLL;
TranslatorLexer.AQGT:
nodeType := ASSIGN_QGT;
TranslatorLexer.AQGE:
nodeType := ASSIGN_QGE;
TranslatorLexer.AQLT:
nodeType := ASSIGN_QLT;
TranslatorLexer.AQLE:
nodeType := ASSIGN_QLE;
TranslatorLexer.AQEQ:
nodeType := ASSIGN_QEQ;
TranslatorLexer.AQNE:
nodeType := ASSIGN_QNE;
TranslatorLexer.AOMULL:
nodeType := ASSIGN_OMULL;
TranslatorLexer.AOMULH:
nodeType := ASSIGN_OMULH;
TranslatorLexer.AOMULHS:
nodeType := ASSIGN_OMULHS;
TranslatorLexer.AOADD:
nodeType := ASSIGN_OADD;
TranslatorLexer.AOADDS:
nodeType := ASSIGN_OADDS;
TranslatorLexer.AOADDUS:
nodeType := ASSIGN_OADDUS;
TranslatorLexer.AOSUB:
nodeType := ASSIGN_OSUB;
TranslatorLexer.AOSUBS:
nodeType := ASSIGN_OSUBS;
TranslatorLexer.AOSUBUS:
nodeType := ASSIGN_OSUBUS;
TranslatorLexer.AOSRA:
nodeType := ASSIGN_OSRA;
TranslatorLexer.AOSRL:
nodeType := ASSIGN_OSRL;
TranslatorLexer.AOSLL:
nodeType := ASSIGN_OSLL;
TranslatorLexer.AOGT:
nodeType := ASSIGN_OGT;
TranslatorLexer.AOGE:
nodeType := ASSIGN_OGE;
TranslatorLexer.AOLT:
nodeType := ASSIGN_OLT;
TranslatorLexer.AOLE:
nodeType := ASSIGN_OLE;
TranslatorLexer.AOEQ:
nodeType := ASSIGN_OEQ;
TranslatorLexer.AONE:
nodeType := ASSIGN_ONE;
else
result := position;
exit;
end;
nodeLeft := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
nodeVal := nodeLeft.value;
if (nodeVal <> EXPR_LOCAL_VARIABLE) and (nodeVal <> EXPR_GLOBAL_VARIABLE) and
(nodeVal <> EXPR_FIELD) and (nodeVal <> EXPR_ARRAY) then begin
raise CompileError.create(msgOperationApplicableOnlyToVar, lexemes, position);
end;
typeLeft := nodeLeft.dataType;
if typeLeft = nil then begin
raise CompileError.create(msgCannotAssignToNull, lexemes, position);
end;
typeKind := typeLeft.kind;
case nodeType of
ASSIGN_SMULL, ASSIGN_SDIVS, ASSIGN_SREMS, ASSIGN_SDIVU, ASSIGN_SREMU, ASSIGN_SADD, ASSIGN_SSUB:
if (typeKind <> TranslatorType.KIND_CHAR) and
(typeKind <> TranslatorType.KIND_BYTE) and
(typeKind <> TranslatorType.KIND_SHORT) and
(typeKind <> TranslatorType.KIND_INT) and
(typeKind <> TranslatorType.KIND_LONG) and
(typeKind <> TranslatorType.KIND_FLOAT) and
(typeKind <> TranslatorType.KIND_DOUBLE) and
(typeKind <> TranslatorType.KIND_REAL) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
ASSIGN_SSLL, ASSIGN_SSRA, ASSIGN_SSRL:
if (typeKind <> TranslatorType.KIND_CHAR) and
(typeKind <> TranslatorType.KIND_BYTE) and
(typeKind <> TranslatorType.KIND_SHORT) and
(typeKind <> TranslatorType.KIND_INT) and
(typeKind <> TranslatorType.KIND_LONG) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
ASSIGN_SANDB, ASSIGN_SXORB, ASSIGN_SORB:
if (typeKind <> TranslatorType.KIND_BOOLEAN) and
(typeKind <> TranslatorType.KIND_CHAR) and
(typeKind <> TranslatorType.KIND_BYTE) and
(typeKind <> TranslatorType.KIND_SHORT) and
(typeKind <> TranslatorType.KIND_INT) and
(typeKind <> TranslatorType.KIND_LONG) and
(typeKind <> TranslatorType.KIND_ULTRA) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
ASSIGN_QMULL, ASSIGN_QADD, ASSIGN_QSUB: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
if (typeKind <> TranslatorType.KIND_LONG) and
(typeKind <> TranslatorType.KIND_ULTRA) and
(typeKind <> TranslatorType.KIND_XVECTOR) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
ASSIGN_QMULH, ASSIGN_QSLL, ASSIGN_QSRA, ASSIGN_QSRL,
ASSIGN_QGT, ASSIGN_QGE, ASSIGN_QLT, ASSIGN_QLE, ASSIGN_QEQ, ASSIGN_QNE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
if (typeKind <> TranslatorType.KIND_LONG) and
(typeKind <> TranslatorType.KIND_ULTRA) then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
ASSIGN_QMULHS, ASSIGN_QADDS, ASSIGN_QADDUS, ASSIGN_QSUBS, ASSIGN_QSUBUS: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
if typeKind <> TranslatorType.KIND_LONG then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
ASSIGN_QDIV: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
if typeKind <> TranslatorType.KIND_XVECTOR then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
ASSIGN_OMULL, ASSIGN_OMULH, ASSIGN_OMULHS, ASSIGN_OADD, ASSIGN_OADDS, ASSIGN_OADDUS,
ASSIGN_OSUB, ASSIGN_OSUBS, ASSIGN_OSUBUS, ASSIGN_OSLL, ASSIGN_OSRA, ASSIGN_OSRL,
ASSIGN_OGT, ASSIGN_OGE, ASSIGN_OLT, ASSIGN_OLE, ASSIGN_OEQ, ASSIGN_ONE: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
if typeKind <> TranslatorType.KIND_ULTRA then begin
raise CompileError.create(msgCannotApplyOperation, lexemes, position);
end;
end;
end;
owner := parent.owner;
operPosition := position;
nodeOper := owner.addNodeBefore(nodeLeft) as SyntaxNode;
nodeOper.setDataAssociate(position, nodeType, typeLeft, nil);
nodeLeft.setParent(nodeOper, 0);
position := parseExprAssign(lexemes, position + 1, nodeOper);
nodeRight := nodeOper.getChild(1) as SyntaxNode;
case nodeType of
ASSIGN_SSLL, ASSIGN_SSRA, ASSIGN_SSRL,
ASSIGN_QSLL, ASSIGN_QSRA, ASSIGN_QSRL,
ASSIGN_OSLL, ASSIGN_OSRA, ASSIGN_OSRL:
if operandSize < TranslatorType.SIZE_32_BIT then begin
typeLeft := typeShort;
end else begin
typeLeft := typeInt;
end;
ASSIGN_SREMS, ASSIGN_SREMU:
case typeKind of
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE:
typeLeft := typeReal;
end;
end;
if not possibleAssign(typeLeft, nodeRight.dataType, nodeRight.associate) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, operPosition);
end;
insertTypeCast(nodeRight, typeLeft);
result := position;
end;
function TranslatorTreeBuilder.parseLocalVar(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
begin
position := parseForExpr(lexemes, position, parent, false);
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
result := position + 1;
end;
function TranslatorTreeBuilder.parseDispose(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operNode: SyntaxNode;
begin
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_DISPOSE, nil, nil);
position := parseExprAssign(lexemes, position, operNode);
case getTypeKind((operNode.getChild(0) as SyntaxNode).dataType) of
TranslatorType.KIND_ARRAY, TranslatorType.KIND_STRUCT: ;
else
raise CompileError.create(msgTypeMustBeStruct, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
result := position + 1;
end;
function TranslatorTreeBuilder.parseWith(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
currWithVarNum: int;
vtyp: TypeDescriptor;
local: LocalVariable;
operNode: SyntaxNode;
wvarNode: SyntaxNode;
owner: Tree;
begin
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
owner := parent.owner;
currWithVarNum := self.currWithVarNum;
operNode := owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_WITH, nil, nil);
repeat
inc(position);
wvarNode := owner.addChildLast(operNode) as SyntaxNode;
wvarNode.setDataAssociate(-1, NULL, nil, nil);
position := parseExprAssign(lexemes, position, wvarNode);
vtyp := (wvarNode.getChild(0) as SyntaxNode).dataType;
if (vtyp = nil) or (vtyp.kind <> TranslatorType.KIND_STRUCT) then begin
raise CompileError.create(msgTypeMustBeStruct, lexemes, position);
end;
local := TranslatorLocalVariable.create(vtyp, stringToUTF16(
'with.' + intToString(currWithVarNum)));
inc(currWithVarNum);
wvarNode.setDataAssociate(-1, BLOCK_WITH, nil, local);
until lexemes.getType(position) <> TranslatorLexer.COMMA;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
self.currWithVarNum := currWithVarNum;
result := parseOperator(lexemes, position + 1, operNode);
end;
function TranslatorTreeBuilder.parseTry(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
element: NamedObject;
operNode: SyntaxNode;
bodyNode: SyntaxNode;
fretNode: SyntaxNode;
owner: Tree;
begin
operNode := parent;
repeat
if operNode.value = BLOCK_FINALLY_START then begin
raise CompileError.create(msgFinallyTryNotAllowed, lexemes, position - 1);
end;
operNode := operNode.parent as SyntaxNode;
until operNode = nil;
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
owner := parent.owner;
operNode := owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_TRY_CATCH, nil, nil);
bodyNode := owner.addChildLast(operNode) as SyntaxNode;
bodyNode.setDataAssociate(position, OPERATOR_BLOCK, nil, nil);
position := parseOpBlock(lexemes, position + 1, bodyNode);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
inc(position);
case lexemes.getType(position) of
TranslatorLexer.KW_CATCH: repeat
operPosition := position;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
inc(position);
element := parseIdentifier(lexemes, position, parent);
if not (element is GlobalException) then begin
raise CompileError.create(msgExpectedIdentifierOfException, lexemes, position);
end;
position := stayPosition;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
bodyNode := owner.addChildLast(operNode) as SyntaxNode;
bodyNode.setDataAssociate(operPosition, BLOCK_CATCH, nil, element as GlobalException);
position := parseOpBlock(lexemes, position + 1, bodyNode);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
inc(position);
until lexemes.getType(position) <> TranslatorLexer.KW_CATCH;
TranslatorLexer.KW_FINALLY: begin
operNode.value := OPERATOR_TRY_FINALLY;
operPosition := position;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
bodyNode := owner.addChildLast(operNode) as SyntaxNode;
bodyNode.setDataAssociate(operPosition, BLOCK_FINALLY_START, nil, nil);
position := parseOpBlock(lexemes, position + 1, bodyNode);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
fretNode := owner.addChildLast(bodyNode) as SyntaxNode;
fretNode.setDataAssociate(position, BLOCK_FINALLY_RETURN, nil, nil);
inc(position);
end;
else
raise CompileError.create(msgExpectedKeywordCatchFinally, lexemes, position);
end;
result := position;
end;
function TranslatorTreeBuilder.parseBreak(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
operNode: SyntaxNode;
asocNode: BuilderNode;
labelName: UnicodeString;
begin
operPosition := position - 1;
asocNode := parent as BuilderNode;
if lexemes.getType(position) = TranslatorLexer.IDENTIFIER then begin
labelName := lexemes.getValueUString(position);
inc(position);
repeat
case asocNode.value of
BLOCK_FINALLY_START: begin
raise CompileError.create(msgFinallyBreakNotAllowed, lexemes, position);
end;
OPERATOR_LABEL: begin
if asocNode.labelName = labelName then begin
break;
end;
end;
end;
asocNode := asocNode.parent as BuilderNode;
if asocNode = nil then begin
raise CompileError.create(msgBreakLabelNotFound, lexemes, position);
end;
until false;
end else begin
repeat
case asocNode.value of
BLOCK_FINALLY_START: begin
raise CompileError.create(msgFinallyBreakNotAllowed, lexemes, position);
end;
OPERATOR_DO, OPERATOR_FOR, OPERATOR_WHILE, OPERATOR_SWITCH: begin
break;
end;
end;
asocNode := asocNode.parent as BuilderNode;
if asocNode = nil then begin
raise CompileError.create(msgBreakUnlabeledNotAllowed, lexemes, position);
end;
until false;
end;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(operPosition, OPERATOR_BREAK, nil, asocNode);
result := position + 1;
end;
function TranslatorTreeBuilder.parseContinue(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
operNode: SyntaxNode;
asocNode: BuilderNode;
targNode: BuilderNode;
labelName: UnicodeString;
begin
operPosition := position - 1;
asocNode := parent as BuilderNode;
if lexemes.getType(position) = TranslatorLexer.IDENTIFIER then begin
labelName := lexemes.getValueUString(position);
inc(position);
repeat
case asocNode.value of
BLOCK_FINALLY_START: begin
raise CompileError.create(msgFinallyBreakNotAllowed, lexemes, position);
end;
OPERATOR_LABEL: begin
if asocNode.labelName = labelName then begin
if asocNode.getChildrensCount() <= 0 then begin
raise CompileError.create(msgContinueLabeledNotAllowed, lexemes, position);
end;
targNode := asocNode.getChild(0) as BuilderNode;
case targNode.value of
OPERATOR_DO, OPERATOR_FOR, OPERATOR_WHILE: begin
asocNode := targNode;
break;
end;
else
raise CompileError.create(msgContinueLabeledNotAllowed, lexemes, position);
end;
end;
end;
end;
asocNode := asocNode.parent as BuilderNode;
if asocNode = nil then begin
raise CompileError.create(msgContinueLabelNotFound, lexemes, position);
end;
until false;
end else begin
repeat
case asocNode.value of
BLOCK_FINALLY_START: begin
raise CompileError.create(msgFinallyBreakNotAllowed, lexemes, position);
end;
OPERATOR_DO, OPERATOR_FOR, OPERATOR_WHILE: begin
break;
end;
end;
asocNode := asocNode.parent as BuilderNode;
if asocNode = nil then begin
raise CompileError.create(msgContinueUnlabeledNotAllowed, lexemes, position);
end;
until false;
end;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(operPosition, OPERATOR_CONTINUE, nil, asocNode);
result := position + 1;
end;
function TranslatorTreeBuilder.parseIf(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operNode: SyntaxNode;
exprType: TypeDescriptor;
begin
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_IF, nil, nil);
position := parseExprAssign(lexemes, position + 1, operNode);
exprType := (operNode.getChild(0) as SyntaxNode).dataType;
if getTypeKind(exprType) <> TranslatorType.KIND_BOOLEAN then begin
raise CompileError.create(msgTypeMustBeBoolean, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
position := parseOperator(lexemes, position + 1, operNode);
if lexemes.getType(position) = TranslatorLexer.KW_ELSE then begin
position := parseOperator(lexemes, position + 1, operNode);
end;
result := position;
end;
function TranslatorTreeBuilder.parseSwitch(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
presentDefault: boolean;
caseIntValue: int;
exprTypeKind: int;
operPosition: int;
operNode: SyntaxNode;
exprNode: SyntaxNode;
exprType: TypeDescriptor;
caseValue: GlobalConstant;
presentCases: Vector;
where: Namespace;
owner: Tree;
begin
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
owner := parent.owner;
operPosition := position - 1;
operNode := owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(operPosition, OPERATOR_SWITCH, nil, nil);
position := parseExprAssign(lexemes, position + 1, operNode);
exprNode := operNode.getChild(0) as SyntaxNode;
exprType := exprNode.dataType;
exprTypeKind := getTypeKind(exprType);
if operandSize < TranslatorType.SIZE_32_BIT then begin
case exprTypeKind of
TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT: begin
exprType := typeShort;
exprTypeKind := exprType.kind;
insertTypeCast(exprNode, exprType);
end;
TranslatorType.KIND_CHAR: ;
else
raise CompileError.create(msgTypeMustBeShort, lexemes, position);
end;
end else begin
if not possibleAssign(typeInt, exprType, exprNode.associate) then begin
raise CompileError.create(msgTypeMustBeInt, lexemes, position);
end;
exprType := typeInt;
exprTypeKind := exprType.kind;
insertTypeCast(exprNode, exprType);
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.OPENED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedOpenedCurlyBracket, lexemes, position);
end;
inc(position);
where := ((owner.root as SyntaxNode).associate as GlobalFunction).owner;
presentDefault := false;
presentCases := Vector.create();
try
repeat
operPosition := position;
case lexemes.getType(position) of
TranslatorLexer.KW_CASE: begin
caseValue := parseConst(where, position + 1);
position := stayPosition;
if not possibleAssign(exprTypeKind, caseValue) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, position);
end;
caseIntValue := caseValue.intValue;
if presentCases.contains(caseIntValue) then begin
raise CompileError.create(msgSwitchCaseValueAlreadyPresent, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.COLON then begin
raise CompileError.create(msgExpectedColon, lexemes, position);
end;
presentCases.addElement(caseIntValue);
exprNode := owner.addChildLast(operNode) as SyntaxNode;
exprNode.setDataAssociate(operPosition, BLOCK_CASE, nil, caseIntValue);
position := parseOpBlock(lexemes, position + 1, operNode);
end;
TranslatorLexer.KW_DEFAULT: begin
inc(position);
if presentDefault then begin
raise CompileError.create(msgSwitchDefaultAlreadyPresent, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.COLON then begin
raise CompileError.create(msgExpectedColon, lexemes, position);
end;
presentDefault := true;
exprNode := owner.addChildLast(operNode) as SyntaxNode;
exprNode.setDataAssociate(operPosition, BLOCK_DEFAULT, nil, nil);
position := parseOpBlock(lexemes, position + 1, operNode);
end;
else
break;
end;
until false;
if not presentDefault then begin
exprNode := owner.addChildLast(operNode) as SyntaxNode;
exprNode.setDataAssociate(-1, BLOCK_DEFAULT, nil, nil);
end;
finally
presentCases.free();
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
result := position + 1;
end;
function TranslatorTreeBuilder.parseDo(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operNode: SyntaxNode;
exprType: TypeDescriptor;
begin
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_DO, nil, nil);
position := parseOperator(lexemes, position, operNode);
if lexemes.getType(position) <> TranslatorLexer.KW_WHILE then begin
raise CompileError.create(msgExpectedKeywordWhile, lexemes, position);
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
position := parseExprAssign(lexemes, position + 1, operNode);
exprType := (operNode.getChild(1) as SyntaxNode).dataType;
if getTypeKind(exprType) <> TranslatorType.KIND_BOOLEAN then begin
raise CompileError.create(msgTypeMustBeBoolean, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
result := position + 1;
end;
function TranslatorTreeBuilder.parseFor(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
count: int;
operNode: SyntaxNode;
exprNode: SyntaxNode;
stepNode: SyntaxNode;
bodyNode: SyntaxNode;
owner: Tree;
begin
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
owner := parent.owner;
operNode := owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_FOR, nil, nil);
inc(position);
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
repeat
position := parseForExpr(lexemes, position, operNode, false);
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
break;
end;
inc(position);
until false;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
end;
inc(position);
count := operNode.getChildrensCount();
if lexemes.getType(position) = TranslatorLexer.SEMICOLON then begin
exprNode := owner.addChildLast(operNode) as SyntaxNode;
exprNode.setDataAssociate(-1, EXPR_VALUE_BOOLEAN, typeBoolean, true);
end else begin
position := parseExprAssign(lexemes, position, operNode);
exprNode := operNode.getChild(count) as SyntaxNode;
if getTypeKind(exprNode.dataType) <> TranslatorType.KIND_BOOLEAN then begin
raise CompileError.create(msgTypeMustBeBoolean, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
end;
inc(position);
stepNode := owner.addChildLast(operNode) as SyntaxNode;
stepNode.setDataAssociate(-1, OPERATOR_BLOCK, nil, nil);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
repeat
position := parseForExpr(lexemes, position, stepNode, true);
if lexemes.getType(position) <> TranslatorLexer.COMMA then begin
break;
end;
inc(position);
until false;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
end;
position := parseOperator(lexemes, position + 1, operNode);
bodyNode := operNode.getChild(count + 2) as SyntaxNode;
bodyNode.index := count;
stepNode.index := count + 1;
exprNode.index := count + 2;
result := position;
end;
function TranslatorTreeBuilder.parseWhile(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operNode: SyntaxNode;
exprType: TypeDescriptor;
begin
if lexemes.getType(position) <> TranslatorLexer.OPENED_PARENTHESIS then begin
raise CompileError.create(msgExpectedOpenedParenthesis, lexemes, position);
end;
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position - 1, OPERATOR_WHILE, nil, nil);
position := parseExprAssign(lexemes, position + 1, operNode);
exprType := (operNode.getChild(0) as SyntaxNode).dataType;
if getTypeKind(exprType) <> TranslatorType.KIND_BOOLEAN then begin
raise CompileError.create(msgTypeMustBeBoolean, lexemes, position);
end;
if lexemes.getType(position) <> TranslatorLexer.CLOSED_PARENTHESIS then begin
raise CompileError.create(msgExpectedClosedParenthesis, lexemes, position);
end;
position := parseOperator(lexemes, position + 1, operNode);
operNode.getChild(1).index := 0;
result := position;
end;
function TranslatorTreeBuilder.parseThrow(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
element: NamedObject;
operNode: SyntaxNode;
begin
operPosition := position - 1;
element := parseIdentifier(lexemes, position, parent);
if not (element is GlobalException) then begin
raise CompileError.create(msgExpectedIdentifierOfException, lexemes, position);
end;
position := stayPosition;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
operNode := parent.owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(operPosition, OPERATOR_THROW, nil, element as GlobalException);
result := position + 1;
end;
function TranslatorTreeBuilder.parseReturn(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
operPosition: int;
operNode: SyntaxNode;
exprNode: SyntaxNode;
returnType: TypeDescriptor;
owner: Tree;
begin
operPosition := position - 1;
operNode := parent;
repeat
if operNode.value = BLOCK_FINALLY_START then begin
raise CompileError.create(msgFinallyBreakNotAllowed, lexemes, operPosition);
end;
operNode := operNode.parent as SyntaxNode;
until operNode = nil;
owner := parent.owner;
operNode := owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(operPosition, OPERATOR_RETURN, nil, nil);
returnType := ((owner.root as SyntaxNode).associate as
GlobalFunction).functionType.getReturnType();
if returnType.kind <> TranslatorType.KIND_VOID then begin
position := parseExprAssign(lexemes, position, operNode);
exprNode := operNode.getChild(0) as SyntaxNode;
if not possibleAssign(returnType, exprNode.dataType, exprNode.associate) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, position);
end;
insertTypeCast(exprNode, returnType);
end;
if lexemes.getType(position) <> TranslatorLexer.SEMICOLON then begin
raise CompileError.create(msgExpectedSemicolon, lexemes, position);
end;
result := position + 1;
end;
function TranslatorTreeBuilder.parseOpBlock(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
var
newPosition: int;
begin
repeat
newPosition := parseStatement(lexemes, position, parent, false);
if newPosition <= position then begin
break;
end;
position := newPosition;
until false;
result := position;
end;
function TranslatorTreeBuilder.parseOperator(lexemes: Lexer; position: int;
parent: SyntaxNode): int;
begin
result := parseStatement(lexemes, position, parent, true);
end;
function TranslatorTreeBuilder.parseStatement(lexemes: Lexer; position: int;
parent: SyntaxNode; raisesExceptionIfEmpty: boolean): int;
var
owner: Tree;
child: BuilderNode;
begin
owner := parent.owner;
while (lexemes.getType(position) = TranslatorLexer.IDENTIFIER) and
(lexemes.getType(position + 1) = TranslatorLexer.COLON) do begin
child := owner.addChildLast(parent) as BuilderNode;
child.setDataAssociate(position, OPERATOR_LABEL, nil, nil);
child.labelName := lexemes.getValueUString(position);
inc(position, 2);
parent := child;
end;
case lexemes.getType(position) of
TranslatorLexer.OPENED_PARENTHESIS, TranslatorLexer.INCR, TranslatorLexer.DECR,
TranslatorLexer.SNOTB, TranslatorLexer.SNOTL, TranslatorLexer.SPLUS, TranslatorLexer.SMINUS,
TranslatorLexer.QPACKUS, TranslatorLexer.QUNPCKL, TranslatorLexer.QUNPCKH,
TranslatorLexer.QADD, TranslatorLexer.QSUB,
TranslatorLexer.OPACKUS, TranslatorLexer.OUNPCKL, TranslatorLexer.OUNPCKH,
TranslatorLexer.OADD, TranslatorLexer.OSUB,
TranslatorLexer.KW_NULL, TranslatorLexer.KW_FALSE, TranslatorLexer.KW_TRUE,
TranslatorLexer.KW_NEW, TranslatorLexer.IDENTIFIER, TranslatorLexer.NUM_INT,
TranslatorLexer.NUM_LONG, TranslatorLexer.NUM_FLOAT, TranslatorLexer.NUM_DOUBLE,
TranslatorLexer.NUM_REAL, TranslatorLexer.STRING_LITERAL,
TranslatorLexer.KW_VOID, TranslatorLexer.KW_BOOLEAN, TranslatorLexer.KW_CHAR,
TranslatorLexer.KW_BYTE, TranslatorLexer.KW_SHORT, TranslatorLexer.KW_INT,
TranslatorLexer.KW_LONG, TranslatorLexer.KW_ULTRA, TranslatorLexer.KW_ULTRA32,
TranslatorLexer.KW_ULTRA64, TranslatorLexer.KW_FLOAT, TranslatorLexer.KW_DOUBLE,
TranslatorLexer.KW_REAL, TranslatorLexer.KW_XVECTOR, TranslatorLexer.KW_YVECTOR,
TranslatorLexer.KW_ZVECTOR, TranslatorLexer.KW_FVECTOR: begin
result := parseLocalVar(lexemes, position, parent);
end;
TranslatorLexer.SEMICOLON: begin
child := owner.addChildLast(parent) as BuilderNode;
child.setDataAssociate(position, OPERATOR_EMPTY, nil, nil);
result := position + 1;
end;
TranslatorLexer.OPENED_CURLY_BRACKET: begin
child := owner.addChildLast(parent) as BuilderNode;
child.setDataAssociate(position, OPERATOR_BLOCK, nil, nil);
position := parseOpBlock(lexemes, position + 1, child);
if lexemes.getType(position) <> TranslatorLexer.CLOSED_CURLY_BRACKET then begin
raise CompileError.create(msgExpectedClosedCurlyBracket, lexemes, position);
end;
result := position + 1;
end;
TranslatorLexer.KW_DISPOSE: begin
result := parseDispose(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_WITH: begin
result := parseWith(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_TRY: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
result := parseTry(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_BREAK: begin
result := parseBreak(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_CONTINUE: begin
result := parseContinue(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_IF: begin
result := parseIf(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_SWITCH: begin
result := parseSwitch(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_DO: begin
result := parseDo(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_FOR: begin
result := parseFor(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_WHILE: begin
result := parseWhile(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_THROW: begin
if operandSize < TranslatorType.SIZE_64_BIT then begin
raise CompileError.create(msgOperationNotSupportedOS, lexemes, position);
end;
result := parseThrow(lexemes, position + 1, parent);
end;
TranslatorLexer.KW_RETURN: begin
result := parseReturn(lexemes, position + 1, parent);
end;
else
if raisesExceptionIfEmpty then begin
raise CompileError.create(msgExpectedStatement, lexemes, position);
end;
result := position;
end;
end;
function TranslatorTreeBuilder.parseForExpr(lexemes: Lexer; position: int;
parent: SyntaxNode; expressionOnly: boolean): int;
var
owner: Tree;
local: LocalVariable;
operNode: SyntaxNode;
exprNode: SyntaxNode;
varType: TypeDescriptor;
varName: UnicodeString;
begin
owner := parent.owner;
if expressionOnly = false then begin
varType := tryParseType(((owner.root as SyntaxNode).associate as GlobalFunction).owner,
position);
end else begin
varType := nil;
end;
if varType <> nil then begin
position := stayPosition;
if lexemes.getType(position) <> TranslatorLexer.IDENTIFIER then begin
raise CompileError.create(msgExpectedIdentifierOfVariable, lexemes, position);
end;
varName := lexemes.getValueUString(position);
if findLocalVariable(varName, parent) <> nil then begin
raise CompileError.create(msgAlreadyExistsIdentifier, lexemes, position);
end;
local := TranslatorLocalVariable.create(varType, varName);
local.declarePosition := position;
operNode := owner.addChildLast(parent) as SyntaxNode;
operNode.setDataAssociate(position, OPERATOR_VARIABLE, nil, local);
inc(position);
if lexemes.getType(position) = TranslatorLexer.ASSIGN then begin
position := parseExprAssign(lexemes, position + 1, operNode);
exprNode := operNode.getChild(0) as SyntaxNode;
if not possibleAssign(varType, exprNode.dataType, exprNode.associate) then begin
raise CompileError.create(msgCannotAssignDataType, lexemes, position);
end;
insertTypeCast(exprNode, varType);
end;
end else begin
position := parseExprAssign(lexemes, position, parent);
exprNode := parent.getChild(parent.getChildrensCount() - 1) as SyntaxNode;
case exprNode.value of
EXPR_CALL, EXPR_INCR_POST, EXPR_DECR_POST, EXPR_INCR_PRED, EXPR_DECR_PRED, 600..699: begin
exprNode.dataType := nil;
end;
else
raise CompileError.create(msgExpectedAssignOrCall, lexemes, position);
end;
end;
result := position;
end;
function TranslatorTreeBuilder.parseIdentifier(lexemes: Lexer; position: int;
parent: SyntaxNode): NamedObject;
var
i: int;
value: int;
owner: Tree;
where: Namespace;
place: Namespace;
child: SyntaxNode;
local: LocalVariable;
field: StructureField;
entry: NamespaceEntry;
ident: UnicodeString;
begin
owner := parent.owner;
ident := lexemes.getValueUString(position);
where := ((owner.root as SyntaxNode).associate as GlobalFunction).owner;
repeat
value := parent.value;
if value = OPERATOR_WITH then begin
for i := parent.getChildrensCount() - 1 downto 0 do begin
child := parent.getChild(i) as SyntaxNode;
if child.value <> BLOCK_WITH then begin
continue;
end;
local := child.associate as LocalVariable;
field := (local.dataType as TypeStructure).findField(ident, true);
if (field <> nil) and where.isVisible(field) then begin
stayPosition := position + 1;
result := TranslatorFoundObject.create(local, field);
exit;
end;
end;
end else begin
for i := parent.getChildrensCount() - 1 downto 0 do begin
child := parent.getChild(i) as SyntaxNode;
if child.value <> OPERATOR_VARIABLE then begin
continue;
end;
local := child.associate as LocalVariable;
if local.name = ident then begin
stayPosition := position + 1;
result := local;
exit;
end;
end;
if value = FUNCTION_START then begin
local := (parent.associate as GlobalFunction).functionType.findArgument(ident);
if local <> nil then begin
stayPosition := position + 1;
result := local;
exit;
end;
end;
end;
parent := parent.parent as SyntaxNode;
until parent = nil;
where := ((owner.root as SyntaxNode).associate as GlobalFunction).owner;
entry := where.findEntry(ident, true);
if entry <> nil then begin
stayPosition := position + 1;
result := entry;
exit;
end;
place := findNamespace(ident);
if place = nil then begin
raise CompileError.create(msgExpectedIdentifierOfVariable, lexemes, position);
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.PERIOD then begin
raise CompileError.create(msgExpectedPeriod, lexemes, position);
end;
inc(position);
if lexemes.getType(position) <> TranslatorLexer.IDENTIFIER then begin
raise CompileError.create(msgExpectedIdentifierOfVariable, lexemes, position);
end;
ident := lexemes.getValueUString(position);
entry := place.findEntry(ident, false);
if (entry = nil) or not where.isVisible(entry) then begin
raise CompileError.create(msgExpectedIdentifierOfVariable, lexemes, position);
end;
stayPosition := position + 1;
result := entry;
end;
procedure TranslatorTreeBuilder.optimizeJumps(tree: SyntaxTree; touchReturn: boolean);
label
label0;
var
optimized: boolean;
cval: int;
clbn: int;
curr: SyntaxNode;
goan: SyntaxNode;
asoc: BuilderNode;
enum: NodeEnumerator;
begin
{ оптимизация переходов }
repeat
optimized := false;
curr := tree.root as SyntaxNode;
enum := curr.enumerateChildrens();
repeat
cval := curr.value;
clbn := curr.labelNumber;
if (clbn < 0) and (cval <> BLOCK_CASE) and (cval <> BLOCK_DEFAULT) then begin
goto label0;
end;
asoc := curr.goAlwaysToNode as BuilderNode;
if (asoc <> nil) and ((asoc as TObject) <> (curr as TObject)) then begin
if touchReturn and (asoc.labelNumber = clbn + 1) and (cval = JUMP) then begin
tree.deleteLabelNumber(clbn);
curr.goAlwaysToNode := nil;
optimized := true;
goto label0;
end;
goan := asoc.goAlwaysToNode;
if goan <> nil then begin
case asoc.value of
JUMP, EXPR_VALUE_BOOLEAN: begin
curr.goAlwaysToNode := goan;
asoc.optimized := true;
optimized := true;
end;
OPERATOR_RETURN: begin
if touchReturn then begin
curr.goAlwaysToNode := goan;
asoc.optimized := true;
optimized := true;
end;
end;
end;
end;
goto label0;
end;
asoc := curr.goIfTrueToNode as BuilderNode;
if (asoc <> nil) and ((asoc as TObject) <> (curr as TObject)) then begin
goan := asoc.goAlwaysToNode;
if goan <> nil then begin
case asoc.value of
JUMP, EXPR_VALUE_BOOLEAN: begin
curr.goIfTrueToNode := goan;
asoc.optimized := true;
optimized := true;
end;
OPERATOR_RETURN: begin
if touchReturn then begin
curr.goIfTrueToNode := goan;
asoc.optimized := true;
optimized := true;
end;
end;
end;
end;
end;
asoc := curr.goIfFalseToNode as BuilderNode;
if (asoc <> nil) and ((asoc as TObject) <> (curr as TObject)) then begin
goan := asoc.goAlwaysToNode;
if goan <> nil then begin
case asoc.value of
JUMP, EXPR_VALUE_BOOLEAN: begin
curr.goIfFalseToNode := goan;
asoc.optimized := true;
optimized := true;
end;
OPERATOR_RETURN: begin
if touchReturn then begin
curr.goIfFalseToNode := goan;
asoc.optimized := true;
optimized := true;
end;
end;
end;
end;
end;
label0:
curr := enum.nextChild() as SyntaxNode;
until curr = nil;
until not optimized;
end;
procedure TranslatorTreeBuilder.numerateNodes(node: SyntaxNode);
var
i: int;
c: int;
parent: SyntaxNode;
begin
{ нумерация узлов нужна для определения порядка их компиляции }
{ не все узлы будут иметь номера, поскольку некоторые из них не порождают исполняемый код }
c := node.getChildrensCount() - 1;
case node.value of
{ нумеруются только дочерние узлы, – родительский узел не нумеруется }
OPERATOR_LABEL, OPERATOR_BLOCK, OPERATOR_WITH, OPERATOR_TRY_CATCH, OPERATOR_TRY_FINALLY,
OPERATOR_IF, OPERATOR_FOR, OPERATOR_WHILE, OPERATOR_DO, BLOCK_CATCH, BLOCK_FINALLY_START,
EXPR_SNOTL, EXPR_SANDL, EXPR_SORL, EXPR_QUESTION: begin
for i := 0 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
end;
{ родительский и дочерние узлы нумеруются в случае, если есть дочерние узлы }
OPERATOR_VARIABLE, BLOCK_WITH: begin
if c >= 0 then begin
for i := 0 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
end;
{ только родительский узел нумеруется, поскольку дочерних узлов нет }
OPERATOR_BREAK, OPERATOR_CONTINUE, OPERATOR_THROW, BLOCK_FINALLY_RETURN,
EXPR_VALUE_NULL, EXPR_VALUE_BOOLEAN, EXPR_VALUE_LONG, EXPR_VALUE_ULTRA,
EXPR_VALUE_REAL, EXPR_VALUE_XVECTOR, EXPR_VALUE_STRING: begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
{ сначала нумеруются дочерние узлы, затем – родительский узел }
OPERATOR_DISPOSE, OPERATOR_RETURN, EXPR_NEW_ARRAY_BY_LENGTH,
EXPR_NEW_ULTRA, EXPR_NEW_XVECTOR, EXPR_FIELD_ASSIGN, EXPR_ARRAY_ASSIGN, EXPR_CALL,
EXPR_COMPOUND, EXPR_INCR_POST, EXPR_DECR_POST, EXPR_SNOTB, EXPR_SNEG,
EXPR_INCR_PRED, EXPR_DECR_PRED, EXPR_QPACKUS, EXPR_QUNPCKL, EXPR_QUNPCKH, EXPR_QNEG,
EXPR_OPACKUS, EXPR_OUNPCKL, EXPR_OUNPCKH, EXPR_ONEG, EXPR_SMULL, EXPR_SDIVS, EXPR_SREMS,
EXPR_SDIVU, EXPR_SREMU, EXPR_QMULL, EXPR_QMULH, EXPR_QMULHS, EXPR_QDIV, EXPR_OMULL, EXPR_OMULH,
EXPR_OMULHS, EXPR_SADD, EXPR_SSUB, EXPR_QADD, EXPR_QADDS, EXPR_QADDUS, EXPR_QSUB, EXPR_QSUBS,
EXPR_QSUBUS, EXPR_OADD, EXPR_OADDS, EXPR_OADDUS, EXPR_OSUB, EXPR_OSUBS, EXPR_OSUBUS, EXPR_SSLL,
EXPR_SSRA, EXPR_SSRL, EXPR_QSLL, EXPR_QSRA, EXPR_QSRL, EXPR_OSLL, EXPR_OSRA, EXPR_OSRL,
EXPR_SGT, EXPR_SGE, EXPR_SLT, EXPR_SLE, EXPR_QGT, EXPR_QGE, EXPR_QLT, EXPR_QLE, EXPR_OGT,
EXPR_OGE, EXPR_OLT, EXPR_OLE, EXPR_SEQ, EXPR_SNE, EXPR_QEQ, EXPR_QNE, EXPR_OEQ, EXPR_ONE,
EXPR_SANDB, EXPR_SXORB, EXPR_SORB, EXPR_SEQ_NULL, EXPR_SNE_NULL, EXPR_SZR_TEST, EXPR_SNZ_TEST,
ASSIGN, ASSIGN_SMULL, ASSIGN_SDIVS, ASSIGN_SREMS, ASSIGN_SDIVU, ASSIGN_SREMU, ASSIGN_QMULL,
ASSIGN_QMULH, ASSIGN_QMULHS, ASSIGN_QDIV, ASSIGN_OMULL, ASSIGN_OMULH, ASSIGN_OMULHS,
ASSIGN_SADD, ASSIGN_SSUB, ASSIGN_QADD, ASSIGN_QADDS, ASSIGN_QADDUS, ASSIGN_QSUB, ASSIGN_QSUBS,
ASSIGN_QSUBUS, ASSIGN_OADD, ASSIGN_OADDS, ASSIGN_OADDUS, ASSIGN_OSUB, ASSIGN_OSUBS,
ASSIGN_OSUBUS, ASSIGN_SSLL, ASSIGN_SSRA, ASSIGN_SSRL, ASSIGN_QSLL, ASSIGN_QSRA, ASSIGN_QSRL,
ASSIGN_OSLL, ASSIGN_OSRA, ASSIGN_OSRL, ASSIGN_QGT, ASSIGN_QGE, ASSIGN_QLT, ASSIGN_QLE,
ASSIGN_OGT, ASSIGN_OGE, ASSIGN_OLT, ASSIGN_OLE, ASSIGN_QEQ, ASSIGN_QNE, ASSIGN_OEQ, ASSIGN_ONE,
ASSIGN_SANDB, ASSIGN_SXORB, ASSIGN_SORB: begin
for i := 0 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
{ сначала нумеруется родительский узел, затем – дочерние узлы }
EXPR_NEW_STRUCT, EXPR_NEW_ARRAY_BY_ELEMENTS: begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
for i := 0 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
end;
{ особая нумерация узлов в операторе switch }
OPERATOR_SWITCH: begin
numerateNodes(node.getChild(0) as SyntaxNode);
(node.owner as SyntaxTree).assignLabelNumberTo(node);
for i := 1 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
end;
{ особая нумерация целых чисел, если это количество бит для сдвига }
EXPR_VALUE_INT: begin
i := (node.parent as SyntaxNode).value;
if (node.index <> 1) or (
(i <> EXPR_SSLL) and (i <> EXPR_SSRA) and (i <> EXPR_SSRL) and
(i <> EXPR_QSLL) and (i <> EXPR_QSRA) and (i <> EXPR_QSRL) and
(i <> EXPR_OSLL) and (i <> EXPR_OSRA) and (i <> EXPR_OSRL) and
(i <> ASSIGN_SSLL) and (i <> ASSIGN_SSRA) and (i <> ASSIGN_SSRL) and
(i <> ASSIGN_QSLL) and (i <> ASSIGN_QSRA) and (i <> ASSIGN_QSRL) and
(i <> ASSIGN_OSLL) and (i <> ASSIGN_OSRA) and (i <> ASSIGN_OSRL)) then begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
end;
{ особая нумерация узлов там, куда можно присвоить значение }
EXPR_LOCAL_VARIABLE, EXPR_GLOBAL_VARIABLE, EXPR_ARRAY, EXPR_FIELD: begin
for i := 0 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
if (node.index > 0) or not isNodeValueAssign((node.parent as SyntaxNode).value) then begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
end;
{ особая нумерация узлов для глобальной функции }
EXPR_GLOBAL_FUNCTION: begin
parent := node.parent as SyntaxNode;
if (parent.value <> EXPR_CALL) or (node.index <> parent.getChildrensCount() - 1) then begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
end;
{ особая нумерация узлов для операции приведения к типу }
EXPR_TYPE_CAST: begin
for i := 0 to c do begin
numerateNodes(node.getChild(i) as SyntaxNode);
end;
case getTypeKind((node.getChild(0) as SyntaxNode).dataType) of
TranslatorType.KIND_CHAR:
case getTypeKind(node.dataType) of
TranslatorType.KIND_BYTE, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA,
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL,
TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
TranslatorType.KIND_SHORT:
if operandSize > TranslatorType.SIZE_16_BIT then begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
end;
TranslatorType.KIND_BYTE:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR:
if operandSize > TranslatorType.SIZE_16_BIT then begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_SHORT:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR:
if operandSize > TranslatorType.SIZE_16_BIT then begin
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_BYTE, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA,
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL,
TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_INT:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_LONG:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_ULTRA, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_ULTRA:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_FLOAT,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_FLOAT:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA,
TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_DOUBLE:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA,
TranslatorType.KIND_FLOAT, TranslatorType.KIND_REAL, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_REAL:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA,
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE, TranslatorType.KIND_XVECTOR:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
TranslatorType.KIND_XVECTOR:
case getTypeKind(node.dataType) of
TranslatorType.KIND_CHAR, TranslatorType.KIND_BYTE, TranslatorType.KIND_SHORT,
TranslatorType.KIND_INT, TranslatorType.KIND_LONG, TranslatorType.KIND_ULTRA,
TranslatorType.KIND_FLOAT, TranslatorType.KIND_DOUBLE, TranslatorType.KIND_REAL:
(node.owner as SyntaxTree).assignLabelNumberTo(node);
end;
end;
end;
end;
end;
procedure TranslatorTreeBuilder.placeJumpsInExpression(node: SyntaxNode);
var
lbln: int;
tree: SyntaxTree;
asn1: SyntaxNode;
asn2: SyntaxNode;
asn3: SyntaxNode;
minl: SyntaxNode;
jmp1: SyntaxNode;
curr: SyntaxNode;
enum: NodeEnumerator;
begin
{ расстановка переходов в логических выражениях,
не попавших под действие метода placeJumpsInBoolean }
tree := node.owner as SyntaxTree;
repeat
curr := node;
enum := node.enumerateChildrens();
repeat
case curr.value of
{ дополнительная расстановка переходов в операторах ||, && и ! }
EXPR_SORL, EXPR_SANDL, EXPR_SNOTL: begin
if (curr.goIfTrueToNode = nil) or (curr.goIfFalseToNode = nil) then begin
lbln := curr.getChildWithMaxLabelNumber().labelNumber + 1;
asn1 := tree.addNodeBefore(curr) as SyntaxNode;
asn1.setDataAssociate(-1, EXPR_QUESTION, nil, nil);
asn2 := tree.addChildLast(asn1) as SyntaxNode;
asn2.setDataAssociate(-1, EXPR_VALUE_BOOLEAN, typeBoolean, true);
jmp1 := tree.addChildLast(asn1) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
asn3 := tree.addChildLast(asn1) as SyntaxNode;
asn3.setDataAssociate(-1, EXPR_VALUE_BOOLEAN, typeBoolean, false);
curr.setParent(asn1, 0);
jmp1.setGoAlwaysToNode(tree.getNodeWithLabelNumber(lbln));
tree.setLabelNumber(asn2, lbln);
tree.setLabelNumber(jmp1, lbln + 1);
tree.setLabelNumber(asn3, lbln + 2);
placeJumpsInBoolean(curr, asn2, asn3);
break;
end;
end;
{ дополнительная расстановка переходов в операторе ?: }
EXPR_QUESTION: begin
asn1 := curr.getChild(0) as SyntaxNode;
if (asn1.goIfTrueToNode = nil) or (asn1.goIfFalseToNode = nil) then begin
lbln := curr.getChildWithMaxLabelNumber().labelNumber + 1;
asn2 := curr.getChild(1) as SyntaxNode;
asn3 := curr.getChild(2) as SyntaxNode;
minl := asn3.getChildWithMinLabelNumber();
jmp1 := tree.addNodeBefore(asn3) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
jmp1.setGoAlwaysToNode(tree.getNodeWithLabelNumber(lbln));
tree.setLabelNumber(jmp1, minl.labelNumber);
placeJumpsInBoolean(asn1, asn2.getChildWithMinLabelNumber(), minl);
break;
end;
end;
end;
curr := enum.nextChild() as SyntaxNode;
if curr = nil then begin
exit;
end;
until false;
until false;
end;
procedure TranslatorTreeBuilder.placeJumpsInBoolean(node, goIfTrue, goIfFalse: SyntaxNode);
var
asn1: SyntaxNode;
asn2: SyntaxNode;
asn3: SyntaxNode;
begin
{ расстановка переходов в выражениях типа boolean }
node.setDataGoToNode(goIfTrue, goIfFalse);
case node.value of
{ оператор ?: }
EXPR_QUESTION: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := node.getChild(1) as SyntaxNode;
asn3 := node.getChild(2) as SyntaxNode;
placeJumpsInBoolean(asn1, asn2.getChildWithMinLabelNumber(),
asn3.getChildWithMinLabelNumber());
placeJumpsInBoolean(asn2, goIfTrue, goIfFalse);
placeJumpsInBoolean(asn3, goIfTrue, goIfFalse);
end;
{ оператор || }
EXPR_SORL: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := node.getChild(1) as SyntaxNode;
placeJumpsInBoolean(asn1, goIfTrue, asn2.getChildWithMinLabelNumber());
placeJumpsInBoolean(asn2, goIfTrue, goIfFalse);
end;
{ оператор && }
EXPR_SANDL: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := node.getChild(1) as SyntaxNode;
placeJumpsInBoolean(asn1, asn2.getChildWithMinLabelNumber(), goIfFalse);
placeJumpsInBoolean(asn2, goIfTrue, goIfFalse);
end;
{ оператор ! }
EXPR_SNOTL: begin
asn1 := node.getChild(0) as SyntaxNode;
placeJumpsInBoolean(asn1, goIfFalse, goIfTrue);
end;
{ константа типа boolean }
EXPR_VALUE_BOOLEAN: begin
if (node.associate as BooleanAsObject).booleanValue() = true then begin
node.setGoAlwaysToNode(goIfTrue);
end else begin
node.setGoAlwaysToNode(goIfFalse);
end;
end;
else
placeJumpsInExpression(node);
end;
end;
function TranslatorTreeBuilder.placeJumpsInOperator(node, next: SyntaxNode): SyntaxNode;
label
label0;
var
i: int;
c: int;
v: int;
tree: SyntaxTree;
asn1: SyntaxNode;
asn2: SyntaxNode;
asn3: SyntaxNode;
asn4: SyntaxNode;
asn5: SyntaxNode;
jmp1: SyntaxNode;
texc: GlobalException;
begin
{ расстановка переходов в операторах }
c := node.getChildrensCount() - 1;
tree := node.owner as SyntaxTree;
case node.value of
{ пустой }
OPERATOR_EMPTY: ;
(* метка:, {…}, with *)
OPERATOR_LABEL, OPERATOR_BLOCK, OPERATOR_WITH: begin
for i := c downto 0 do begin
next := placeJumpsInOperator(node.getChild(i) as SyntaxNode, next);
end;
end;
{ заявление локальной переменной, dispose, выражение в операторе with }
OPERATOR_VARIABLE, OPERATOR_DISPOSE, BLOCK_WITH: begin
if c >= 0 then begin
placeJumpsInExpression(node.getChild(0) as SyntaxNode);
next := node.getChildWithMinLabelNumber();
end;
end;
{ try…catch }
OPERATOR_TRY_CATCH: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := next;
for i := c downto 1 do begin
asn2 := placeJumpsInOperator(node.getChild(i) as SyntaxNode, next);
end;
jmp1 := tree.addNodeAfter(asn1) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
jmp1.setGoAlwaysToNode(next);
tree.setLabelNumber(jmp1, asn2.labelNumber);
next := placeJumpsInOperator(asn1, jmp1);
node.setDataGoToNode(next, jmp1); { нужно для определения границ «опасного» кода }
end;
{ try…finally }
OPERATOR_TRY_FINALLY: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := placeJumpsInOperator(node.getChild(1) as SyntaxNode, next);
jmp1 := tree.addNodeAfter(asn1) as SyntaxNode;
jmp1.setDataAssociate(-1, TF_JUMP, nil, node);
jmp1.setGoAlwaysToNode(next);
tree.setLabelNumber(jmp1, asn2.labelNumber);
next := placeJumpsInOperator(asn1, jmp1);
node.setDataGoToNode(next, jmp1); { нужно для определения границ «финализируемого» кода }
end;
{ break }
OPERATOR_BREAK: begin
asn1 := node.associate as SyntaxNode;
asn2 := node.parent as SyntaxNode;
v := JUMP;
repeat
if asn2.value = OPERATOR_TRY_FINALLY then begin
v := TF_JUMP;
break;
end;
if (asn2 as TObject) = (asn1 as TObject) then begin
break;
end;
asn2 := asn2.parent as SyntaxNode;
until asn2 = nil;
node.value := v;
node.setGoAlwaysToNode(tree.getNodeWithLabelNumber(asn1.
getChildWithMaxLabelNumber().labelNumber + 1));
next := node;
end;
{ continue }
OPERATOR_CONTINUE: begin
asn1 := node.associate as SyntaxNode;
asn2 := node.parent as SyntaxNode;
v := JUMP;
repeat
if asn2.value = OPERATOR_TRY_FINALLY then begin
v := TF_JUMP;
break;
end;
if (asn2 as TObject) = (asn1 as TObject) then begin
break;
end;
asn2 := asn2.parent as SyntaxNode;
until asn2 = nil;
node.value := v;
if asn1.value = OPERATOR_FOR then begin
i := asn1.getChildrensCount() - 2;
node.setGoAlwaysToNode(getNodeWithMinLabelNumber(asn1.getChild(i) as SyntaxNode,
(asn1.getChild(i + 1) as SyntaxNode).getChildWithMinLabelNumber()));
end else begin
node.setGoAlwaysToNode((asn1.getChild(asn1.getChildrensCount() - 1) as SyntaxNode).
getChildWithMinLabelNumber());
end;
next := node;
end;
{ if }
OPERATOR_IF: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := node.getChild(1) as SyntaxNode;
if c < 2 then begin
asn2 := placeJumpsInOperator(asn2, next);
placeJumpsInBoolean(asn1, asn2, next);
end else begin
asn3 := node.getChild(2) as SyntaxNode;
jmp1 := tree.addNodeBefore(asn3) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
jmp1.setGoAlwaysToNode(next);
asn3 := placeJumpsInOperator(asn3, next);
asn2 := placeJumpsInOperator(asn2, jmp1);
placeJumpsInBoolean(asn1, asn2, asn3);
tree.setLabelNumber(jmp1, asn3.labelNumber);
end;
next := asn1.getChildWithMinLabelNumber();
end;
{ switch }
OPERATOR_SWITCH: begin
for i := c downto 1 do begin
next := placeJumpsInOperator(node.getChild(i) as SyntaxNode, next);
end;
asn1 := node.getChild(0) as SyntaxNode;
placeJumpsInExpression(asn1);
next := asn1.getChildWithMinLabelNumber();
end;
{ do…while }
OPERATOR_DO: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := node.getChild(1) as SyntaxNode;
asn3 := asn2.getChildWithMinLabelNumber();
asn4 := placeJumpsInOperator(asn1, asn3);
placeJumpsInBoolean(asn2, asn4, next);
next := asn4;
end;
{ for }
OPERATOR_FOR: begin
dec(c, 3);
asn1 := node.getChild(c + 1) as SyntaxNode;
asn2 := node.getChild(c + 2) as SyntaxNode;
asn3 := node.getChild(c + 3) as SyntaxNode;
asn4 := asn3.getChildWithMinLabelNumber();
asn5 := placeJumpsInOperator(asn2, asn4);
asn5 := placeJumpsInOperator(asn1, asn5);
jmp1 := tree.addNodeBefore(asn1) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
jmp1.setGoAlwaysToNode(asn4);
tree.setLabelNumber(jmp1, asn5.labelNumber);
placeJumpsInBoolean(asn3, asn5, next);
next := jmp1;
for i := c downto 0 do begin
next := placeJumpsInOperator(node.getChild(i) as SyntaxNode, next);
end;
end;
{ while }
OPERATOR_WHILE: begin
asn1 := node.getChild(0) as SyntaxNode;
asn2 := node.getChild(1) as SyntaxNode;
asn3 := asn2.getChildWithMinLabelNumber();
asn4 := placeJumpsInOperator(asn1, asn3);
placeJumpsInBoolean(asn2, asn4, next);
jmp1 := tree.addChildFirst(node) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
jmp1.setGoAlwaysToNode(asn3);
tree.setLabelNumber(jmp1, asn4.labelNumber);
next := jmp1;
end;
{ throw }
OPERATOR_THROW: begin
texc := node.associate as GlobalException;
asn1 := node.parent as SyntaxNode;
with tree.root do begin
jmp1 := getChild(getChildrensCount() - 1) as SyntaxNode;
end;
repeat
if asn1.value = OPERATOR_TRY_CATCH then begin
c := asn1.getChildrensCount() - 1;
for i := 0 to c do begin
asn2 := asn1.getChild(i) as SyntaxNode;
if (asn2.value = BLOCK_CATCH) and
texc.isInheritedFrom(asn2.associate as GlobalException) then begin
jmp1 := asn2;
goto label0;
end;
end;
end;
asn1 := asn1.parent as SyntaxNode;
until asn1 = nil;
label0:
node.setGoAlwaysToNode(jmp1);
next := node;
end;
{ return }
OPERATOR_RETURN: begin
asn1 := node.parent as SyntaxNode;
repeat
if asn1.value = OPERATOR_TRY_FINALLY then begin
node.value := TF_OPERATOR_RETURN;
break;
end;
asn1 := asn1.parent as SyntaxNode;
until asn1 = nil;
with tree.root do begin
node.setGoAlwaysToNode(getChild(getChildrensCount() - 1) as SyntaxNode);
end;
if c >= 0 then begin
asn1 := node.getChild(0) as SyntaxNode;
placeJumpsInExpression(asn1);
next := asn1.getChildWithMinLabelNumber();
end else begin
next := node;
end;
end;
{ catch }
BLOCK_CATCH: begin
i := node.index;
asn1 := node.parent as SyntaxNode;
if i < asn1.getChildrensCount() - 1 then begin
jmp1 := tree.addChildLast(node) as SyntaxNode;
jmp1.setDataAssociate(-1, JUMP, nil, nil);
jmp1.setGoAlwaysToNode(next);
tree.setLabelNumber(jmp1, getNodeWithMinLabelNumber(asn1.getChild(i + 1) as SyntaxNode,
next).labelNumber);
next := jmp1;
end;
for i := c downto 0 do begin
next := placeJumpsInOperator(node.getChild(i) as SyntaxNode, next);
end;
node.setGoAlwaysToNode(next); { нужно для определения начала блока catch }
end;
{ finally }
BLOCK_FINALLY_START: begin
for i := c downto 0 do begin
next := placeJumpsInOperator(node.getChild(i) as SyntaxNode, next);
end;
node.setGoAlwaysToNode(next); { нужно для определения начала блока finally }
end;
{ finally return }
BLOCK_FINALLY_RETURN: begin
next := node;
end;
{ case, default }
BLOCK_CASE, BLOCK_DEFAULT: begin
node.goAlwaysToNode := next; { нужно для определения переходов по оператору switch }
end;
{ выражение }
else
placeJumpsInExpression(node);
next := node.getChildWithMinLabelNumber();
end;
result := next;
end;
function TranslatorTreeBuilder.insertInitializations(root: SyntaxNode): SyntaxNode;
var
i: int;
limit: int;
owner: Tree;
callNode: SyntaxNode;
funcNode: SyntaxNode;
tryfNode: SyntaxNode;
bodyNode: SyntaxNode;
fnType: TypeFunction;
func: GlobalFunction;
begin
{ вставка инициализаций и финализаций в главную функцию }
owner := root.owner;
limit := getNamespacesCount() - 1;
for i := 0 to limit do begin
func := getNamespace(i).findEntry(FUNCTION_INITIALIZATION, false) as GlobalFunction;
if func = nil then begin
continue;
end;
fnType := func.functionType;
callNode := owner.addChildLast(root) as SyntaxNode;
callNode.setDataAssociate(-1, EXPR_CALL, nil, nil);
funcNode := owner.addChildLast(callNode) as SyntaxNode;
funcNode.setDataAssociate(-1, EXPR_GLOBAL_FUNCTION, fnType, func);
end;
if operandSize < TranslatorType.SIZE_64_BIT then begin
result := owner.addChildLast(root) as SyntaxNode;
result.setDataAssociate(-1, OPERATOR_BLOCK, nil, nil);
bodyNode := root;
end else begin
tryfNode := owner.addChildLast(root) as SyntaxNode;
tryfNode.setDataAssociate(-1, OPERATOR_TRY_FINALLY, nil, nil);
result := owner.addChildLast(tryfNode) as SyntaxNode;
result.setDataAssociate(-1, OPERATOR_BLOCK, nil, nil);
bodyNode := owner.addChildLast(tryfNode) as SyntaxNode;
bodyNode.setDataAssociate(-1, BLOCK_FINALLY_START, nil, nil);
end;
for i := limit downto 0 do begin
func := getNamespace(i).findEntry(FUNCTION_FINALIZATION, false) as GlobalFunction;
if func = nil then begin
continue;
end;
fnType := func.functionType;
callNode := owner.addChildLast(bodyNode) as SyntaxNode;
callNode.setDataAssociate(-1, EXPR_CALL, nil, nil);
funcNode := owner.addChildLast(callNode) as SyntaxNode;
funcNode.setDataAssociate(-1, EXPR_GLOBAL_FUNCTION, fnType, func);
end;
if operandSize >= TranslatorType.SIZE_64_BIT then begin
funcNode := owner.addChildLast(bodyNode) as SyntaxNode;
funcNode.setDataAssociate(-1, BLOCK_FINALLY_RETURN, nil, nil);
end;
end;
function TranslatorTreeBuilder.isReachable(node: SyntaxNode): boolean;
var
i: int;
cval: int;
currIndex: int;
nodeIndex: int;
prevIndex: int;
tree: SyntaxTree;
curr: SyntaxNode;
galw: SyntaxNode;
gift: SyntaxNode;
giff: SyntaxNode;
enum: NodeEnumerator;
nobj: TObject;
begin
nodeIndex := node.labelNumber;
if nodeIndex = 0 then begin
result := true;
exit;
end;
prevIndex := nodeIndex - 1;
tree := node.owner as SyntaxTree;
nobj := node as TObject;
for i := tree.getNodesWithLabelNumberCount() - 1 downto 0 do begin
curr := tree.getNodeWithLabelNumber(i);
cval := curr.value;
if (cval = OPERATOR_THROW) or (cval = BLOCK_FINALLY_RETURN) then begin
continue;
end;
currIndex := curr.labelNumber;
if currIndex = nodeIndex then begin
continue;
end;
galw := curr.goAlwaysToNode;
gift := curr.goIfTrueToNode;
giff := curr.goIfFalseToNode;
if ((currIndex = prevIndex) and (galw = nil) and (gift = nil) and (giff = nil)) or
((galw as TObject) = nobj) or ((gift as TObject) = nobj) or
((giff as TObject) = nobj) then begin
result := true;
exit;
end;
end;
curr := node.parent as SyntaxNode;
repeat
case curr.value of
OPERATOR_TRY_CATCH, OPERATOR_TRY_FINALLY: begin
if ((curr.goIfTrueToNode as TObject) = nobj) or
((curr.goIfFalseToNode as TObject) = nobj) then begin
result := true;
exit;
end;
end;
BLOCK_CATCH, BLOCK_FINALLY_START: begin
if (curr.goAlwaysToNode as TObject) = nobj then begin
result := true;
exit;
end;
end;
end;
curr := curr.parent as SyntaxNode;
until curr = nil;
curr := tree.root as SyntaxNode;
enum := curr.enumerateChildrens();
repeat
case curr.value of
BLOCK_CASE, BLOCK_DEFAULT: begin
if (curr.goAlwaysToNode as TObject) = nobj then begin
result := true;
exit;
end;
end;
end;
curr := enum.nextChild() as SyntaxNode;
until curr = nil;
result := false;
end;
function TranslatorTreeBuilder.isReturnTo(last: SyntaxNode): boolean;
var
i: int;
cval: int;
currIndex: int;
nodeIndex: int;
prevIndex: int;
tree: SyntaxTree;
curr: SyntaxNode;
galw: SyntaxNode;
gift: SyntaxNode;
giff: SyntaxNode;
enum: NodeEnumerator;
nobj: TObject;
begin
nodeIndex := last.labelNumber;
prevIndex := nodeIndex - 1;
tree := last.owner as SyntaxTree;
nobj := last as TObject;
for i := tree.getNodesWithLabelNumberCount() - 1 downto 0 do begin
curr := tree.getNodeWithLabelNumber(i);
cval := curr.value;
if cval = BLOCK_FINALLY_RETURN then begin
continue;
end;
currIndex := curr.labelNumber;
if currIndex = nodeIndex then begin
continue;
end;
galw := curr.goAlwaysToNode;
gift := curr.goIfTrueToNode;
giff := curr.goIfFalseToNode;
if (((currIndex = prevIndex) and (galw = nil) and (gift = nil) and (giff = nil)) or
((galw as TObject) = nobj) or ((gift as TObject) = nobj) or
((giff as TObject) = nobj)) and (cval <> OPERATOR_RETURN) and
(cval <> TF_OPERATOR_RETURN) and (cval <> OPERATOR_THROW) then begin
result := false;
exit;
end;
end;
curr := tree.root as SyntaxNode;
enum := curr.enumerateChildrens();
repeat
case curr.value of
BLOCK_CASE, BLOCK_DEFAULT, BLOCK_CATCH: begin
if (curr.goAlwaysToNode as TObject) = nobj then begin
result := false;
exit;
end;
end;
end;
curr := enum.nextChild() as SyntaxNode;
until curr = nil;
result := true;
end;
function TranslatorTreeBuilder.hasLinksTo(node: SyntaxNode): boolean;
var
value: int;
notcheck: int;
nobj: TObject;
curr: SyntaxNode;
enum: NodeEnumerator;
begin
notcheck := node.labelNumber - 1;
nobj := node as TObject;
curr := node.owner.root as SyntaxNode;
enum := curr.enumerateChildrens();
repeat
value := curr.value;
if (curr.labelNumber <> notcheck) and
(value <> EXPR_SORL) and (value <> EXPR_SANDL) and
(value <> EXPR_SNOTL) and (value <> EXPR_QUESTION) and
(value <> OPERATOR_THROW) and (
((curr.goAlwaysToNode as TObject) = nobj) or
((curr.goIfTrueToNode as TObject) = nobj) or
((curr.goIfFalseToNode as TObject) = nobj)) then begin
result := true;
exit;
end;
curr := enum.nextChild() as SyntaxNode;
until curr = nil;
result := false;
end;
{ TranslatorFoundObject }
constructor TranslatorFoundObject.create(foundIn: LocalVariable; baseObject: StructureField);
begin
inherited create();
if baseObject = nil then begin
baseObject := TranslatorStructureField.create(nil, 0, false, nil, '');
end;
self.foundIn := foundIn;
self.baseObject := baseObject;
end;
function TranslatorFoundObject.toString(): AnsiString;
begin
result := baseObject.toString();
end;
procedure TranslatorFoundObject.setDeclarePosition(declarePosition: int);
begin
baseObject.setDeclarePosition(declarePosition);
end;
procedure TranslatorFoundObject.setStartPosition(startPosition: int);
begin
baseObject.setStartPosition(startPosition);
end;
function TranslatorFoundObject.getDeclarePosition(): int;
begin
result := baseObject.getDeclarePosition();
end;
function TranslatorFoundObject.getStartPosition(): int;
begin
result := baseObject.getStartPosition();
end;
function TranslatorFoundObject.getName(): UnicodeString;
begin
result := baseObject.getName();
end;
function TranslatorFoundObject.getDataType(): TypeDescriptor;
begin
result := baseObject.getDataType();
end;
function TranslatorFoundObject.isPublic(): boolean;
begin
result := baseObject.isPublic();
end;
function TranslatorFoundObject.getOffset(): int;
begin
result := baseObject.getOffset();
end;
function TranslatorFoundObject.getOwner(): TypeStructure;
begin
result := baseObject.getOwner();
end;
function TranslatorFoundObject.getFoundIn(): LocalVariable;
begin
result := foundIn;
end;
function TranslatorFoundObject.getBaseObject(): StructureField;
begin
result := baseObject;
end;
end.
