{
Этот исходный текст является частью Продвинутого векторного транслятора.
Copyright © 2017 Малик Разработчик
Это свободная программа: вы можете перераспространять её и/или
изменять её на условиях Стандартной общественной лицензии GNU в том виде,
в каком она была опубликована Фондом свободного программного обеспечения;
либо версии 3 лицензии, либо (по вашему выбору) любой более поздней версии.
Эта программа распространяется в надежде, что она может быть полезна,
но БЕЗО ВСЯКИХ ГАРАНТИЙ; даже без неявной гарантии ТОВАРНОГО ВИДА
или ПРИГОДНОСТИ ДЛЯ ОПРЕДЕЛЁННЫХ ЦЕЛЕЙ. Подробнее см. в Стандартной
общественной лицензии GNU.
Вы должны были получить копию Стандартной общественной лицензии GNU
вместе с этой программой. Если это не так, см.
<http://www.gnu.org/licenses/>.
}
unit BuildLex;
{$MODE DELPHI,EXTENDEDSYNTAX ON}
interface
uses
Lang, TranIntf;
{$ASMMODE INTEL,CALLING REGISTER,INLINE ON,GOTO ON}
{$H+,I-,J-,M-,Q-,R-,T-}
type
TranslatorPool = class;
TranslatorPoolInt = class;
TranslatorPoolLong = class;
TranslatorPoolReal = class;
TranslatorPoolString = class;
TranslatorPoolUltra = class;
TranslatorPoolXVector = class;
TranslatorLexer = class;
TranslatorPool = class(RefCountInterfacedObject, Pool)
public
procedure clear(); virtual;
procedure delete(index: int); virtual; abstract;
function getLength(): int; virtual;
protected
count: int;
end;
TranslatorPoolInt = class(TranslatorPool, PoolInt)
protected
class function equals(const x, y: int): boolean; overload;
public
procedure clear(); override;
procedure delete(index: int); override;
procedure setValue(index: int; const value: int); virtual;
function getValue(index: int): int; virtual;
function indexAcquire(const value: int): int; virtual;
function indexOf(const value: int): int; virtual;
protected
function append(const value: int): int; virtual;
strict private
pool: int_Array1d;
end;
TranslatorPoolLong = class(TranslatorPool, PoolLong)
protected
class function equals(const x, y: int64): boolean; overload;
public
procedure clear(); override;
procedure delete(index: int); override;
procedure setValue(index: int; const value: int64); virtual;
function getValue(index: int): int64; virtual;
function indexAcquire(const value: int64): int; virtual;
function indexOf(const value: int64): int; virtual;
protected
function append(const value: int64): int; virtual;
strict private
pool: long_Array1d;
end;
TranslatorPoolReal = class(TranslatorPool, PoolReal)
protected
class function equals(const x, y: real): boolean; overload;
public
procedure clear(); override;
procedure delete(index: int); override;
procedure setValue(index: int; const value: real); virtual;
function getValue(index: int): real; virtual;
function indexAcquire(const value: real): int; virtual;
function indexOf(const value: real): int; virtual;
protected
function append(const value: real): int; virtual;
strict private
pool: real_Array1d;
end;
TranslatorPoolString = class(TranslatorPool, PoolString)
protected
class function equals(const x, y: UnicodeString): boolean; overload;
public
procedure clear(); override;
procedure delete(index: int); override;
procedure setValue(index: int; const value: UnicodeString); virtual;
function getValue(index: int): UnicodeString; virtual;
function indexAcquire(const value: UnicodeString): int; virtual;
function indexOf(const value: UnicodeString): int; virtual;
protected
function append(const value: UnicodeString): int; virtual;
strict private
pool: UnicodeString_Array1d;
end;
TranslatorPoolUltra = class(TranslatorPool, PoolUltra)
protected
class function equals(const x, y: ultra): boolean; overload;
public
procedure clear(); override;
procedure delete(index: int); override;
procedure setValue(index: int; const value: ultra); virtual;
function getValue(index: int): ultra; virtual;
function indexAcquire(const value: ultra): int; virtual;
function indexOf(const value: ultra): int; virtual;
protected
function append(const value: ultra): int; virtual;
strict private
pool: ultra_Array1d;
end;
TranslatorPoolXVector = class(TranslatorPool, PoolXVector)
protected
class function equals(const x, y: xvector): boolean; overload;
public
procedure clear(); override;
procedure delete(index: int); override;
procedure setValue(index: int; const value: xvector); virtual;
function getValue(index: int): xvector; virtual;
function indexAcquire(const value: xvector): int; virtual;
function indexOf(const value: xvector): int; virtual;
protected
function append(const value: xvector): int; virtual;
strict private
pool: xvector_Array1d;
end;
TranslatorLexer = class(RefCountInterfacedObject, Lexer)
public
const COMMENT = -$0001;
const NULL = $0000;
{ symbol }
const COMMA = $0001; // ,
const COLON = $0002; // :
const SEMICOLON = $0003; // ;
const QUESTION_MARK = $0004; // ?
const OPENED_CURLY_BRACKET = $0005; // {
const OPENED_PARENTHESIS = $0006; // (
const OPENED_SQUARE_BRACKET = $0007; // [
const CLOSED_CURLY_BRACKET = $0009; // }
const CLOSED_PARENTHESIS = $000a; // )
const CLOSED_SQUARE_BRACKET = $000b; // ]
{ operator post }
const INCR = $0010; // ++
const DECR = $0011; // --
const PERIOD = $0012; // .
{ operator singuli }
const SNOTB = $0101; // ~
const SANDB = $0102; // &
const SORB = $0103; // |
const SXORB = $0104; // ^
const SNOTL = $0109; // !
const SANDL = $010a; // &&
const SORL = $010b; // ||
const SMULL = $0110; // *
const SDIVS = $0114; // /
const SREMS = $0115; // %
const SDIVU = $0116; // //
const SREMU = $0117; // %%
const SPLUS = $0118; // +
const SMINUS = $011c; // -
const SSRA = $0120; // >>
const SSRL = $0121; // >>>
const SSLL = $0122; // <<
const SGT = $0128; // >
const SGE = $0129; // >=
const SLT = $012a; // <
const SLE = $012b; // <=
const SEQ = $012c; // ==
const SNE = $012d; // !=
{ operator quaterni }
const QPACKUS = $0401; // @@@@
const QUNPCKL = $0402; // ####
const QUNPCKH = $0403; // ^^^^
const QMULL = $0410; // ****
const QMULH = $0411; // ***^
const QMULHS = $0412; // ***|
const QDIV = $0414; // ////
const QADD = $0418; // ++++
const QADDS = $0419; // +++|
const QADDUS = $041a; // +++#
const QSUB = $041c; // ----
const QSUBS = $041d; // ---|
const QSUBUS = $041e; // ---#
const QSRA = $0420; // >>>>
const QSRL = $0421; // >>>>>
const QSLL = $0422; // <<<<
const QGT = $0428; // >>||
const QGE = $0429; // >=||
const QLT = $042a; // <<||
const QLE = $042b; // <=||
const QEQ = $042c; // ==||
const QNE = $042d; // !=||
{ operator octoni }
const OPACKUS = $0801; // @@..@@
const OUNPCKL = $0802; // ##..##
const OUNPCKH = $0803; // ^^..^^
const OMULL = $0810; // **..**
const OMULH = $0811; // **..*^
const OMULHS = $0812; // **..*|
const OADD = $0818; // ++..++
const OADDS = $0819; // ++..+|
const OADDUS = $081a; // ++..+#
const OSUB = $081c; // --..--
const OSUBS = $081d; // --..-|
const OSUBUS = $081e; // --..-#
const OSRA = $0820; // >>..>>
const OSRL = $0821; // >>..>>>
const OSLL = $0822; // <<..<<
const OGT = $0828; // >>|..|
const OGE = $0829; // >=|..|
const OLT = $082a; // <<|..|
const OLE = $082b; // <=|..|
const OEQ = $082c; // ==|..|
const ONE = $082d; // !=|..|
{ operator assign singuli }
const ASSIGN = $4000; // =
const ASANDB = $4102; // &=
const ASORB = $4103; // |=
const ASXORB = $4104; // ^=
const ASMULL = $4110; // *=
const ASDIVS = $4114; // /=
const ASREMS = $4115; // %=
const ASDIVU = $4116; // //=
const ASREMU = $4117; // %%=
const ASPLUS = $4118; // +=
const ASMINUS = $411c; // -=
const ASSRA = $4120; // >>=
const ASSRL = $4121; // >>>=
const ASSLL = $4122; // <<=
{ operator assign quaterni }
const AQMULL = $4410; // ****=
const AQMULH = $4411; // ***^=
const AQMULHS = $4412; // ***|=
const AQDIV = $4414; // ////=
const AQADD = $4418; // ++++=
const AQADDS = $4419; // +++|=
const AQADDUS = $441a; // +++#=
const AQSUB = $441c; // ----=
const AQSUBS = $441d; // ---|=
const AQSUBUS = $441e; // ---#=
const AQSRA = $4420; // >>>>=
const AQSRL = $4421; // >>>>>=
const AQSLL = $4422; // <<<<=
const AQGT = $4428; // >>||=
const AQGE = $4429; // >=||=
const AQLT = $442a; // <<||=
const AQLE = $442b; // <=||=
const AQEQ = $442c; // ==||=
const AQNE = $442d; // !=||=
{ operator assign octoni }
const AOMULL = $4810; // **..**=
const AOMULH = $4811; // **..*^=
const AOMULHS = $4812; // **..*|=
const AOADD = $4818; // ++..++=
const AOADDS = $4819; // ++..+|=
const AOADDUS = $481a; // ++..+#=
const AOSUB = $481c; // --..--=
const AOSUBS = $481d; // --..-|=
const AOSUBUS = $481e; // --..-#=
const AOSRA = $4820; // >>..>>=
const AOSRL = $4821; // >>..>>>=
const AOSLL = $4822; // <<..<<=
const AOGT = $4828; // >>|..|=
const AOGE = $4829; // >=|..|=
const AOLT = $482a; // <<|..|=
const AOLE = $482b; // <=|..|=
const AOEQ = $482c; // ==|..|=
const AONE = $482d; // !=|..|=
{ keywords }
const KW_NULL = -$1000; // null | nihil, nil
const KW_FALSE = -$0fff; // false | falsum
const KW_TRUE = -$0ffe; // true | verum
const KW_IMPORT = -$0ffd; // import | importus
const KW_NAMESPACE = -$0ffc; // namespace | spatium
const KW_PUBLIC = -$0ffb; // public | publicus
const KW_CONST = -$0ffa; // const | constans
const KW_STRUCT = -$0ff9; // struct | structura
const KW_EXCEPTION = -$0ff8; // exception | exceptio
const KW_INTERRUPT = -$0ff7; // interrupt | interruptio
const KW_ASSEMBLER = -$0ff6; // assembler | assembler
const KW_PUREASSEMBLER = -$0ff5; // pureassembler | purusassembler
const KW_INITIALIZATION = -$0ff4; // initialization | initiare
const KW_FINALIZATION = -$0ff3; // finalization | finis
const KW_NEW = -$0ff2; // new | novus, creare
const KW_DISPOSE = -$0ff1; // dispose | auferre
const KW_IF = -$0ff0; // if | si
const KW_ELSE = -$0fef; // else | contra
const KW_SWITCH = -$0fee; // switch | seligere
const KW_CASE = -$0fed; // case | casus
const KW_DEFAULT = -$0fec; // default | deficio
const KW_BREAK = -$0feb; // break | abortum
const KW_CONTINUE = -$0fea; // continue | procedere
const KW_FOR = -$0fe9; // for | pro
const KW_WHILE = -$0fe8; // while | adhuc
const KW_DO = -$0fe7; // do | ago
const KW_WITH = -$0fe6; // with | cum
const KW_TRY = -$0fe5; // try | probo
const KW_CATCH = -$0fe4; // catch | captum
const KW_FINALLY = -$0fe3; // finally | finalis
const KW_THROW = -$0fe2; // throw | emissio
const KW_RETURN = -$0fe1; // return | redire
const KW_VOID = -$0fe0; // void | vacuus
const KW_BOOLEAN = -$0fdf; // boolean | logicus
const KW_CHAR = -$0fde; // char | signum
const KW_FLOAT = -$0fdd; // float | nare
const KW_DOUBLE = -$0fdc; // double | duplex
const KW_REAL = -$0fdb; // real | realis
const KW_BYTE = -$0fda; // byte | bytus
const KW_SHORT = -$0fd9; // short | brevis
const KW_INT = -$0fd8; // int | integer
const KW_LONG = -$0fd7; // long | longus
const KW_ULTRA = -$0fd6; // ultra | ultra
const KW_ULTRA32 = -$0fd5; // ultra32 | ultra32
const KW_ULTRA64 = -$0fd4; // ultra64 | ultra64
const KW_XVECTOR = -$0fd3; // xvector | xvector
const KW_YVECTOR = -$0fd2; // yvector | yvector
const KW_ZVECTOR = -$0fd1; // zvector | zvector
const KW_FVECTOR = -$0fd0; // fvector | fvector
{ valued lexemes }
const IDENTIFIER = -$0010;
const NUM_INT = -$000f;
const NUM_LONG = -$000e;
const NUM_FLOAT = -$000d;
const NUM_DOUBLE = -$000c;
const NUM_REAL = -$000b;
const STRING_LITERAL = -$000a;
{ assembler }
const ASM_LEXEME = -$0002;
private
class procedure clinit();
class procedure cldone();
strict private
class var KEYWORDS: UnicodeString_Array1d;
public
constructor create(const sourceName: UnicodeString);
procedure afterConstruction(); override;
procedure clear(); virtual;
procedure trimToSize(); virtual;
procedure append(lexType, lexValue, lexLine, lexChar: int); virtual;
procedure delete(index: int); virtual;
procedure insert(index, lexType, lexValue: int); virtual;
procedure setData(index, lexType, lexValue: int); virtual;
procedure split(placeComments: boolean; const sourceCode: UnicodeString); virtual;
function getLength(): int; virtual;
function getLinesCount(): int; virtual;
function getLine(index: int): int; virtual;
function getChar(index: int): int; virtual;
function getType(index: int): int; virtual;
function getValue(index: int): int; virtual;
function getValueInt(index: int): int; virtual;
function getValueLong(index: int): int64; virtual;
function getValueReal(index: int): real; virtual;
function getValueAString(index: int): AnsiString; virtual;
function getValueUString(index: int): UnicodeString; virtual;
function getPoolOfInt(): PoolInt; virtual;
function getPoolOfLong(): PoolLong; virtual;
function getPoolOfReal(): PoolReal; virtual;
function getPoolOfString(): PoolString; virtual;
function getSourceName(): UnicodeString; virtual;
function getSourceCode(): UnicodeString; virtual;
function getSourceLine(index: int): UnicodeString; virtual;
function getSourceFragment(beginLine, beginChar,
endLine, endChar: int): UnicodeString; virtual;
function lexemeToString(index: int): UnicodeString; virtual;
protected
count: int;
lexemes: long_Array1d;
function createPoolOfInt(): PoolInt; virtual;
function createPoolOfLong(): PoolLong; virtual;
function createPoolOfReal(): PoolReal; virtual;
function createPoolOfString(): PoolString; virtual;
procedure checkIndex(index: int);
strict private
sourceName: UnicodeString;
sourceCode: UnicodeString;
sourceLines: int_Array1d;
poolOfInts: PoolInt;
poolOfLongs: PoolLong;
poolOfReals: PoolReal;
poolOfStrings: PoolString;
function getIndex(line, char: int): int;
end;
resourcestring
msgIllegalCharacter = 'Недопустимый символ.';
msgErrorInIntConstant = 'Ошибка в константе типа int.';
msgErrorInLongConstant = 'Ошибка в константе типа long.';
msgErrorInFloatConstant = 'Ошибка в константе типа float.';
msgErrorInDoubleConstant = 'Ошибка в константе типа double.';
msgErrorInRealConstant = 'Ошибка в константе типа real.';
msgErrorInCharConstant = 'Ошибка в символьной константе.';
msgErrorInStringLiteral = 'Ошибка в строковом литерале.';
implementation
{ TranslatorPool }
procedure TranslatorPool.clear();
begin
count := 0;
end;
function TranslatorPool.getLength(): int;
begin
result := count;
end;
{ TranslatorPoolInt }
class function TranslatorPoolInt.equals(const x, y: int): boolean;
begin
result := x = y;
end;
procedure TranslatorPoolInt.clear();
begin
inherited clear();
pool := nil;
end;
procedure TranslatorPoolInt.delete(index: int);
var
c: int;
e: int;
begin
c := count;
if (index < 0) or (index >= c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
e := c - index - 1;
if e > 0 then begin
arraycopyPrimitives(pool, index + 1, pool, index, e);
end;
dec(c);
pool[c] := 0;
count := c;
end;
procedure TranslatorPoolInt.setValue(index: int; const value: int);
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
pool[index] := value;
end;
function TranslatorPoolInt.getValue(index: int): int;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := pool[index];
end;
function TranslatorPoolInt.indexAcquire(const value: int): int;
begin
result := indexOf(value);
if result < 0 then begin
result := append(value);
end;
end;
function TranslatorPoolInt.indexOf(const value: int): int;
var
i: int;
c: int;
begin
c := count - 1;
for i := 0 to c do begin
if equals(pool[i], value) then begin
result := i;
exit;
end;
end;
result := -1;
end;
function TranslatorPoolInt.append(const value: int): int;
var
pool: int_Array1d;
newpool: int_Array1d;
begin
result := self.count;
pool := self.pool;
if result = length(pool) then begin
newpool := int_Array1d_create((result shl 1) + 1);
arraycopyPrimitives(pool, 0, newpool, 0, result);
self.pool := newpool;
pool := newpool;
end;
pool[result] := value;
self.count := result + 1;
end;
{ TranslatorPoolLong }
class function TranslatorPoolLong.equals(const x, y: int64): boolean;
begin
result := long(x) = long(y);
end;
procedure TranslatorPoolLong.clear();
begin
inherited clear();
pool := nil;
end;
procedure TranslatorPoolLong.delete(index: int);
var
c: int;
e: int;
begin
c := count;
if (index < 0) or (index >= c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
e := c - index - 1;
if e > 0 then begin
arraycopyPrimitives(pool, index + 1, pool, index, e);
end;
dec(c);
pool[c] := 0;
count := c;
end;
procedure TranslatorPoolLong.setValue(index: int; const value: int64);
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
pool[index] := value;
end;
function TranslatorPoolLong.getValue(index: int): int64;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := pool[index];
end;
function TranslatorPoolLong.indexAcquire(const value: int64): int;
begin
result := indexOf(value);
if result < 0 then begin
result := append(value);
end;
end;
function TranslatorPoolLong.indexOf(const value: int64): int;
var
i: int;
c: int;
begin
c := count - 1;
for i := 0 to c do begin
if equals(pool[i], value) then begin
result := i;
exit;
end;
end;
result := -1;
end;
function TranslatorPoolLong.append(const value: int64): int;
var
pool: long_Array1d;
newpool: long_Array1d;
begin
result := self.count;
pool := self.pool;
if result = length(pool) then begin
newpool := long_Array1d_create((result shl 1) + 1);
arraycopyPrimitives(pool, 0, newpool, 0, result);
self.pool := newpool;
pool := newpool;
end;
pool[result] := value;
self.count := result + 1;
end;
{ TranslatorPoolReal }
class function TranslatorPoolReal.equals(const x, y: real): boolean;
begin
result := (realExtractExponent(x) = realExtractExponent(y)) and
(realExtractSignificand(x) = realExtractSignificand(y));
end;
procedure TranslatorPoolReal.clear();
begin
inherited clear();
pool := nil;
end;
procedure TranslatorPoolReal.delete(index: int);
var
c: int;
e: int;
begin
c := count;
if (index < 0) or (index >= c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
e := c - index - 1;
if e > 0 then begin
arraycopyPrimitives(pool, index + 1, pool, index, e);
end;
dec(c);
pool[c] := 0;
count := c;
end;
procedure TranslatorPoolReal.setValue(index: int; const value: real);
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
pool[index] := value;
end;
function TranslatorPoolReal.getValue(index: int): real;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := pool[index];
end;
function TranslatorPoolReal.indexAcquire(const value: real): int;
begin
result := indexOf(value);
if result < 0 then begin
result := append(value);
end;
end;
function TranslatorPoolReal.indexOf(const value: real): int;
var
i: int;
c: int;
begin
c := count - 1;
for i := 0 to c do begin
if equals(pool[i], value) then begin
result := i;
exit;
end;
end;
result := -1;
end;
function TranslatorPoolReal.append(const value: real): int;
var
pool: real_Array1d;
newpool: real_Array1d;
begin
result := self.count;
pool := self.pool;
if result = length(pool) then begin
newpool := real_Array1d_create((result shl 1) + 1);
arraycopyPrimitives(pool, 0, newpool, 0, result);
self.pool := newpool;
pool := newpool;
end;
pool[result] := value;
self.count := result + 1;
end;
{ TranslatorPoolString }
class function TranslatorPoolString.equals(const x, y: UnicodeString): boolean;
begin
result := x = y;
end;
procedure TranslatorPoolString.clear();
begin
inherited clear();
pool := nil;
end;
procedure TranslatorPoolString.delete(index: int);
var
c: int;
e: int;
begin
c := count;
if (index < 0) or (index >= c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
e := c - index - 1;
if e > 0 then begin
arraycopyUnicodeStrings(pool, index + 1, pool, index, e);
end;
dec(c);
pool[c] := '';
count := c;
end;
procedure TranslatorPoolString.setValue(index: int; const value: UnicodeString);
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
pool[index] := value;
end;
function TranslatorPoolString.getValue(index: int): UnicodeString;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := pool[index];
end;
function TranslatorPoolString.indexAcquire(const value: UnicodeString): int;
begin
result := indexOf(value);
if result < 0 then begin
result := append(value);
end;
end;
function TranslatorPoolString.indexOf(const value: UnicodeString): int;
var
i: int;
c: int;
begin
c := count - 1;
for i := 0 to c do begin
if equals(pool[i], value) then begin
result := i;
exit;
end;
end;
result := -1;
end;
function TranslatorPoolString.append(const value: UnicodeString): int;
var
pool: UnicodeString_Array1d;
newpool: UnicodeString_Array1d;
begin
result := self.count;
pool := self.pool;
if result = length(pool) then begin
newpool := UnicodeString_Array1d_create((result shl 1) + 1);
arraycopyUnicodeStrings(pool, 0, newpool, 0, result);
self.pool := newpool;
pool := newpool;
end;
pool[result] := value;
self.count := result + 1;
end;
{ TranslatorPoolUltra }
class function TranslatorPoolUltra.equals(const x, y: ultra): boolean; assembler; nostackframe;
asm
movdqu xmm0, [edx]
movdqu xmm1, [ecx]
pcmpeqd xmm0, xmm1
movmskps eax, xmm0
cmp eax, $0f
sete al
movsx eax, al
end;
procedure TranslatorPoolUltra.clear();
begin
inherited clear();
pool := nil;
end;
procedure TranslatorPoolUltra.delete(index: int);
var
c: int;
e: int;
begin
c := count;
if (index < 0) or (index >= c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
e := c - index - 1;
if e > 0 then begin
arraycopyPrimitives(pool, index + 1, pool, index, e);
end;
dec(c);
pool[c] := ultraBuild(0, 0, 0, 0);
count := c;
end;
procedure TranslatorPoolUltra.setValue(index: int; const value: ultra);
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
pool[index] := value;
end;
function TranslatorPoolUltra.getValue(index: int): ultra;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := pool[index];
end;
function TranslatorPoolUltra.indexAcquire(const value: ultra): int;
begin
result := indexOf(value);
if result < 0 then begin
result := append(value);
end;
end;
function TranslatorPoolUltra.indexOf(const value: ultra): int;
var
i: int;
c: int;
begin
c := count - 1;
for i := 0 to c do begin
if equals(pool[i], value) then begin
result := i;
exit;
end;
end;
result := -1;
end;
function TranslatorPoolUltra.append(const value: ultra): int;
var
pool: ultra_Array1d;
newpool: ultra_Array1d;
begin
result := self.count;
pool := self.pool;
if result = length(pool) then begin
newpool := ultra_Array1d_create((result shl 1) + 1);
arraycopyPrimitives(pool, 0, newpool, 0, result);
self.pool := newpool;
pool := newpool;
end;
pool[result] := value;
self.count := result + 1;
end;
{ TranslatorPoolXVector }
class function TranslatorPoolXVector.equals(const x, y: xvector): boolean; assembler; nostackframe;
asm
movdqu xmm0, [edx]
movdqu xmm1, [ecx]
pcmpeqd xmm0, xmm1
movmskps eax, xmm0
cmp eax, $0f
sete al
movsx eax, al
end;
procedure TranslatorPoolXVector.clear();
begin
inherited clear();
pool := nil;
end;
procedure TranslatorPoolXVector.delete(index: int);
var
c: int;
e: int;
begin
c := count;
if (index < 0) or (index >= c) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
e := c - index - 1;
if e > 0 then begin
arraycopyPrimitives(pool, index + 1, pool, index, e);
end;
dec(c);
pool[c] := xvectorBuild(0, 0, 0, 0);
count := c;
end;
procedure TranslatorPoolXVector.setValue(index: int; const value: xvector);
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
pool[index] := value;
end;
function TranslatorPoolXVector.getValue(index: int): xvector;
begin
if (index < 0) or (index >= count) then begin
raise ArrayIndexOutOfBoundsException.create(msgArrayIndexOutOfBounds);
end;
result := pool[index];
end;
function TranslatorPoolXVector.indexAcquire(const value: xvector): int;
begin
result := indexOf(value);
if result < 0 then begin
result := append(value);
end;
end;
function TranslatorPoolXVector.indexOf(const value: xvector): int;
var
i: int;
c: int;
begin
c := count - 1;
for i := 0 to c do begin
if equals(pool[i], value) then begin
result := i;
exit;
end;
end;
result := -1;
end;
function TranslatorPoolXVector.append(const value: xvector): int;
var
pool: xvector_Array1d;
newpool: xvector_Array1d;
begin
result := self.count;
pool := self.pool;
if result = length(pool) then begin
newpool := xvector_Array1d_create((result shl 1) + 1);
arraycopyPrimitives(pool, 0, newpool, 0, result);
self.pool := newpool;
pool := newpool;
end;
pool[result] := value;
self.count := result + 1;
end;
{ TranslatorLexer }
class procedure TranslatorLexer.clinit();
begin
KEYWORDS := UnicodeString_Array1d_create([
'null', 'false', 'true', 'import', 'namespace', 'public', 'const', 'struct', 'exception',
'interrupt', 'assembler', 'pureassembler', 'initialization', 'finalization', 'new',
'dispose', 'if', 'else', 'switch', 'case', 'default', 'break', 'continue', 'for', 'while',
'do', 'with', 'try', 'catch', 'finally', 'throw', 'return', 'void', 'boolean', 'char',
'float', 'double', 'real', 'byte', 'short', 'int', 'long', 'ultra', 'ultra32', 'ultra64',
'xvector', 'yvector', 'zvector', 'fvector'
]);
end;
class procedure TranslatorLexer.cldone();
begin
KEYWORDS := nil;
end;
constructor TranslatorLexer.create(const sourceName: UnicodeString);
begin
inherited create();
self.count := 0;
self.lexemes := nil;
self.sourceName := sourceName;
self.sourceCode := '';
self.sourceLines := nil;
self.poolOfInts := nil;
self.poolOfLongs := nil;
self.poolOfReals := nil;
self.poolOfStrings := nil;
end;
procedure TranslatorLexer.afterConstruction();
begin
inherited afterConstruction();
self.poolOfInts := createPoolOfInt();
self.poolOfLongs := createPoolOfLong();
self.poolOfReals := createPoolOfReal();
self.poolOfStrings := createPoolOfString();
end;
procedure TranslatorLexer.clear();
begin
count := 0;
lexemes := nil;
sourceCode := '';
sourceLines := nil;
end;
procedure TranslatorLexer.trimToSize();
var
c: int;
lexemes: long_Array1d;
newlexemes: long_Array1d;
begin
c := self.count;
lexemes := self.lexemes;
if length(lexemes) > c then begin
newlexemes := long_Array1d_create(c);
arraycopyPrimitives(lexemes, 0, newlexemes, 0, c);
self.lexemes := newlexemes;
end;
end;
procedure TranslatorLexer.append(lexType, lexValue, lexLine, lexChar: int);
var
c: int;
lexemes: long_Array1d;
newlexemes: long_Array1d;
begin
c := self.count;
lexemes := self.lexemes;
if length(lexemes) = c then begin
newlexemes := long_Array1d_create((c shl 1) + 1);
arraycopyPrimitives(lexemes, 0, newlexemes, 0, c);
self.lexemes := newlexemes;
lexemes := newlexemes;
end;
lexemes[c] := longBuild(
(lexLine shl 16) + (lexChar and $ffff),
(lexValue shl 16) + (lexType and $ffff));
self.count := c + 1;
end;
procedure TranslatorLexer.delete(index: int);
var
c: int;
e: int;
lexemes: long_Array1d;
begin
c := self.count;
if (index < 0) or (index >= c) then begin
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
lexemes := self.lexemes;
e := c - index - 1;
if e > 0 then begin
arraycopyPrimitives(lexemes, index + 1, lexemes, index, e);
end;
dec(c);
lexemes[c] := 0;
self.count := c;
end;
procedure TranslatorLexer.insert(index, lexType, lexValue: int);
var
c: int;
e: int;
lexemes: long_Array1d;
newlexemes: long_Array1d;
begin
c := self.count;
if (index < 0) or (index > c) then begin
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
lexemes := self.lexemes;
if length(lexemes) = c then begin
newlexemes := long_Array1d_create((c shl 1) + 1);
arraycopyPrimitives(lexemes, 0, newlexemes, 0, c);
self.lexemes := newlexemes;
lexemes := newlexemes;
end;
e := c - index;
if e > 0 then begin
arraycopyPrimitives(lexemes, index, lexemes, index + 1, e);
end;
lexemes[index] := longBuild(0, (lexValue shl 16) + (lexType and $ffff));
self.count := c + 1;
end;
procedure TranslatorLexer.setData(index, lexType, lexValue: int);
begin
checkIndex(index);
lexemes[index].ints[0] := (lexValue shl 16) + (lexType and $ffff);
end;
procedure TranslatorLexer.split(placeComments: boolean; const sourceCode: UnicodeString);
label
label0,
label1;
var
negative: boolean;
fraction: boolean;
hasorder: boolean;
c: uchar;
d: uchar;
x: real;
i: int;
j: int;
order: int;
fracLength: int;
linesCount: int;
lineStart: int;
lineNumber: int;
lexemeStart: int;
s: PWideChar;
ints: PoolInt;
longs: PoolLong;
reals: PoolReal;
strs: PoolString;
str: UnicodeString;
lines: int_Array1d;
procedure addLine(index, count: int); inline;
var
newlines: int_Array1d;
begin
if length(lines) = linesCount then begin
newlines := int_Array1d_create((linesCount shl 1) + 2);
arraycopyPrimitives(lines, 0, newlines, 0, linesCount);
lines := newlines;
end;
lines[linesCount] := index;
lines[linesCount + 1] := count;
inc(linesCount, 2);
end;
function trimLines(): int_Array1d; inline;
begin
if length(lines) = linesCount then begin
result := lines;
exit;
end;
result := int_Array1d_create(linesCount);
arraycopyPrimitives(lines, 0, result, 0, linesCount);
end;
begin
clear();
i := 0;
linesCount := 0;
lineStart := -1;
lineNumber := 1;
lexemeStart := 0;
s := PWideChar(sourceCode);
ints := poolOfInts;
longs := poolOfLongs;
reals := poolOfReals;
strs := poolOfStrings;
lines := nil;
self.sourceCode := sourceCode;
self.sourceLines := nil;
if s = nil then begin
goto label1;
end;
c := s[0];
if (c = #$feff) or (c = #$fffe) or (c = #$ffff) then begin
i := 1;
end;
repeat
lexemeStart := i;
c := s[i];
inc(i);
case c of
#$0000: begin
addLine(lineStart + 1, i - lineStart - 2);
break;
end;
#$0001..#$0020: begin
if (c = #$000d) and (s[i] = #$000a) then begin
addLine(lineStart + 1, i - lineStart - 2);
inc(i);
inc(lineNumber);
lineStart := i - 1;
continue;
end;
if (c = #$000d) or (c = #$000a) then begin
addLine(lineStart + 1, i - lineStart - 2);
inc(lineNumber);
lineStart := i - 1;
continue;
end;
end;
'!': begin
{ !
!=
!=||
!=||=
!=|..|
!=|..|=
T0123456 }
if s[i] = '=' then begin
if s[i + 1] = '|' then begin
case s[i + 2] of
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQNE, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QNE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 3] = '.') and (s[i + 4] = '|') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AONE, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(ONE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SNE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SNE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SNE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
append(SNOTL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'"': begin
str := '';
repeat
c := s[i];
inc(i);
case c of
#$0000: begin
dec(i);
raise CompileError.create(msgErrorInStringLiteral, self,
lineNumber, i - lineStart);
end;
'"': begin
break;
end;
'\': begin
case s[i] of
'0': begin
inc(i);
str := str + #$0000;
end;
'b': begin
inc(i);
str := str + #$0008;
end;
't': begin
inc(i);
str := str + #$0009;
end;
'n': begin
inc(i);
str := str + #$000a;
end;
'f': begin
inc(i);
str := str + #$000c;
end;
'r': begin
inc(i);
str := str + #$000d;
end;
'"': begin
inc(i);
str := str + '"';
end;
'''': begin
inc(i);
str := str + '''';
end;
'\': begin
inc(i);
str := str + '\';
end;
'u': begin
inc(i);
order := 0;
for j := 3 downto 0 do begin
c := s[i];
case c of
'0'..'9': begin
order := order + ((int(c) - int('0')) shl (j shl 2));
end;
'A'..'F': begin
order := order + ((int(c) - (int('A') - $0a)) shl (j shl 2));
end;
'a'..'f': begin
order := order + ((int(c) - (int('a') - $0a)) shl (j shl 2));
end;
else
raise CompileError.create(msgErrorInStringLiteral, self,
lineNumber, i - lineStart);
end;
inc(i);
end;
str := str + uchar(order);
end;
#$0001..#$0020: begin
repeat
c := s[i];
inc(i);
if (c = #$000d) and (s[i] = #$000a) then begin
addLine(lineStart + 1, i - lineStart - 2);
inc(i);
inc(lineNumber);
lineStart := i - 1;
continue;
end;
if (c = #$000d) or (c = #$000a) then begin
addLine(lineStart + 1, i - lineStart - 2);
inc(lineNumber);
lineStart := i - 1;
continue;
end;
until (c < #$0001) or (c > #$0020);
dec(i);
end;
else
raise CompileError.create(msgErrorInStringLiteral, self,
lineNumber, i - lineStart);
end;
end;
else
str := str + c;
end;
until false;
append(STRING_LITERAL, strs.indexAcquire(str), lineNumber, lexemeStart - lineStart);
end;
'#': begin
{ ####
##..##
T012345 }
if s[i] = '#' then begin
case s[i + 1] of
'#': begin
if s[i + 2] = '#' then begin
inc(i, 3);
append(QUNPCKL, 0, lineNumber, lexemeStart - lineStart);
end else begin
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '#') and (s[i + 4] = '#') then begin
inc(i, 5);
append(OUNPCKL, 0, lineNumber, lexemeStart - lineStart);
end else begin
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'$': begin
repeat
case s[i] of
'0'..'9', 'A'..'F', 'a'..'f': begin
inc(i);
end;
else
break;
end;
until false;
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
'%': begin
{ %
%=
%%
%%=
T012 }
case s[i] of
'=': begin
inc(i, 1);
append(ASREMS, 0, lineNumber, lexemeStart - lineStart);
end;
'%': begin
if s[i + 1] = '=' then begin
inc(i, 2);
append(ASREMU, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 1);
append(SREMU, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SREMS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'&': begin
{ &
&=
&&
T01 }
case s[i] of
'=': begin
inc(i, 1);
append(ASANDB, 0, lineNumber, lexemeStart - lineStart);
end;
'&': begin
inc(i, 1);
append(SANDL, 0, lineNumber, lexemeStart - lineStart);
end;
else
append(SANDB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'''': begin
c := s[i];
inc(i);
if c = '\' then begin
case s[i] of
'0': begin
inc(i);
append(NUM_INT, ints.indexAcquire($0000),
lineNumber, lexemeStart - lineStart);
end;
'b': begin
inc(i);
append(NUM_INT, ints.indexAcquire($0008),
lineNumber, lexemeStart - lineStart);
end;
't': begin
inc(i);
append(NUM_INT, ints.indexAcquire($0009),
lineNumber, lexemeStart - lineStart);
end;
'n': begin
inc(i);
append(NUM_INT, ints.indexAcquire($000a),
lineNumber, lexemeStart - lineStart);
end;
'f': begin
inc(i);
append(NUM_INT, ints.indexAcquire($000c),
lineNumber, lexemeStart - lineStart);
end;
'r': begin
inc(i);
append(NUM_INT, ints.indexAcquire($000d),
lineNumber, lexemeStart - lineStart);
end;
'"': begin
inc(i);
append(NUM_INT, ints.indexAcquire(int('"')),
lineNumber, lexemeStart - lineStart);
end;
'''': begin
inc(i);
append(NUM_INT, ints.indexAcquire(int('''')),
lineNumber, lexemeStart - lineStart);
end;
'\': begin
inc(i);
append(NUM_INT, ints.indexAcquire(int('\')),
lineNumber, lexemeStart - lineStart);
end;
'u': begin
inc(i);
order := 0;
for j := 3 downto 0 do begin
c := s[i];
case c of
'0'..'9': begin
order := order + ((int(c) - int('0')) shl (j shl 2));
end;
'A'..'F': begin
order := order + ((int(c) - (int('A') - $0a)) shl (j shl 2));
end;
'a'..'f': begin
order := order + ((int(c) - (int('a') - $0a)) shl (j shl 2));
end;
else
raise CompileError.create(msgErrorInCharConstant, self,
lineNumber, i - lineStart);
end;
inc(i);
end;
append(NUM_INT, ints.indexAcquire(order),
lineNumber, lexemeStart - lineStart);
end;
else
raise CompileError.create(msgErrorInCharConstant, self,
lineNumber, i - lineStart);
end;
end else begin
if c = '''' then begin
dec(i);
raise CompileError.create(msgErrorInCharConstant, self,
lineNumber, i - lineStart);
end;
append(NUM_INT, ints.indexAcquire(int(c)),
lineNumber, lexemeStart - lineStart);
end;
if s[i] = '''' then begin
inc(i);
end else begin
raise CompileError.create(msgErrorInCharConstant, self,
lineNumber, i - lineStart);
end;
end;
'(': begin
append(OPENED_PARENTHESIS, 0, lineNumber, lexemeStart - lineStart);
end;
')': begin
append(CLOSED_PARENTHESIS, 0, lineNumber, lexemeStart - lineStart);
end;
'*': begin
{ *
*=
****
****=
***^
***^=
***|
***|=
**..**
**..**=
**..*^
**..*^=
**..*|
**..*|=
T0123456 }
case s[i] of
'=': begin
inc(i, 1);
append(ASMULL, 0, lineNumber, lexemeStart - lineStart);
end;
'*': begin
case s[i + 1] of
'*': begin
case s[i + 2] of
'*': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQMULL, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'^': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQMULH, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QMULH, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQMULHS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QMULHS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '*') then begin
case s[i + 4] of
'*': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOMULL, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'^': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOMULH, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OMULH, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOMULHS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OMULHS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
append(SMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SMULL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'+': begin
{ +
+=
++
++++
++++=
+++|
+++|=
+++#
+++#=
++..++
++..++=
++..+|
++..+|=
++..+#
++..+#=
T0123456 }
case s[i] of
'=': begin
inc(i, 1);
append(ASPLUS, 0, lineNumber, lexemeStart - lineStart);
end;
'+': begin
case s[i + 1] of
'+': begin
case s[i + 2] of
'+': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQADD, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QADD, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQADDS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QADDS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'#': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQADDUS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QADDUS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(INCR, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '+') then begin
case s[i + 4] of
'+': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOADD, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OADD, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOADDS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OADDS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'#': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOADDUS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OADDUS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(INCR, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(INCR, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(INCR, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SPLUS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
',': begin
append(COMMA, 0, lineNumber, lexemeStart - lineStart);
end;
'-': begin
{ -
-=
--
----
----=
---|
---|=
---#
---#=
--..--
--..--=
--..-|
--..-|=
--..-#
--..-#=
T0123456 }
case s[i] of
'=': begin
inc(i, 1);
append(ASMINUS, 0, lineNumber, lexemeStart - lineStart);
end;
'-': begin
case s[i + 1] of
'-': begin
case s[i + 2] of
'-': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQSUB, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QSUB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQSUBS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QSUBS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'#': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQSUBUS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QSUBUS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(DECR, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '-') then begin
case s[i + 4] of
'-': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOSUB, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OSUB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOSUBS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OSUBS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'#': begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOSUBUS, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OSUBUS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(DECR, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(DECR, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(DECR, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SMINUS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.', '0'..'9': begin
d := s[i];
if (c = '.') and ((d < '0') or (d > '9')) then begin
append(PERIOD, 0, lineNumber, lexemeStart - lineStart);
continue;
end;
if (c = '0') and ((d = 'X') or (d = 'x')) then begin
inc(i);
c := s[i];
if ((c < '0') or (c > '9')) and ((c < 'a') or (c > 'f')) and
((c < 'A') or (c > 'F')) then begin
raise CompileError.create(msgIllegalCharacter, self,
lineNumber, i - lineStart);
end;
x := 0.0;
repeat
case c of
'0'..'9': begin
x := 16.0 * x + (int(c) - int('0'));
end;
'A'..'F': begin
x := 16.0 * x + (int(c) - (int('A') - $0a));
end;
'a'..'f': begin
x := 16.0 * x + (int(c) - (int('a') - $0a));
end;
else
break;
end;
inc(i);
c := s[i];
until false;
order := realExtractExponent(x);
if (c = 'L') or (c = 'l') then begin
inc(i);
if order >= $403f then begin
raise CompileError.create(msgErrorInLongConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_LONG, longs.indexAcquire(
realExtractSignificand(x) shr ($403e - order)),
lineNumber, lexemeStart - lineStart);
end else begin
if order >= $401f then begin
raise CompileError.create(msgErrorInIntConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_INT, ints.indexAcquire(int(
realExtractSignificand(x) shr ($403e - order))),
lineNumber, lexemeStart - lineStart);
end;
end else begin
dec(i);
x := 0.0;
fraction := false;
fracLength := 0;
repeat
case c of
'.': begin
fraction := true;
end;
'0'..'9': begin
x := 10.0 * x + (int(c) - int('0'));
if fraction then begin
inc(fracLength);
end;
end;
else
break;
end;
inc(i);
c := s[i];
until false;
hasorder := false;
order := 0;
if (c = 'E') or (c = 'e') then begin
hasorder := true;
inc(i);
c := s[i];
if c = '-' then begin
inc(i);
c := s[i];
negative := true;
end else begin
if c = '+' then begin
inc(i);
c := s[i];
end;
negative := false;
end;
if (c < '0') or (c > '9') then begin
raise CompileError.create(msgIllegalCharacter, self,
lineNumber, i - lineStart);
end;
repeat
case c of
'0'..'9': begin
order := 10 * order + (int(c) - int('0'));
if order >= 10000 then begin
raise CompileError.create(msgIllegalCharacter, self,
lineNumber, i - lineStart);
end;
end;
else
break;
end;
inc(i);
c := s[i];
until false;
if negative then begin
order := -order;
end;
end;
x := RealValueRepresenter.pow10(x, order - fracLength);
order := realExtractExponent(x);
case c of
'L', 'l': begin
inc(i);
if hasorder or fraction or (order >= $403f) then begin
raise CompileError.create(msgErrorInLongConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_LONG, longs.indexAcquire(
realExtractSignificand(x) shr ($403e - order)),
lineNumber, lexemeStart - lineStart);
end;
'F', 'f': begin
inc(i);
x := realToFloat(x);
if realIsInfinity(x) then begin
raise CompileError.create(msgErrorInFloatConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_FLOAT, reals.indexAcquire(x),
lineNumber, lexemeStart - lineStart);
end;
'D', 'd': begin
inc(i);
x := realToDouble(x);
if realIsInfinity(x) then begin
raise CompileError.create(msgErrorInDoubleConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_DOUBLE, reals.indexAcquire(x),
lineNumber, lexemeStart - lineStart);
end;
'R', 'r': begin
inc(i);
if realIsInfinity(x) then begin
raise CompileError.create(msgErrorInRealConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_REAL, reals.indexAcquire(x),
lineNumber, lexemeStart - lineStart);
end;
else
if hasorder or fraction then begin
if realIsInfinity(x) then begin
raise CompileError.create(msgErrorInRealConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_REAL, reals.indexAcquire(x),
lineNumber, lexemeStart - lineStart);
end else begin
if order >= $401f then begin
raise CompileError.create(msgErrorInIntConstant, self,
lineNumber, lexemeStart - lineStart);
end;
append(NUM_INT, ints.indexAcquire(int(
realExtractSignificand(x) shr ($403e - order))),
lineNumber, lexemeStart - lineStart);
end;
end;
end;
end;
'/': begin
{ /
/=
//
//=
////
////=
/* ... */
T01234 }
case s[i] of
'*': begin
{ начало считывания комментария }
if placeComments then begin
append(COMMENT, -1, lineNumber, lexemeStart - lineStart);
end;
inc(i);
repeat
c := s[i];
inc(i);
case c of
#$0000: begin
addLine(lineStart + 1, i - lineStart - 2);
goto label1;
end;
#$0001..#$0020: begin
if (c = #$000d) and (s[i] = #$000a) then begin
addLine(lineStart + 1, i - lineStart - 2);
inc(i);
inc(lineNumber);
lineStart := i - 1;
continue;
end;
if (c = #$000d) or (c = #$000a) then begin
addLine(lineStart + 1, i - lineStart - 2);
inc(lineNumber);
lineStart := i - 1;
continue;
end;
end;
'*': begin
if s[i] = '/' then begin
inc(i);
break;
end;
end;
end;
until false;
{ конец считывания комментария }
end;
'=': begin
inc(i, 1);
append(ASDIVS, 0, lineNumber, lexemeStart - lineStart);
end;
'/': begin
case s[i + 1] of
'=': begin
inc(i, 2);
append(ASDIVU, 0, lineNumber, lexemeStart - lineStart);
end;
'/': begin
if s[i + 2] = '/' then begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQDIV, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QDIV, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SDIVU, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SDIVU, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SDIVS, 0, lineNumber, lexemeStart - lineStart);
end;
end;
':': begin
append(COLON, 0, lineNumber, lexemeStart - lineStart);
end;
';': begin
append(SEMICOLON, 0, lineNumber, lexemeStart - lineStart);
end;
'<': begin
{ <
<=
<=||
<=||=
<=|..|
<=|..|=
<<
<<=
<<<<
<<<<=
<<..<<
<<..<<=
<<||
<<||=
<<|..|
<<|..|=
T0123456 }
case s[i] of
'=': begin
if s[i + 1] = '|' then begin
case s[i + 2] of
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQLE, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QLE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 3] = '.') and (s[i + 4] = '|') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOLE, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OLE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SLE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SLE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SLE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'<': begin
case s[i + 1] of
'=': begin
inc(i, 2);
append(ASSLL, 0, lineNumber, lexemeStart - lineStart);
end;
'<': begin
if s[i + 2] = '<' then begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQSLL, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '<') and (s[i + 4] = '<') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOSLL, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
case s[i + 2] of
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQLT, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QLT, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 3] = '.') and (s[i + 4] = '|') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOLT, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OLT, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SSLL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SLT, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'=': begin
{ =
==
==||
==||=
==|..|
==|..|=
T0123456 }
if s[i] = '='then begin
if s[i + 1] = '|' then begin
case s[i + 2] of
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQEQ, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QEQ, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 3] = '.') and (s[i + 4] = '|') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOEQ, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OEQ, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SEQ, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SEQ, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SEQ, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
append(ASSIGN, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'>': begin
{ >
>=
>=||
>=||=
>=|..|
>=|..|=
>>
>>=
>>>
>>>=
>>>>
>>>>=
>>>>>
>>>>>=
>>..>>
>>..>>=
>>..>>>
>>..>>>=
>>||
>>||=
>>|..|
>>|..|=
T01234567 }
case s[i] of
'=': begin
if s[i + 1] = '|' then begin
case s[i + 2] of
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQGE, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QGE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 3] ='.') and (s[i + 4] = '|') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOGE, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OGE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SGE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SGE, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SGE, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'>': begin
case s[i + 1] of
'=': begin
inc(i, 2);
append(ASSRA, 0, lineNumber, lexemeStart - lineStart);
end;
'>': begin
case s[i + 2] of
'=': begin
inc(i, 3);
append(ASSRL, 0, lineNumber, lexemeStart - lineStart);
end;
'>': begin
case s[i + 3] of
'=': begin
inc(i, 4);
append(AQSRA, 0, lineNumber, lexemeStart - lineStart);
end;
'>': begin
if s[i + 4] = '=' then begin
inc(i, 5);
append(AQSRL, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 4);
append(QSRL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 3);
append(QSRA, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 2);
append(SSRL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '>') and (s[i + 4] = '>') then begin
case s[i + 5] of
'=': begin
inc(i, 6);
append(AOSRA, 0, lineNumber, lexemeStart - lineStart);
end;
'>': begin
if s[i + 6] = '=' then begin
inc(i, 7);
append(AOSRL, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 6);
append(OSRL, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 5);
append(OSRA, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SSRA, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'|': begin
case s[i + 2] of
'|': begin
if s[i + 3] = '=' then begin
inc(i, 4);
append(AQGT, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 3);
append(QGT, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 3] = '.') and (s[i + 4] = '|') then begin
if s[i + 5] = '=' then begin
inc(i, 6);
append(AOGT, 0, lineNumber, lexemeStart - lineStart);
end else begin
inc(i, 5);
append(OGT, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
inc(i, 1);
append(SSRA, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SSRA, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
inc(i, 1);
append(SSRA, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SGT, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'?': begin
append(QUESTION_MARK, 0, lineNumber, lexemeStart - lineStart);
end;
'@': begin
{ @@@@
@@..@@
T012345 }
if s[i] = '@' then begin
case s[i + 1] of
'@': begin
if s[i + 2] = '@' then begin
inc(i, 3);
append(QPACKUS, 0, lineNumber, lexemeStart - lineStart);
end else begin
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '@') and (s[i + 4] = '@') then begin
inc(i, 5);
append(OPACKUS, 0, lineNumber, lexemeStart - lineStart);
end else begin
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end else begin
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'A'..'Z', '_', 'a'..'z': begin
repeat
c := s[i];
if ((c < '0') or (c > '9')) and ((c < 'A') or (c > 'Z')) and
(c <> '_') and ((c < 'a') or (c > 'z')) then begin
break;
end;
inc(i);
until false;
str := copy(sourceCode, lexemeStart + 1, i - lexemeStart);
for j := length(KEYWORDS) - 1 downto 0 do begin
if KEYWORDS[j] = str then begin
append(j + KW_NULL, 0, lineNumber, lexemeStart - lineStart);
goto label0;
end;
end;
append(IDENTIFIER, strs.indexAcquire(str), lineNumber, lexemeStart - lineStart);
label0:
end;
'[': begin
append(OPENED_SQUARE_BRACKET, 0, lineNumber, lexemeStart - lineStart);
end;
']': begin
append(CLOSED_SQUARE_BRACKET, 0, lineNumber, lexemeStart - lineStart);
end;
'^': begin
{ ^
^=
^^^^
^^..^^
T012345 }
case s[i] of
'=': begin
inc(i, 1);
append(ASXORB, 0, lineNumber, lexemeStart - lineStart);
end;
'^': begin
case s[i + 1] of
'^': begin
if s[i + 2] = '^' then begin
inc(i, 3);
append(QUNPCKH, 0, lineNumber, lexemeStart - lineStart);
end else begin
append(SXORB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'.': begin
if (s[i + 2] = '.') and (s[i + 3] = '^') and (s[i + 4] = '^') then begin
inc(i, 5);
append(OUNPCKH, 0, lineNumber, lexemeStart - lineStart);
end else begin
append(SXORB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SXORB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
else
append(SXORB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'{': begin
append(OPENED_CURLY_BRACKET, 0, lineNumber, lexemeStart - lineStart);
end;
'|': begin
{ |
|=
||
T01 }
case s[i] of
'=': begin
inc(i, 1);
append(ASORB, 0, lineNumber, lexemeStart - lineStart);
end;
'|': begin
inc(i, 1);
append(SORL, 0, lineNumber, lexemeStart - lineStart);
end;
else
append(SORB, 0, lineNumber, lexemeStart - lineStart);
end;
end;
'}': begin
append(CLOSED_CURLY_BRACKET, 0, lineNumber, lexemeStart - lineStart);
end;
'~': begin
append(SNOTB, 0, lineNumber, lexemeStart - lineStart);
end;
else
append(ASM_LEXEME, 0, lineNumber, lexemeStart - lineStart);
end;
until false;
label1:
append(NULL, 0, lineNumber, lexemeStart - lineStart);
self.sourceLines := trimLines();
end;
function TranslatorLexer.getLength(): int;
begin
result := count;
end;
function TranslatorLexer.getLinesCount(): int;
begin
result := length(sourceLines) shr 1;
end;
function TranslatorLexer.getLine(index: int): int;
begin
checkIndex(index);
result := lexemes[index].shorts[3] and $ffff;
end;
function TranslatorLexer.getChar(index: int): int;
begin
checkIndex(index);
result := lexemes[index].shorts[2] and $ffff;
end;
function TranslatorLexer.getType(index: int): int;
begin
checkIndex(index);
result := lexemes[index].shorts[0];
end;
function TranslatorLexer.getValue(index: int): int;
begin
checkIndex(index);
result := lexemes[index].shorts[1] and $ffff;
end;
function TranslatorLexer.getValueInt(index: int): int;
begin
checkIndex(index);
result := poolOfInts.getValue(lexemes[index].shorts[1] and $ffff);
end;
function TranslatorLexer.getValueLong(index: int): int64;
begin
checkIndex(index);
result := poolOfLongs.getValue(lexemes[index].shorts[1] and $ffff);
end;
function TranslatorLexer.getValueReal(index: int): real;
begin
checkIndex(index);
result := poolOfReals.getValue(lexemes[index].shorts[1] and $ffff);
end;
function TranslatorLexer.getValueAString(index: int): AnsiString;
begin
checkIndex(index);
result := stringToUTF8(poolOfStrings.getValue(lexemes[index].shorts[1] and $ffff));
end;
function TranslatorLexer.getValueUString(index: int): UnicodeString;
begin
checkIndex(index);
result := poolOfStrings.getValue(lexemes[index].shorts[1] and $ffff);
end;
function TranslatorLexer.getPoolOfInt(): PoolInt;
begin
result := poolOfInts;
end;
function TranslatorLexer.getPoolOfLong(): PoolLong;
begin
result := poolOfLongs;
end;
function TranslatorLexer.getPoolOfReal(): PoolReal;
begin
result := poolOfReals;
end;
function TranslatorLexer.getPoolOfString(): PoolString;
begin
result := poolOfStrings;
end;
function TranslatorLexer.getSourceName(): UnicodeString;
begin
result := sourceName;
end;
function TranslatorLexer.getSourceCode(): UnicodeString;
begin
result := sourceCode;
end;
function TranslatorLexer.getSourceLine(index: int): UnicodeString;
var
strs: int_Array1d;
begin
strs := sourceLines;
if (index <= 0) or (index > length(strs) shr 1) then begin
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
index := (index - 1) shl 1;
result := stringTrim(copy(sourceCode, strs[index] + 1, strs[index + 1]));
end;
function TranslatorLexer.getSourceFragment(beginLine, beginChar,
endLine, endChar: int): UnicodeString;
var
beginIndex: int;
endIndex: int;
begin
beginIndex := getIndex(beginLine, beginChar);
endIndex := getIndex(endLine, endChar);
result := stringTrim(copy(sourceCode, beginIndex + 1, endIndex - beginIndex));
end;
function TranslatorLexer.lexemeToString(index: int): UnicodeString;
var
lexeme: int;
lexType: int;
lexValue: int;
begin
checkIndex(index);
lexeme := int(lexemes[index]);
lexType := short(lexeme);
lexValue := (lexeme shr 16) and $ffff;
case lexType of
KW_NULL..KW_FVECTOR:
result := KEYWORDS[lexType - KW_NULL];
IDENTIFIER:
result := 'ID ' + poolOfStrings.getValue(lexValue);
NUM_INT:
result := '0x' + stringToUTF16(intToHexString(poolOfInts.getValue(lexValue)));
NUM_LONG:
result := '0x' + stringToUTF16(longToHexString(poolOfLongs.getValue(lexValue))) + 'L';
NUM_FLOAT:
result := stringToUTF16(realToString(poolOfReals.getValue(lexValue))) + 'F';
NUM_DOUBLE:
result := stringToUTF16(realToString(poolOfReals.getValue(lexValue))) + 'D';
NUM_REAL:
result := stringToUTF16(realToString(poolOfReals.getValue(lexValue))) + 'R';
STRING_LITERAL:
result := '"' + poolOfStrings.getValue(lexValue) + '"';
ASM_LEXEME:
result := 'ASM LEXEME';
COMMENT:
result := '/* COMMENT */';
NULL:
result := 'NULL';
COMMA:
result := ',';
COLON:
result := ':';
SEMICOLON:
result := ';';
QUESTION_MARK:
result := '?';
OPENED_CURLY_BRACKET:
result := '{';
OPENED_PARENTHESIS:
result := '(';
OPENED_SQUARE_BRACKET:
result := '[';
CLOSED_CURLY_BRACKET:
result := '}';
CLOSED_PARENTHESIS:
result := ')';
CLOSED_SQUARE_BRACKET:
result := ']';
INCR:
result := '++';
DECR:
result := '--';
PERIOD:
result := '.';
SNOTB:
result := '~';
SANDB:
result := '&';
SORB:
result := '|';
SXORB:
result := '^';
SNOTL:
result := '!';
SANDL:
result := '&&';
SORL:
result := '||';
SMULL:
result := '*';
SDIVS:
result := '/';
SREMS:
result := '%';
SDIVU:
result := '//';
SREMU:
result := '%%';
SPLUS:
result := '+';
SMINUS:
result := '-';
SSRA:
result := '>>';
SSRL:
result := '>>>';
SSLL:
result := '<<';
SGT:
result := '>';
SGE:
result := '>=';
SLT:
result := '<';
SLE:
result := '<=';
SEQ:
result := '==';
SNE:
result := '!=';
QPACKUS:
result := '@@@@';
QUNPCKL:
result := '####';
QUNPCKH:
result := '^^^^';
QMULL:
result := '****';
QMULH:
result := '***^';
QMULHS:
result := '***|';
QDIV:
result := '////';
QADD:
result := '++++';
QADDS:
result := '+++|';
QADDUS:
result := '+++#';
QSUB:
result := '----';
QSUBS:
result := '---|';
QSUBUS:
result := '---#';
QSRA:
result := '>>>>';
QSRL:
result := '>>>>>';
QSLL:
result := '<<<<';
QGT:
result := '>>||';
QGE:
result := '>=||';
QLT:
result := '<<||';
QLE:
result := '<=||';
QEQ:
result := '==||';
QNE:
result := '!=||';
OPACKUS:
result := '@@..@@';
OUNPCKL:
result := '##..##';
OUNPCKH:
result := '^^..^^';
OMULL:
result := '**..**';
OMULH:
result := '**..*^';
OMULHS:
result := '**..*|';
OADD:
result := '++..++';
OADDS:
result := '++..+|';
OADDUS:
result := '++..+#';
OSUB:
result := '--..--';
OSUBS:
result := '--..-|';
OSUBUS:
result := '--..-#';
OSRA:
result := '>>..>>';
OSRL:
result := '>>..>>>';
OSLL:
result := '<<..<<';
OGT:
result := '>>|..|';
OGE:
result := '>=|..|';
OLT:
result := '<<|..|';
OLE:
result := '<=|..|';
OEQ:
result := '==|..|';
ONE:
result := '!=|..|';
ASSIGN:
result := '=';
ASANDB:
result := '&=';
ASORB:
result := '|=';
ASXORB:
result := '^=';
ASMULL:
result := '*=';
ASDIVS:
result := '/=';
ASREMS:
result := '%=';
ASDIVU:
result := '//=';
ASREMU:
result := '%%=';
ASPLUS:
result := '+=';
ASMINUS:
result := '-=';
ASSRA:
result := '>>=';
ASSRL:
result := '>>>=';
ASSLL:
result := '<<=';
AQMULL:
result := '****=';
AQMULH:
result := '***^=';
AQMULHS:
result := '***|=';
AQDIV:
result := '////=';
AQADD:
result := '++++=';
AQADDS:
result := '+++|=';
AQADDUS:
result := '+++#=';
AQSUB:
result := '----=';
AQSUBS:
result := '---|=';
AQSUBUS:
result := '---#=';
AQSRA:
result := '>>>>=';
AQSRL:
result := '>>>>>=';
AQSLL:
result := '<<<<=';
AQGT:
result := '>>||=';
AQGE:
result := '>=||=';
AQLT:
result := '<<||=';
AQLE:
result := '<=||=';
AQEQ:
result := '==||=';
AQNE:
result := '!=||=';
AOMULL:
result := '**..**=';
AOMULH:
result := '**..*^=';
AOMULHS:
result := '**..*|=';
AOADD:
result := '++..++=';
AOADDS:
result := '++..+|=';
AOADDUS:
result := '++..+#=';
AOSUB:
result := '--..--=';
AOSUBS:
result := '--..-|=';
AOSUBUS:
result := '--..-#=';
AOSRA:
result := '>>..>>=';
AOSRL:
result := '>>..>>>=';
AOSLL:
result := '<<..<<=';
AOGT:
result := '>>|..|=';
AOGE:
result := '>=|..|=';
AOLT:
result := '<<|..|=';
AOLE:
result := '<=|..|=';
AOEQ:
result := '==|..|=';
AONE:
result := '!=|..|=';
else
result := '';
end;
end;
function TranslatorLexer.createPoolOfInt(): PoolInt;
begin
result := TranslatorPoolInt.create();
end;
function TranslatorLexer.createPoolOfLong(): PoolLong;
begin
result := TranslatorPoolLong.create();
end;
function TranslatorLexer.createPoolOfReal(): PoolReal;
begin
result := TranslatorPoolReal.create();
end;
function TranslatorLexer.createPoolOfString(): PoolString;
begin
result := TranslatorPoolString.create();
end;
procedure TranslatorLexer.checkIndex(index: int);
begin
if (index < 0) or (index >= count) then begin
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
end;
function TranslatorLexer.getIndex(line, char: int): int;
var
strs: int_Array1d;
begin
strs := sourceLines;
if (line <= 0) or (line > length(strs) shr 1) then begin
raise IndexOutOfBoundsException.create(msgIndexOutOfBounds);
end;
line := (line - 1) shl 1;
result := strs[line] + (char - 1);
end;
initialization
TranslatorLexer.clinit();
finalization
TranslatorLexer.cldone();
end.
