mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 11:09:13 +02:00
* synchronized with trunk
git-svn-id: branches/wasm@46970 -
This commit is contained in:
nickysn
commit
114d0d738b
@ -464,8 +464,8 @@ Unit AoptObj;
|
||||
|
||||
function JumpTargetOp(ai: taicpu): poper; inline;
|
||||
begin
|
||||
{$if defined(MIPS) or defined(riscv64) or defined(riscv32)}
|
||||
{ MIPS or RiscV branches can have 1,2 or 3 operands, target label is the last one. }
|
||||
{$if defined(MIPS) or defined(riscv64) or defined(riscv32) or defined(xtensa)}
|
||||
{ MIPS, Xtensa or RiscV branches can have 1,2 or 3 operands, target label is the last one. }
|
||||
result:=ai.oper[ai.ops-1];
|
||||
{$elseif defined(SPARC64)}
|
||||
if ai.ops=2 then
|
||||
@ -1644,6 +1644,11 @@ Unit AoptObj;
|
||||
p.loadreg(0, NR_X0);
|
||||
p.ops:=2;
|
||||
{$endif}
|
||||
{$ifdef xtensa}
|
||||
p.opcode := aopt_uncondjmp;
|
||||
p.loadoper(0, p.oper[p.ops-1]^);
|
||||
p.ops:=1;
|
||||
{$endif}
|
||||
{$endif not avr}
|
||||
{$ifdef mips}
|
||||
{ MIPS conditional jump instructions also conntain register
|
||||
|
||||
@ -4626,6 +4626,16 @@ begin
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$if defined(xtensa)}
|
||||
{ it is determined during system unit compilation if nsau is used for bsr or not,
|
||||
this is not perfect but the current implementation bsf/bsr does not allow another
|
||||
solution }
|
||||
if CPUXTENSA_HAS_NSAx in cpu_capabilities[init_settings.cputype] then
|
||||
begin
|
||||
def_system_macro('FPC_HAS_INTERNAL_BSR');
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
{$if defined(powerpc64)}
|
||||
{ on sysv targets, default to elfv2 for little endian and to elfv1 for
|
||||
big endian (unless specified otherwise). As the gcc man page says:
|
||||
|
||||
@ -1115,13 +1115,13 @@ begin
|
||||
writeln(t,' "COMPONENT_KCONFIGS_PROJBUILD": "Kconfig.projbuild",');
|
||||
writeln(t,' "IDF_CMAKE": "y",');
|
||||
writeln(t,' "IDF_TARGET": "esp32",');
|
||||
writeln(t,' "IDF_PATH": "'+idfpath+'",');
|
||||
writeln(t,' "IDF_PATH": "'+TargetFixPath(idfpath,false)+'",');
|
||||
writeln(t,' "COMPONENT_KCONFIGS_SOURCE_FILE": "kconfigs.in",');
|
||||
writeln(t,' "COMPONENT_KCONFIGS_PROJBUILD_SOURCE_FILE": "kconfigs_projbuild.in"');
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln(t,' "IDF_PATH": "'+idfpath+'",');
|
||||
writeln(t,' "IDF_PATH": "'+TargetFixPath(idfpath,false)+'",');
|
||||
writeln(t,' "IDF_TARGET": "esp8266",');
|
||||
writeln(t,' "IDF_CMAKE": "n"');
|
||||
end;
|
||||
@ -1161,9 +1161,17 @@ begin
|
||||
success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,true);
|
||||
|
||||
{ generate linker maps }
|
||||
binstr:='$IDF_PATH/tools/ldgen/ldgen.py';
|
||||
{$ifdef UNIX}
|
||||
binstr:=TargetFixPath(idfpath,false)+'/tools/ldgen/ldgen.py';
|
||||
{$else}
|
||||
binstr:='python';
|
||||
{$endif UNIX}
|
||||
if source_info.exeext<>'' then
|
||||
binstr:=binstr+source_info.exeext;
|
||||
S:=FindUtil(utilsprefix+'objdump');
|
||||
if (current_settings.controllertype = ct_esp32) then
|
||||
cmdstr:='--config sdkconfig '+
|
||||
cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
|
||||
'--config sdkconfig '+
|
||||
'--fragments $IDF_PATH/components/xtensa/linker.lf $IDF_PATH/components/soc/linker.lf $IDF_PATH/components/esp_event/linker.lf '+
|
||||
'$IDF_PATH/components/spi_flash/linker.lf $IDF_PATH/components/esp_wifi/linker.lf $IDF_PATH/components/lwip/linker.lf '+
|
||||
'$IDF_PATH/components/heap/linker.lf $IDF_PATH/components/esp_ringbuf/linker.lf $IDF_PATH/components/espcoredump/linker.lf $IDF_PATH/components/esp32/linker.lf '+
|
||||
@ -1174,9 +1182,10 @@ begin
|
||||
'--kconfig $IDF_PATH/Kconfig '+
|
||||
'--env-file config.env '+
|
||||
'--libraries-file ldgen_libraries '+
|
||||
'--objdump xtensa-esp32-elf-objdump'
|
||||
'--objdump '+S
|
||||
else
|
||||
cmdstr:='--config sdkconfig '+
|
||||
cmdstr:={$ifndef UNIX}'$IDF_PATH/tools/ldgen/ldgen.py '+{$endif UNIX}
|
||||
'--config sdkconfig '+
|
||||
'--fragments $IDF_PATH/components/esp8266/ld/esp8266_fragments.lf '+
|
||||
'$IDF_PATH/components/esp8266/ld/esp8266_bss_fragments.lf $IDF_PATH/components/esp8266/linker.lf '+
|
||||
'$IDF_PATH/components/freertos/linker.lf $IDF_PATH/components/log/linker.lf '+
|
||||
@ -1191,9 +1200,8 @@ begin
|
||||
'--kconfig $IDF_PATH/Kconfig '+
|
||||
'--env-file config.env '+
|
||||
'--libraries-file ldgen_libraries '+
|
||||
'--objdump xtensa-lx106-elf-objdump';
|
||||
'--objdump '+S;
|
||||
|
||||
Replace(binstr,'$IDF_PATH',idfpath);
|
||||
Replace(cmdstr,'$IDF_PATH',idfpath);
|
||||
if success and not(cs_link_nolink in current_settings.globalswitches) then
|
||||
success:=DoExec(binstr,cmdstr,true,false);
|
||||
@ -1262,10 +1270,18 @@ begin
|
||||
{$ifdef XTENSA}
|
||||
if success then
|
||||
begin
|
||||
binstr:=idfpath+'/components/esptool_py/esptool/esptool.py';
|
||||
{$ifdef UNIX}
|
||||
binstr:=TargetFixPath(idfpath,false)+'/components/esptool_py/esptool/esptool.py';
|
||||
cmdstr:='';
|
||||
{$else}
|
||||
binstr:='python';
|
||||
cmdstr:=idfpath+'/components/esptool_py/esptool/esptool.py ';
|
||||
{$endif UNIX}
|
||||
if source_info.exeext<>'' then
|
||||
binstr:=binstr+source_info.exeext;
|
||||
if (current_settings.controllertype = ct_esp32) then
|
||||
begin
|
||||
success:=DoExec(binstr,'--chip esp32 elf2image --flash_mode dio --flash_freq 40m '+
|
||||
success:=DoExec(binstr,cmdstr+'--chip esp32 elf2image --flash_mode dio --flash_freq 40m '+
|
||||
'--flash_size '+tostr(embedded_controllers[current_settings.controllertype].flashsize div (1024*1024))+'MB '+
|
||||
'--elf-sha256-offset 0xb0 '+
|
||||
'-o '+maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.bin')))+' '+
|
||||
@ -1274,7 +1290,7 @@ begin
|
||||
end
|
||||
else if (current_settings.controllertype = ct_esp8266) then
|
||||
begin
|
||||
success:=DoExec(binstr,'--chip esp8266 elf2image --flash_mode dout --flash_freq 40m '+
|
||||
success:=DoExec(binstr,cmdstr+'--chip esp8266 elf2image --flash_mode dout --flash_freq 40m '+
|
||||
'--flash_size '+tostr(embedded_controllers[current_settings.controllertype].flashsize div (1024*1024))+'MB '+
|
||||
'--version=3 '+
|
||||
'-o '+maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename,'.bin')))+' '+
|
||||
|
||||
@ -69,6 +69,8 @@ interface
|
||||
procedure a_cmp_reg_reg_label(list: TAsmList; size: tcgsize; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel);override;
|
||||
procedure a_jmp_always(list: TAsmList; l: TAsmLabel);override;
|
||||
|
||||
procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: TCGSize; src, dst: TRegister);override;
|
||||
|
||||
procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister);override;
|
||||
|
||||
procedure g_concatcopy(list : TAsmList; const source,dest : treference; len : tcgint);override;
|
||||
@ -621,6 +623,7 @@ implementation
|
||||
begin
|
||||
instr:=taicpu.op_reg_sym(A_B,f.register,l);
|
||||
instr.condition:=flags_to_cond(f.flag);
|
||||
instr.is_jmp:=true;
|
||||
list.concat(instr);
|
||||
end
|
||||
else
|
||||
@ -905,6 +908,7 @@ implementation
|
||||
end;
|
||||
instr:=taicpu.op_reg_sym(A_B,reg,l);
|
||||
instr.condition:=op;
|
||||
instr.is_jmp:=true;
|
||||
list.concat(instr);
|
||||
end
|
||||
else if is_b4const(a) and
|
||||
@ -921,6 +925,7 @@ implementation
|
||||
|
||||
instr:=taicpu.op_reg_const_sym(A_B,reg,a,l);
|
||||
instr.condition:=op;
|
||||
instr.is_jmp:=true;
|
||||
list.concat(instr);
|
||||
end
|
||||
else if is_b4constu(a) and
|
||||
@ -935,6 +940,7 @@ implementation
|
||||
|
||||
instr:=taicpu.op_reg_const_sym(A_B,reg,a,l);
|
||||
instr.condition:=op;
|
||||
instr.is_jmp:=true;
|
||||
list.concat(instr);
|
||||
end
|
||||
else
|
||||
@ -958,6 +964,7 @@ implementation
|
||||
|
||||
instr:=taicpu.op_reg_reg_sym(A_B,reg2,reg1,l);
|
||||
instr.condition:=TOpCmp2AsmCond[cmp_op];
|
||||
instr.is_jmp:=true;
|
||||
list.concat(instr);
|
||||
end;
|
||||
|
||||
@ -1265,6 +1272,28 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure tcgcpu.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; srcsize, dstsize: TCGSize; src, dst: TRegister);
|
||||
var
|
||||
ai: taicpu;
|
||||
tmpreg: TRegister;
|
||||
begin
|
||||
if reverse then
|
||||
begin
|
||||
list.Concat(taicpu.op_reg_reg(A_NSAU,dst,src));
|
||||
tmpreg:=getintregister(list,OS_INT);
|
||||
a_load_const_reg(list,OS_INT,31,tmpreg);
|
||||
a_op_reg_reg_reg(list,OP_SUB,OS_INT,dst,tmpreg,dst);
|
||||
tmpreg:=getintregister(list,OS_INT);
|
||||
a_load_const_reg(list,OS_INT,255,tmpreg);
|
||||
ai:=taicpu.op_reg_reg_reg(A_MOV,dst,tmpreg,src);
|
||||
ai.condition:=C_EQZ;
|
||||
list.Concat(ai);
|
||||
end
|
||||
else
|
||||
Internalerror(2020092604);
|
||||
end;
|
||||
|
||||
|
||||
procedure tcg64fxtensa.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
|
||||
var
|
||||
instr: taicpu;
|
||||
|
||||
@ -137,6 +137,7 @@ Const
|
||||
(
|
||||
CPUXTENSA_REGWINDOW,
|
||||
CPUXTENSA_HAS_SEXT,
|
||||
CPUXTENSA_HAS_NSAx,
|
||||
CPUXTENSA_HAS_BOOLEAN_OPTION,
|
||||
CPUXTENSA_HAS_MUL32HIGH,
|
||||
CPUXTENSA_HAS_DIV,
|
||||
@ -154,7 +155,7 @@ Const
|
||||
(
|
||||
{ cpu_none } [],
|
||||
{ cpu_lx106 } [],
|
||||
{ cpu_lx6 } [CPUXTENSA_REGWINDOW, CPUXTENSA_HAS_SEXT, CPUXTENSA_HAS_BOOLEAN_OPTION, CPUXTENSA_HAS_MUL32HIGH, CPUXTENSA_HAS_DIV, CPUXTENSA_HAS_LOOPS]
|
||||
{ cpu_lx6 } [CPUXTENSA_REGWINDOW, CPUXTENSA_HAS_SEXT, CPUXTENSA_HAS_NSAx, CPUXTENSA_HAS_BOOLEAN_OPTION, CPUXTENSA_HAS_MUL32HIGH, CPUXTENSA_HAS_DIV, CPUXTENSA_HAS_LOOPS]
|
||||
);
|
||||
|
||||
fpu_capabilities : array[tfputype] of set of tfpuflags =
|
||||
|
||||
@ -33,6 +33,8 @@ interface
|
||||
protected
|
||||
function first_real_to_real: tnode;override;
|
||||
procedure second_int_to_bool;override;
|
||||
procedure second_int_to_real;override;
|
||||
function first_int_to_real: tnode;override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -67,7 +69,7 @@ implementation
|
||||
left:=nil;
|
||||
end;
|
||||
else
|
||||
internalerror(200610151);
|
||||
internalerror(2020092603);
|
||||
end;
|
||||
s64real:
|
||||
case tfloatdef(resultdef).floattype of
|
||||
@ -80,10 +82,10 @@ implementation
|
||||
left:=nil;
|
||||
end;
|
||||
else
|
||||
internalerror(200610152);
|
||||
internalerror(2020092602);
|
||||
end;
|
||||
else
|
||||
internalerror(200610153);
|
||||
internalerror(2020092601);
|
||||
end;
|
||||
left:=nil;
|
||||
firstpass(result);
|
||||
@ -94,7 +96,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure tcputypeconvnode.second_int_to_bool;
|
||||
var
|
||||
hreg1, onereg: tregister;
|
||||
@ -187,6 +188,41 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function tcputypeconvnode.first_int_to_real: tnode;
|
||||
var
|
||||
fname: string[19];
|
||||
begin
|
||||
if (cs_fp_emulation in current_settings.moduleswitches) or
|
||||
(current_settings.fputype=fpu_soft) or
|
||||
not(FPUXTENSA_SINGLE in fpu_capabilities[current_settings.fputype]) or
|
||||
((is_double(resultdef)) and not(FPUXTENSA_DOUBLE in fpu_capabilities[current_settings.fputype])) or
|
||||
is_64bitint(left.resultdef) or
|
||||
is_currency(left.resultdef) or
|
||||
(is_32bit(left.resultdef) and not(is_signed(left.resultdef))) then
|
||||
result:=inherited first_int_to_real
|
||||
else
|
||||
begin
|
||||
{ other integers are supposed to be 32 bit }
|
||||
inserttypeconv(left,s32inttype);
|
||||
firstpass(left);
|
||||
result:=nil;
|
||||
expectloc:=LOC_FPUREGISTER;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tcputypeconvnode.second_int_to_real;
|
||||
var
|
||||
ai: taicpu;
|
||||
begin
|
||||
location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
|
||||
location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
|
||||
hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,s32inttype,true);
|
||||
ai:=taicpu.op_reg_reg_const(A_FLOAT,location.register,left.location.register,0);
|
||||
ai.oppostfix:=PF_S;
|
||||
current_asmdata.CurrAsmList.concat(ai);
|
||||
end;
|
||||
|
||||
begin
|
||||
ctypeconvnode:=tcputypeconvnode;
|
||||
end.
|
||||
|
||||
@ -19,11 +19,9 @@ unit jsbase;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{$ifdef pas2js}
|
||||
js,
|
||||
{$endif}
|
||||
Classes;
|
||||
{$ifdef pas2js}
|
||||
uses js;
|
||||
{$endif}
|
||||
|
||||
const
|
||||
MinSafeIntDouble = -$1fffffffffffff; // -9007199254740991 53 bits (52 explicitly stored)
|
||||
|
||||
@ -2308,6 +2308,7 @@ type
|
||||
function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
|
||||
function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
|
||||
function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
|
||||
function GetPasClassForward(ClassEl: TPasClassType): TPasClassType;
|
||||
function GetParentProcBody(El: TPasElement): TProcedureBody;
|
||||
function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
|
||||
function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
|
||||
@ -28009,6 +28010,31 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasResolver.GetPasClassForward(ClassEl: TPasClassType): TPasClassType;
|
||||
var
|
||||
Parent: TPasElement;
|
||||
i: Integer;
|
||||
CurClass: TPasClassType;
|
||||
Ref: TResolvedReference;
|
||||
Decls: TFPList;
|
||||
begin
|
||||
Result:=nil;
|
||||
if ClassEl=nil then exit;
|
||||
Parent:=ClassEl.Parent;
|
||||
if not (Parent is TPasDeclarations) then
|
||||
RaiseNotYetImplemented(20200926214106,ClassEl);
|
||||
Decls:=TPasDeclarations(Parent).Classes;
|
||||
for i:=0 to Decls.Count-1 do
|
||||
begin
|
||||
CurClass:=TPasClassType(Decls[i]);
|
||||
if CurClass=ClassEl then exit;
|
||||
if not CurClass.IsForward then continue;
|
||||
Ref:=TResolvedReference(CurClass.CustomData);
|
||||
if Ref.Declaration=ClassEl then
|
||||
exit(TPasClassType(Ref.Declaration));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
|
||||
begin
|
||||
while El<>nil do
|
||||
|
||||
@ -123,11 +123,11 @@ resourcestring
|
||||
SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records';
|
||||
SParserNoFieldsAllowedInX = 'Fields are not allowed in %s';
|
||||
SParserInvalidRecordVisibility = 'Records can only have public and (strict) private as visibility specifiers';
|
||||
SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location.';
|
||||
SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location.';
|
||||
SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location.';
|
||||
SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location.';
|
||||
SErrRecordTypesNotAllowed = 'Record types not allowed at this location.';
|
||||
SErrRecordConstantsNotAllowed = 'Record constants not allowed at this location';
|
||||
SErrRecordVariablesNotAllowed = 'Record variables not allowed at this location';
|
||||
SErrRecordMethodsNotAllowed = 'Record methods not allowed at this location';
|
||||
SErrRecordPropertiesNotAllowed = 'Record properties not allowed at this location';
|
||||
SErrRecordTypesNotAllowed = 'Record types not allowed at this location';
|
||||
SParserTypeNotAllowedHere = 'Type "%s" not allowed here';
|
||||
SParserNotAnOperand = 'Not an operand: (%d : %s)';
|
||||
SParserArrayPropertiesCannotHaveDefaultValue = 'Array properties cannot have default value';
|
||||
|
||||
@ -4196,11 +4196,11 @@ var
|
||||
{$ifdef UsePChar}
|
||||
OldLength: integer;
|
||||
Ch: Char;
|
||||
LE: string[2];
|
||||
{$else}
|
||||
s: string;
|
||||
l: integer;
|
||||
{$endif}
|
||||
LE : String[2];
|
||||
|
||||
procedure FetchCurTokenString; inline;
|
||||
begin
|
||||
@ -4327,7 +4327,7 @@ begin
|
||||
'(':
|
||||
begin
|
||||
Inc(FTokenPos);
|
||||
if {$ifdef UsePChar}FTokenPos[0] = '.'{$else}(FTokenPos>l) or (s[FTokenPos]<>'.'){$endif} then
|
||||
if {$ifdef UsePChar}FTokenPos[0] = '.'{$else}(FTokenPos<=l) and (s[FTokenPos]='.'){$endif} then
|
||||
begin
|
||||
Inc(FTokenPos);
|
||||
Result := tkSquaredBraceOpen;
|
||||
@ -4336,7 +4336,9 @@ begin
|
||||
Result := tkBraceOpen
|
||||
else
|
||||
begin
|
||||
{$ifdef UsePChar}
|
||||
LE:=LineEnding;
|
||||
{$endif}
|
||||
// Old-style multi-line comment
|
||||
Inc(FTokenPos);
|
||||
TokenStart := FTokenPos;
|
||||
@ -4353,13 +4355,11 @@ begin
|
||||
SetLength(FCurTokenString, OldLength + SectionLength + length(LineEnding)); // Corrected JC
|
||||
if SectionLength > 0 then
|
||||
Move(TokenStart^, FCurTokenString[OldLength + 1],SectionLength);
|
||||
|
||||
// Corrected JC: Append the correct lineending
|
||||
Inc(OldLength, SectionLength);
|
||||
for Ch in LE do
|
||||
begin
|
||||
Inc(OldLength);
|
||||
FCurTokenString[OldLength] := Ch;
|
||||
Inc(OldLength);
|
||||
FCurTokenString[OldLength] := Ch;
|
||||
end;
|
||||
{$else}
|
||||
FCurTokenString:=FCurTokenString+copy(FCurLine,TokenStart,SectionLength)+LineEnding; // Corrected JC
|
||||
@ -4519,7 +4519,7 @@ begin
|
||||
Inc(FTokenPos);
|
||||
until {$ifdef UsePChar}not (FTokenPos[0] in Digits){$else}(FTokenPos>l) or not (s[FTokenPos] in Digits){$endif};
|
||||
if {$ifdef UsePChar}(FTokenPos[0]='.') and (FTokenPos[1]<>'.') and (FTokenPos[1]<>')'){$else}
|
||||
(FTokenPos<=l) and (s[FTokenPos]='.') and ((FTokenPos=l) or (s[FTokenPos+1]<>'.') and ((FTokenPos=l) or (s[FTokenPos+1]<>')')){$endif}then
|
||||
(FTokenPos<=l) and (s[FTokenPos]='.') and ((FTokenPos=l) or ((s[FTokenPos+1]<>'.') and (s[FTokenPos+1]<>')'))){$endif}then
|
||||
begin
|
||||
inc(FTokenPos);
|
||||
while {$ifdef UsePChar}FTokenPos[0] in Digits{$else}(FTokenPos<=l) and (s[FTokenPos] in Digits){$endif} do
|
||||
@ -4654,11 +4654,11 @@ begin
|
||||
end;
|
||||
'{': // Multi-line comment
|
||||
begin
|
||||
LE:=LineEnding;
|
||||
Inc(FTokenPos);
|
||||
TokenStart := FTokenPos;
|
||||
FCurTokenString := '';
|
||||
{$ifdef UsePChar}
|
||||
LE:=LineEnding;
|
||||
OldLength := 0;
|
||||
{$endif}
|
||||
NestingLevel := 0;
|
||||
|
||||
@ -466,7 +466,6 @@ interface
|
||||
|
||||
uses
|
||||
{$ifdef pas2js}
|
||||
js,
|
||||
{$else}
|
||||
AVL_Tree,
|
||||
{$endif}
|
||||
@ -1673,6 +1672,7 @@ type
|
||||
function GetContextOfPasElement(El: TPasElement): TConvertContext;
|
||||
function GetFuncContextOfPasElement(El: TPasElement): TFunctionContext;
|
||||
function GetContextOfType(aType: TConvertContextClass): TConvertContext;
|
||||
function GetMainSectionContext: TFunctionContext;
|
||||
function CurrentModeSwitches: TModeSwitches;
|
||||
function GetGlobalFunc: TFunctionContext;
|
||||
procedure WriteStack;
|
||||
@ -1922,7 +1922,9 @@ type
|
||||
Function GetTypeInfoName(El: TPasType; AContext: TConvertContext;
|
||||
ErrorEl: TPasElement; Full: boolean = false): String; virtual;
|
||||
Function TransformArgName(Arg: TPasArgument; AContext: TConvertContext): string; virtual;
|
||||
Function CreateGlobalAlias(El: TPasElement; JSPath: string; AContext: TConvertContext): string; virtual;
|
||||
Function CreateGlobalAliasForeign(El: TPasElement; JSPath: string; AContext: TConvertContext): string; virtual; // El in other module
|
||||
Function CreateGlobalAliasNull(El: TPasElement; Prefix: TPas2JSBuiltInName;
|
||||
SectionContext: TSectionContext): TFCLocalIdentifier; virtual;
|
||||
// utility functions for creating stuff
|
||||
Function IsElementUsed(El: TPasElement): boolean; virtual;
|
||||
Function IsSystemUnit(aModule: TPasModule): boolean; virtual;
|
||||
@ -7541,6 +7543,18 @@ begin
|
||||
until ctx=nil;
|
||||
end;
|
||||
|
||||
function TConvertContext.GetMainSectionContext: TFunctionContext;
|
||||
var
|
||||
Ctx: TConvertContext;
|
||||
begin
|
||||
Ctx:=Self;
|
||||
repeat
|
||||
if Ctx is TSectionContext then
|
||||
Result:=TSectionContext(Ctx);
|
||||
Ctx:=Ctx.Parent;
|
||||
until Ctx=nil;
|
||||
end;
|
||||
|
||||
function TConvertContext.CurrentModeSwitches: TModeSwitches;
|
||||
begin
|
||||
if Resolver=nil then
|
||||
@ -14650,6 +14664,29 @@ Var
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InitForwards(Decls: TFPList; SectionContext: TSectionContext);
|
||||
var
|
||||
i: Integer;
|
||||
P: TPasElement;
|
||||
C: TClass;
|
||||
begin
|
||||
For i:=0 to Decls.Count-1 do
|
||||
begin
|
||||
P:=TPasElement(Decls[i]);
|
||||
if not IsElementUsed(P) then continue;
|
||||
C:=P.ClassType;
|
||||
if (C=TPasClassType) and TPasClassType(P).IsForward then
|
||||
continue;
|
||||
if (C=TPasClassType) or (C=TPasRecordType) or (C=TPasEnumType) then
|
||||
begin
|
||||
// add var $lt = null;
|
||||
CreateGlobalAliasNull(P,pbivnLocalTypeRef,SectionContext);
|
||||
if (C=TPasClassType) or (C=TPasRecordType) then
|
||||
InitForwards(TPasMembersType(P).Members,SectionContext);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure InitSection(Section: TPasSection);
|
||||
var
|
||||
SectionScope: TPas2JSSectionScope;
|
||||
@ -14665,6 +14702,18 @@ Var
|
||||
SectionCtx:=TSectionContext(AContext);
|
||||
Src:=SectionCtx.JSElement as TJSSourceElements;
|
||||
SectionCtx.HeaderIndex:=Src.Statements.Count;
|
||||
|
||||
// add local vars for forward declarations
|
||||
if (coShortRefGlobals in Options)
|
||||
and (Section.ClassType<>TImplementationSection) then
|
||||
begin
|
||||
InitForwards(Section.Declarations,TSectionContext(AContext));
|
||||
if Section is TInterfaceSection then
|
||||
begin
|
||||
InitForwards(TPasModule(Section.Parent).ImplementationSection.Declarations,
|
||||
TSectionContext(AContext));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
@ -14846,7 +14895,7 @@ var
|
||||
P: TPasElement;
|
||||
Scope: TPas2JSClassScope;
|
||||
Ancestor: TPasType;
|
||||
AncestorPath, OwnerName, DestructorName, FnName, IntfKind: String;
|
||||
AncestorPath, OwnerName, DestructorName, FnName, IntfKind, JSName: String;
|
||||
C: TClass;
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
NeedInitFunction, HasConstructor, IsJSFunction, NeedClassExt,
|
||||
@ -14926,7 +14975,8 @@ begin
|
||||
Call.AddArg(CreatePrimitiveDotExpr(OwnerName,El));
|
||||
|
||||
// add parameter: string constant '"classname"'
|
||||
ArgEx := CreateLiteralString(El,TransformElToJSName(El,AContext));
|
||||
JSName:=TransformElToJSName(El,AContext);
|
||||
ArgEx:=CreateLiteralString(El,JSName);
|
||||
Call.AddArg(ArgEx);
|
||||
|
||||
if El.ObjKind=okInterface then
|
||||
@ -14985,6 +15035,18 @@ begin
|
||||
FuncContext.ThisVar.Element:=El;
|
||||
FuncContext.ThisVar.Kind:=cvkGlobal;
|
||||
|
||||
if coShortRefGlobals in Options then
|
||||
begin
|
||||
// $lt = this;
|
||||
JSName:=AContext.GetLocalName(El,[cvkGlobal]);
|
||||
if JSName='' then
|
||||
RaiseNotSupported(El,AContext,20200926232402);
|
||||
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
|
||||
AssignSt.LHS:=CreatePrimitiveDotExpr(JSName,El);
|
||||
AssignSt.Expr:=CreatePrimitiveDotExpr('this',El);
|
||||
AddToSourceElements(Src,AssignSt);
|
||||
end;
|
||||
|
||||
if IntfKind<>'' then
|
||||
begin
|
||||
// add this.$kind="com";
|
||||
@ -15278,6 +15340,8 @@ function TPasToJSConverter.ConvertEnumType(El: TPasEnumType;
|
||||
// minvalue: 0,
|
||||
// maxvalue: 1
|
||||
// });
|
||||
// coShortRefGlobals:
|
||||
// $lt = this.TMyEnum ...
|
||||
var
|
||||
ObjectContect: TObjectContext;
|
||||
i: Integer;
|
||||
@ -15285,7 +15349,7 @@ var
|
||||
ParentObj, Obj, TIObj: TJSObjectLiteral;
|
||||
ObjLit, TIProp: TJSObjectLiteralElement;
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
JSName: TJSString;
|
||||
JSName: string;
|
||||
Call: TJSCallExpression;
|
||||
List: TJSStatementList;
|
||||
ok: Boolean;
|
||||
@ -15293,6 +15357,7 @@ var
|
||||
Src: TJSSourceElements;
|
||||
ProcScope: TPas2JSProcedureScope;
|
||||
VarSt: TJSVariableStatement;
|
||||
SectionContext: TSectionContext;
|
||||
begin
|
||||
Result:=nil;
|
||||
for i:=0 to El.Values.Count-1 do
|
||||
@ -15322,11 +15387,14 @@ begin
|
||||
else if El.Parent is TProcedureBody then
|
||||
begin
|
||||
// add 'var TypeName = {}'
|
||||
VarSt:=CreateVarStatement(TransformElToJSName(El,AContext),Obj,El);
|
||||
JSName:=TransformElToJSName(El,AContext);
|
||||
VarSt:=CreateVarStatement(JSName,Obj,El);
|
||||
if AContext.JSElement is TJSSourceElements then
|
||||
begin
|
||||
Src:=TJSSourceElements(AContext.JSElement);
|
||||
AddToSourceElements(Src,VarSt); // keep Result=nil
|
||||
if AContext is TFunctionContext then
|
||||
TFunctionContext(AContext).AddLocalVar(JSName,El,cvkGlobal,false);
|
||||
end
|
||||
else
|
||||
Result:=VarSt;
|
||||
@ -15338,20 +15406,32 @@ begin
|
||||
AssignSt.LHS:=CreateSubDeclNameExpr(El,AContext);
|
||||
AssignSt.Expr:=Obj;
|
||||
Result:=AssignSt;
|
||||
if coShortRefGlobals in Options then
|
||||
begin
|
||||
SectionContext:=TSectionContext(AContext.GetMainSectionContext);
|
||||
JSName:=SectionContext.GetLocalName(El,[cvkGlobal]);
|
||||
if JSName='' then
|
||||
RaiseNotSupported(El,AContext,20200926232620);
|
||||
// $lt = this.TypeName = {}
|
||||
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
|
||||
AssignSt.LHS:=CreatePrimitiveDotExpr(JSName,El);
|
||||
AssignSt.Expr:=Result;
|
||||
Result:=AssignSt;
|
||||
end;
|
||||
end;
|
||||
|
||||
ObjectContect:=TObjectContext.Create(El,Obj,AContext);
|
||||
for i:=0 to El.Values.Count-1 do
|
||||
begin
|
||||
EnumValue:=TPasEnumValue(El.Values[i]);
|
||||
JSName:=TJSString(TransformElToJSName(EnumValue,AContext));
|
||||
JSName:=TransformElToJSName(EnumValue,AContext);
|
||||
// add "0":"value"
|
||||
ObjLit:=Obj.Elements.AddElement;
|
||||
ObjLit.Name:=TJSString(IntToStr(i));
|
||||
ObjLit.Expr:=CreateLiteralJSString(El,JSName);
|
||||
ObjLit.Expr:=CreateLiteralJSString(El,TJSString(JSName));
|
||||
// add value:0
|
||||
ObjLit:=Obj.Elements.AddElement;
|
||||
ObjLit.Name:=JSName;
|
||||
ObjLit.Name:=TJSString(JSName);
|
||||
ObjLit.Expr:=CreateLiteralNumber(El,i);
|
||||
end;
|
||||
|
||||
@ -16930,11 +17010,9 @@ var
|
||||
SectionCtx: TSectionContext;
|
||||
begin
|
||||
if JS=nil then exit;
|
||||
SectionCtx:=TSectionContext(aContext.GetContextOfType(TSectionContext));
|
||||
SectionCtx:=TSectionContext(aContext.GetMainSectionContext);
|
||||
if SectionCtx=nil then
|
||||
RaiseNotSupported(PosEl,aContext,20200606142555);
|
||||
if SectionCtx.Parent is TSectionContext then
|
||||
SectionCtx:=TSectionContext(SectionCtx.Parent);
|
||||
SectionCtx.AddHeaderStatement(JS);
|
||||
end;
|
||||
|
||||
@ -24187,7 +24265,7 @@ begin
|
||||
RaiseNotSupported(El,AContext,20200609230526,GetObjPath(El));
|
||||
Result:=Result+'.'+TransformElToJSName(El,AContext);
|
||||
if ShortRefGlobals then
|
||||
Result:=CreateGlobalAlias(El,Result,AContext);
|
||||
Result:=CreateGlobalAliasForeign(El,Result,AContext);
|
||||
end;
|
||||
|
||||
procedure TPasToJSConverter.CreateProcedureCall(var Call: TJSCallExpression;
|
||||
@ -25299,7 +25377,7 @@ var
|
||||
DelaySrc: TJSSourceElements;
|
||||
DelayFuncContext: TFunctionContext;
|
||||
Call: TJSCallExpression;
|
||||
JSParentName: String;
|
||||
JSParentName, JSName: String;
|
||||
FunDecl: TJSFunctionDeclarationStatement;
|
||||
Src: TJSSourceElements;
|
||||
FuncContext: TFunctionContext;
|
||||
@ -25312,6 +25390,7 @@ var
|
||||
NewFields, Vars, Methods: TFPList;
|
||||
ok, IsComplex, SpecializeDelay: Boolean;
|
||||
VarSt: TJSVariableStatement;
|
||||
AssignSt: TJSSimpleAssignStatement;
|
||||
begin
|
||||
Result:=nil;
|
||||
if El.Name='' then
|
||||
@ -25343,7 +25422,8 @@ begin
|
||||
RaiseNotSupported(El,AContext,20190105104054);
|
||||
// local record type elevated to global scope
|
||||
Src:=TJSSourceElements(AContext.JSElement);
|
||||
VarSt:=CreateVarStatement(TransformElToJSName(El,AContext),Call,El);
|
||||
JSName:=TransformElToJSName(El,AContext);
|
||||
VarSt:=CreateVarStatement(JSName,Call,El);
|
||||
AddToSourceElements(Src,VarSt); // keep Result=nil
|
||||
// add parameter: parent = null
|
||||
Call.AddArg(CreateLiteralNull(El));
|
||||
@ -25380,6 +25460,18 @@ begin
|
||||
FuncContext.ThisVar.Element:=El;
|
||||
FuncContext.ThisVar.Kind:=cvkGlobal;
|
||||
|
||||
if (coShortRefGlobals in Options) and not (El.Parent is TProcedureBody) then
|
||||
begin
|
||||
// $lt = this;
|
||||
JSName:=AContext.GetLocalName(El,[cvkGlobal]);
|
||||
if JSName='' then
|
||||
RaiseNotSupported(El,AContext,20200926235501);
|
||||
AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,El));
|
||||
AssignSt.LHS:=CreatePrimitiveDotExpr(JSName,El);
|
||||
AssignSt.Expr:=CreatePrimitiveDotExpr('this',El);
|
||||
AddToSourceElements(Src,AssignSt);
|
||||
end;
|
||||
|
||||
// init fields
|
||||
NewFields:=TFPList.Create;
|
||||
Vars:=TFPList.Create;
|
||||
@ -25692,7 +25784,7 @@ begin
|
||||
Result:=GetBIName(pbivnModules)+'.'+Result;
|
||||
|
||||
if coShortRefGlobals in Options then
|
||||
Result:=CreateGlobalAlias(El,Result,AContext);
|
||||
Result:=CreateGlobalAliasForeign(El,Result,AContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -25939,7 +26031,7 @@ begin
|
||||
Result:=TransformToJSName(Arg,Result,true,AContext);
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateGlobalAlias(El: TPasElement; JSPath: string;
|
||||
function TPasToJSConverter.CreateGlobalAliasForeign(El: TPasElement; JSPath: string;
|
||||
AContext: TConvertContext): string;
|
||||
var
|
||||
ElModule, MyModule: TPasModule;
|
||||
@ -25965,9 +26057,7 @@ begin
|
||||
else
|
||||
begin
|
||||
// El is from another unit
|
||||
SectionContext:=TSectionContext(AContext.GetContextOfType(TSectionContext));
|
||||
if SectionContext.Parent is TSectionContext then
|
||||
SectionContext:=TSectionContext(SectionContext.Parent);
|
||||
SectionContext:=TSectionContext(AContext.GetMainSectionContext);
|
||||
|
||||
FuncContext:=AContext.GetFunctionContext;
|
||||
if El is TPasModule then
|
||||
@ -26003,6 +26093,18 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.CreateGlobalAliasNull(El: TPasElement;
|
||||
Prefix: TPas2JSBuiltInName; SectionContext: TSectionContext
|
||||
): TFCLocalIdentifier;
|
||||
var
|
||||
V: TJSVariableStatement;
|
||||
begin
|
||||
// insert var $lt = null;
|
||||
Result:=SectionContext.AddLocalVar(GetBIName(Prefix),El,cvkGlobal,true);
|
||||
V:=CreateVarStatement(Result.Name,CreateLiteralNull(El),El);
|
||||
AddHeaderStatement(V,El,SectionContext);
|
||||
end;
|
||||
|
||||
function TPasToJSConverter.ConvertPasElement(El: TPasElement;
|
||||
Resolver: TPas2JSResolver): TJSElement;
|
||||
var
|
||||
|
||||
@ -25,7 +25,7 @@ unit FPPJsSrcMap;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, math,
|
||||
SysUtils, math,
|
||||
jswriter, jstree, JSSrcMap;
|
||||
|
||||
type
|
||||
|
||||
@ -1182,6 +1182,7 @@ begin
|
||||
// maybe emit message ?
|
||||
FResourceHandler.StartUnit(PasModule.Name);
|
||||
FResourceHandler.HandleResource(aFileName,aOptions);
|
||||
if Sender=nil then ;
|
||||
end;
|
||||
|
||||
function TPas2jsCompilerFile.OnConverterIsElementUsed(Sender: TObject;
|
||||
|
||||
@ -26,7 +26,7 @@ uses
|
||||
{$IFDEF NodeJS}
|
||||
node.fs,
|
||||
{$ENDIF}
|
||||
Classes, SysUtils, Pas2jsFileUtils, Pas2JSFS, Pas2jsCompiler;
|
||||
SysUtils, Pas2jsFileUtils, Pas2JSFS, Pas2jsCompiler;
|
||||
|
||||
Type
|
||||
TPas2JSFileConfigSupport = Class(TPas2JSConfigSupport)
|
||||
|
||||
@ -23,7 +23,7 @@ unit Pas2JSFSCompiler;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
SysUtils,
|
||||
PasUseAnalyzer,
|
||||
Pas2jsFileCache, Pas2jsCompiler,
|
||||
Pas2JSFS,
|
||||
|
||||
@ -5,7 +5,7 @@ unit pas2jsresstrfile;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpJSON;
|
||||
SysUtils, fpJSON;
|
||||
|
||||
Type
|
||||
|
||||
|
||||
@ -61,6 +61,9 @@ type
|
||||
procedure TestOptShortRefGlobals_Unit_FromIntfImpl_ToIntfImpl;
|
||||
procedure TestOptShortRefGlobals_Property;
|
||||
procedure TestOptShortRefGlobals_GenericFunction;
|
||||
procedure TestOptShortRefGlobals_SameUnit_EnumType;
|
||||
procedure TestOptShortRefGlobals_SameUnit_ClassType;
|
||||
procedure TestOptShortRefGlobals_SameUnit_RecordType;
|
||||
|
||||
// Whole Program Optimization
|
||||
procedure TestWPO_OmitLocalVar;
|
||||
@ -245,24 +248,26 @@ begin
|
||||
ConvertProgram;
|
||||
CheckSource('TestOptShortRefGlobals_Program',
|
||||
LinesToStr([
|
||||
'var $lt = null;',
|
||||
'var $lm = pas.UnitA;',
|
||||
'var $lt = $lm.TBird;',
|
||||
'var $lt1 = $lm.TRec;',
|
||||
'rtl.createClass(this, "TEagle", $lt, function () {',
|
||||
'var $lt1 = $lm.TBird;',
|
||||
'var $lt2 = $lm.TRec;',
|
||||
'rtl.createClass(this, "TEagle", $lt1, function () {',
|
||||
' $lt = this;',
|
||||
' this.Run = function (w) {',
|
||||
' var Result = 0;',
|
||||
' return Result;',
|
||||
' };',
|
||||
'});',
|
||||
'this.e = null;',
|
||||
'this.r = $lt1.$new();',
|
||||
'this.r = $lt2.$new();',
|
||||
'this.c = {};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$mod.e = $mod.TEagle.$create("Create");',
|
||||
'$lm.b = $lt.$create("Create");',
|
||||
'$lt.c = $mod.e.c + 1;',
|
||||
'$mod.r.x = $lt.c;',
|
||||
'$mod.e = $lt.$create("Create");',
|
||||
'$lm.b = $lt1.$create("Create");',
|
||||
'$lt1.c = $mod.e.c + 1;',
|
||||
'$mod.r.x = $lt1.c;',
|
||||
'$mod.r.x = $lm.b.c;',
|
||||
'$mod.r.x = $mod.e.$class.Run(5);',
|
||||
'$mod.r.x = $mod.e.$class.Run(5);',
|
||||
@ -351,42 +356,46 @@ begin
|
||||
CheckSource('TestOptShortRefGlobals_Unit_FromIntfImpl_ToIntfImpl',
|
||||
LinesToStr([
|
||||
'var $impl = $mod.$impl;',
|
||||
'var $lm = pas.UnitA;',
|
||||
'var $lt = $lm.TBird;',
|
||||
'var $lm1 = null;',
|
||||
'var $lt = null;',
|
||||
'var $lt1 = null;',
|
||||
'var $lt2 = null;',
|
||||
'var $lm = pas.UnitA;',
|
||||
'var $lt2 = $lm.TBird;',
|
||||
'var $lm1 = null;',
|
||||
'var $lt3 = null;',
|
||||
'rtl.createClass(this, "TEagle", $lt, function () {',
|
||||
'var $lt4 = null;',
|
||||
'var $lt5 = null;',
|
||||
'rtl.createClass(this, "TEagle", $lt2, function () {',
|
||||
' $lt = this;',
|
||||
' this.Fly = function () {',
|
||||
' $impl.TRedAnt.$create("Create");',
|
||||
' $lt1.$create("Create");',
|
||||
' $lt3.$create("Create");',
|
||||
' $lt2.$create("Create");',
|
||||
' $lt.$create("Create");',
|
||||
' $mod.TEagle.$create("Create");',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$impl.RedAnt = $impl.TRedAnt.$create("Create");',
|
||||
'$impl.Ant = $lt1.$create("Create");',
|
||||
'$impl.Bird = $lt.$create("Create");',
|
||||
'$impl.Eagle = $mod.TEagle.$create("Create");',
|
||||
'$lt3.$create("Create");',
|
||||
'$impl.RedAnt = $lt1.$create("Create");',
|
||||
'$impl.Ant = $lt3.$create("Create");',
|
||||
'$impl.Bird = $lt2.$create("Create");',
|
||||
'$impl.Eagle = $lt.$create("Create");',
|
||||
'$lt5.$create("Create");',
|
||||
'$impl.Eagle.Fly();',
|
||||
'$impl.RedAnt.Run();',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'$lm1 = pas.UnitB;',
|
||||
'$lt1 = $lm1.TAnt;',
|
||||
'$lt2 = $lm1.TBear;',
|
||||
'$lt3 = $lm1.TFrog;',
|
||||
'rtl.createClass($impl, "TRedAnt", $lt1, function () {',
|
||||
'$lt3 = $lm1.TAnt;',
|
||||
'$lt4 = $lm1.TBear;',
|
||||
'$lt5 = $lm1.TFrog;',
|
||||
'rtl.createClass($impl, "TRedAnt", $lt3, function () {',
|
||||
' $lt1 = this;',
|
||||
' this.Run = function () {',
|
||||
' $impl.TRedAnt.$create("Create");',
|
||||
' $lt1.$create("Create");',
|
||||
' $lt.$create("Create");',
|
||||
' $mod.TEagle.$create("Create");',
|
||||
' $lt3.$create("Create");',
|
||||
' $lt2.$create("Create");',
|
||||
' $lt.$create("Create");',
|
||||
' $lt4.$create("Create");',
|
||||
' };',
|
||||
'});',
|
||||
'$impl.RedAnt = null;',
|
||||
@ -430,9 +439,11 @@ begin
|
||||
ConvertUnit;
|
||||
CheckSource('TestOptShortRefGlobals_Property',
|
||||
LinesToStr([
|
||||
'var $lt = null;',
|
||||
'var $lm = pas.UnitA;',
|
||||
'var $lt = $lm.TBird;',
|
||||
'rtl.createClass(this, "TEagle", $lt, function () {',
|
||||
'var $lt1 = $lm.TBird;',
|
||||
'rtl.createClass(this, "TEagle", $lt1, function () {',
|
||||
' $lt = this;',
|
||||
' this.Fly = function (o) {',
|
||||
' this.Fly(this.FWing);',
|
||||
' this.Fly(this.FLeg);',
|
||||
@ -474,11 +485,13 @@ begin
|
||||
ConvertUnit;
|
||||
CheckSource('TestOptShortRefGlobals_GenericFunction',
|
||||
LinesToStr([
|
||||
'var $lt = null;',
|
||||
'var $lm = pas.system;',
|
||||
'var $lt = $lm.TObject;',
|
||||
'var $lt1 = $lm.TObject;',
|
||||
'var $lm1 = pas.UnitA;',
|
||||
'var $lp = $lm1.Run$G1;',
|
||||
'rtl.createClass(this, "TEagle", $lt, function () {',
|
||||
'rtl.createClass(this, "TEagle", $lt1, function () {',
|
||||
' $lt = this;',
|
||||
'});',
|
||||
'this.Fly = function () {',
|
||||
' $lp(null);',
|
||||
@ -490,6 +503,280 @@ begin
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestOptimizations.TestOptShortRefGlobals_SameUnit_EnumType;
|
||||
begin
|
||||
StartUnit(true,[supTObject]);
|
||||
Add([
|
||||
'{$optimization JSShortRefGlobals}',
|
||||
'interface',
|
||||
'type',
|
||||
' TBird = class',
|
||||
' type',
|
||||
' TFlag = (big,small);',
|
||||
' procedure Fly;',
|
||||
' end;',
|
||||
' TEnum = (red,blue);',
|
||||
'var',
|
||||
' e: TEnum;',
|
||||
' f: TBird.TFlag;',
|
||||
'procedure Run;',
|
||||
'implementation',
|
||||
'procedure TBird.Fly;',
|
||||
'begin',
|
||||
' e:=blue;',
|
||||
' f:=small;',
|
||||
'end;',
|
||||
'procedure Run;',
|
||||
'type TSub = (left,right);',
|
||||
'var s: TSub;',
|
||||
'begin',
|
||||
' e:=red;',
|
||||
' s:=right;',
|
||||
' f:=big;',
|
||||
'end;',
|
||||
'']);
|
||||
ConvertUnit;
|
||||
CheckSource('TestOptShortRefGlobals_SameUnit_EnumType',
|
||||
LinesToStr([
|
||||
'var $lt = null;',
|
||||
'var $lt1 = null;',
|
||||
'var $lt2 = null;',
|
||||
'var $lm = pas.system;',
|
||||
'var $lt3 = $lm.TObject;',
|
||||
'rtl.createClass(this, "TBird", $lt3, function () {',
|
||||
' $lt = this;',
|
||||
' $lt1 = this.TFlag = {',
|
||||
' "0": "big",',
|
||||
' big: 0,',
|
||||
' "1": "small",',
|
||||
' small: 1',
|
||||
' };',
|
||||
' this.Fly = function () {',
|
||||
' $mod.e = $lt2.blue;',
|
||||
' $mod.f = $lt1.small;',
|
||||
' };',
|
||||
'});',
|
||||
'$lt2 = this.TEnum = {',
|
||||
' "0": "red",',
|
||||
' red: 0,',
|
||||
' "1": "blue",',
|
||||
' blue: 1',
|
||||
'};',
|
||||
'this.e = 0;',
|
||||
'this.f = 0;',
|
||||
'var TSub = {',
|
||||
' "0": "left",',
|
||||
' left: 0,',
|
||||
' "1": "right",',
|
||||
' right: 1',
|
||||
'};',
|
||||
'this.Run = function () {',
|
||||
' var s = 0;',
|
||||
' $mod.e = $lt2.red;',
|
||||
' s = TSub.right;',
|
||||
' $mod.f = $lt1.big;',
|
||||
'};',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestOptimizations.TestOptShortRefGlobals_SameUnit_ClassType;
|
||||
begin
|
||||
WithTypeInfo:=true;
|
||||
StartUnit(true,[supTObject]);
|
||||
Add([
|
||||
'{$optimization JSShortRefGlobals}',
|
||||
'interface',
|
||||
'type',
|
||||
' TBird = class;',
|
||||
' TAnt = class',
|
||||
' type',
|
||||
' TLeg = class',
|
||||
' end;',
|
||||
' procedure Run;',
|
||||
' published',
|
||||
' Bird: TBird;',
|
||||
' end;',
|
||||
' TBird = class',
|
||||
' procedure Fly;',
|
||||
' end;',
|
||||
'implementation',
|
||||
'type',
|
||||
' TFrog = class',
|
||||
' end;',
|
||||
'procedure TAnt.Run;',
|
||||
'begin',
|
||||
' if typeinfo(TBird)=nil then;',
|
||||
' Bird:=TBird.Create;',
|
||||
' TLeg.Create;',
|
||||
' TFrog.Create;',
|
||||
'end;',
|
||||
'procedure TBird.Fly;',
|
||||
'begin',
|
||||
' if typeinfo(TAnt)=nil then;',
|
||||
'end;',
|
||||
'']);
|
||||
ConvertUnit;
|
||||
CheckSource('TestOptShortRefGlobals_SameUnit_ClassType',
|
||||
LinesToStr([
|
||||
'var $impl = $mod.$impl;',
|
||||
'var $lt = null;',
|
||||
'var $lt1 = null;',
|
||||
'var $lt2 = null;',
|
||||
'var $lt3 = null;',
|
||||
'var $lm = pas.system;',
|
||||
'var $lt4 = $lm.TObject;',
|
||||
'this.$rtti.$Class("TBird");',
|
||||
'rtl.createClass(this, "TAnt", $lt4, function () {',
|
||||
' $lt = this;',
|
||||
' rtl.createClass(this, "TLeg", $lt4, function () {',
|
||||
' $lt1 = this;',
|
||||
' });',
|
||||
' this.$init = function () {',
|
||||
' $lt4.$init.call(this);',
|
||||
' this.Bird = null;',
|
||||
' };',
|
||||
' this.$final = function () {',
|
||||
' this.Bird = undefined;',
|
||||
' $lt4.$final.call(this);',
|
||||
' };',
|
||||
' this.Run = function () {',
|
||||
' if ($mod.$rtti["TBird"] === null) ;',
|
||||
' this.Bird = $lt2.$create("Create");',
|
||||
' $lt1.$create("Create");',
|
||||
' $lt3.$create("Create");',
|
||||
' };',
|
||||
' var $r = this.$rtti;',
|
||||
' $r.addField("Bird", $mod.$rtti["TBird"]);',
|
||||
'});',
|
||||
'rtl.createClass(this, "TBird", $lt4, function () {',
|
||||
' $lt2 = this;',
|
||||
' this.Fly = function () {',
|
||||
' if ($mod.$rtti["TAnt"] === null) ;',
|
||||
' };',
|
||||
'});',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']),
|
||||
LinesToStr([
|
||||
'rtl.createClass($impl, "TFrog", $lt4, function () {',
|
||||
' $lt3 = this;',
|
||||
'});',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestOptimizations.TestOptShortRefGlobals_SameUnit_RecordType;
|
||||
begin
|
||||
StartUnit(true,[supTObject]);
|
||||
Add([
|
||||
'{$optimization JSShortRefGlobals}',
|
||||
'{$modeswitch advancedrecords}',
|
||||
'interface',
|
||||
'type',
|
||||
' TAnt = record',
|
||||
' type',
|
||||
' TLeg = record',
|
||||
' l: word;',
|
||||
' end;',
|
||||
' procedure Run;',
|
||||
' Leg: TLeg;',
|
||||
' end;',
|
||||
'implementation',
|
||||
'type',
|
||||
' TBird = record',
|
||||
' b: word;',
|
||||
' end;',
|
||||
'procedure TAnt.Run;',
|
||||
'type',
|
||||
' TFoot = record',
|
||||
' f: word;',
|
||||
' end;',
|
||||
'var',
|
||||
' b: TBird;',
|
||||
' l: TLeg;',
|
||||
' a: TAnt;',
|
||||
' f: TFoot;',
|
||||
'begin',
|
||||
' b.b:=1;',
|
||||
' l.l:=2;',
|
||||
' a.Leg.l:=3;',
|
||||
' f.f:=4;',
|
||||
'end;',
|
||||
'']);
|
||||
ConvertUnit;
|
||||
CheckSource('TestOptShortRefGlobals_SameUnit_RecordType',
|
||||
LinesToStr([
|
||||
'var $impl = $mod.$impl;',
|
||||
'var $lt = null;',
|
||||
'var $lt1 = null;',
|
||||
'var $lt2 = null;',
|
||||
'rtl.recNewT(this, "TAnt", function () {',
|
||||
' $lt = this;',
|
||||
' rtl.recNewT($lt, "TLeg", function () {',
|
||||
' $lt1 = this;',
|
||||
' this.l = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.l === b.l;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.l = s.l;',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
' this.$new = function () {',
|
||||
' var r = Object.create(this);',
|
||||
' r.Leg = $lt1.$new();',
|
||||
' return r;',
|
||||
' };',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.Leg.$eq(b.Leg);',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.Leg.$assign(s.Leg);',
|
||||
' return this;',
|
||||
' };',
|
||||
' var TFoot = rtl.recNewT(null, "", function () {',
|
||||
' this.f = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.f === b.f;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.f = s.f;',
|
||||
' return this;',
|
||||
' };',
|
||||
' });',
|
||||
' this.Run = function () {',
|
||||
' var b = $lt2.$new();',
|
||||
' var l = $lt1.$new();',
|
||||
' var a = $lt.$new();',
|
||||
' var f = TFoot.$new();',
|
||||
' b.b = 1;',
|
||||
' l.l = 2;',
|
||||
' a.Leg.l = 3;',
|
||||
' f.f = 4;',
|
||||
' };',
|
||||
'}, true);',
|
||||
'']),
|
||||
LinesToStr([
|
||||
'']),
|
||||
LinesToStr([
|
||||
'rtl.recNewT($impl, "TBird", function () {',
|
||||
' $lt2 = this;',
|
||||
' this.b = 0;',
|
||||
' this.$eq = function (b) {',
|
||||
' return this.b === b.b;',
|
||||
' };',
|
||||
' this.$assign = function (s) {',
|
||||
' this.b = s.b;',
|
||||
' return this;',
|
||||
' };',
|
||||
'});',
|
||||
'']));
|
||||
end;
|
||||
|
||||
procedure TTestOptimizations.TestWPO_OmitLocalVar;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1311,7 +1598,7 @@ procedure TTestOptimizations.TestWPO_ConstructorDefaultValueConst;
|
||||
var
|
||||
ActualSrc, ExpectedSrc: String;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true);
|
||||
Add([
|
||||
'const gcBlack = 0;',
|
||||
@ -1362,7 +1649,7 @@ procedure TTestOptimizations.TestWPO_RTTI_PublishedField;
|
||||
var
|
||||
ActualSrc, ExpectedSrc: String;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true);
|
||||
Add('type');
|
||||
Add(' TArrA = array of char;');
|
||||
@ -1410,7 +1697,7 @@ procedure TTestOptimizations.TestWPO_RTTI_TypeInfo;
|
||||
var
|
||||
ActualSrc, ExpectedSrc: String;
|
||||
begin
|
||||
Converter.Options:=Converter.Options-[coNoTypeInfo];
|
||||
WithTypeInfo:=true;
|
||||
StartProgram(true);
|
||||
Add('type');
|
||||
Add(' TArrA = array of char;');
|
||||
|
||||
@ -1143,7 +1143,7 @@ function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64;compilerpr
|
||||
{$endif}
|
||||
|
||||
{$ifdef FPC_HAS_INTERNAL_BSR}
|
||||
{$if defined(cpui386) or defined(cpux86_64) or defined(cpuarm) or defined(cpuaarch64) or defined(cpupowerpc32) or defined(cpupowerpc64)}
|
||||
{$if defined(cpui386) or defined(cpux86_64) or defined(cpuarm) or defined(cpuaarch64) or defined(cpupowerpc32) or defined(cpupowerpc64) or defined(cpuxtensa)}
|
||||
{$define FPC_HAS_INTERNAL_BSR_BYTE}
|
||||
{$define FPC_HAS_INTERNAL_BSR_WORD}
|
||||
{$define FPC_HAS_INTERNAL_BSR_DWORD}
|
||||
|
||||
@ -113,6 +113,7 @@ type
|
||||
varerror : (verror : hresult);
|
||||
varboolean : (vboolean : wordbool);
|
||||
varunknown : (vunknown : pointer);
|
||||
varustring : (vustring : pointer);
|
||||
// vardecimal : ( : );
|
||||
varshortint : (vshortint : shortint);
|
||||
varbyte : (vbyte : byte);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user