paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 06:26:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

* small fix to operator overloading when in MMX mode

Browse Source 
+ the compiler uses now fldz and fld1 if possible
  + some fixes to floating point registers
  + some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
  * .... ???
This commit is contained in:
florian 1999-09-15 20:35:37 +00:00
parent 8e642be78a
commit 1c638f2952
20 changed files with 488 additions and 117 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/aasm.pas
View File

@ -694,7 +694,7 @@ uses
begin
inherited init;
typ:=ait_align;
if b in [1,2,4,8,16] then
if b in [1,2,4,8,16,32] then
aligntype := b
else
aligntype := 1;
@ -709,7 +709,7 @@ uses
begin
inherited init;
typ:=ait_align;
if b in [1,2,4,8,16] then
if b in [1,2,4,8,16,32] then
aligntype := b
else
aligntype := 1;
@ -985,7 +985,14 @@ uses
end.
{
$Log$
Revision 1.61 1999-09-08 15:01:29 jonas
Revision 1.62 1999-09-15 20:35:37 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.61 1999/09/08 15:01:29 jonas
* some small changes so the noew optimizer is again compilable
Revision 1.60 1999/08/06 15:30:17 florian

15
compiler/cg386flw.pas
View File

@ -44,7 +44,7 @@ interface
implementation
uses
cobjects,verbose,globals,systems,
cobjects,verbose,globtype,globals,systems,
symconst,symtable,aasm,types,
hcodegen,temp_gen,pass_2,
cpubase,cpuasm,
@ -280,6 +280,10 @@ implementation
if not(omitfirstcomp) or temptovalue then
emitjmp(hcond,aktbreaklabel);
{ align loop target }
if not(cs_littlesize in aktglobalswitches) then
exprasmlist^.concat(new(pai_align,init_op(16,$90)));
emitlab(l3);
{ help register must not be in instruction block }
@ -804,7 +808,14 @@ do_jmp:
end.
{
$Log$
Revision 1.48 1999-09-07 07:56:37 peter
Revision 1.49 1999-09-15 20:35:37 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.48 1999/09/07 07:56:37 peter
* reload esi in except block to allow virtual methods
Revision 1.47 1999/08/25 11:59:42 jonas

76
compiler/cg386inl.pas
View File

@ -843,7 +843,7 @@ implementation
l : longint;
ispushed : boolean;
hregister : tregister;
otlabel,oflabel : pasmlabel;
otlabel,oflabel,l1 : pasmlabel;
oldpushedparasize : longint;
begin
@ -1310,6 +1310,71 @@ implementation
end;
end;
end;
in_pi:
emit_none(A_FLDPI,S_NO);
in_sin_extended,
in_arctan_extended,
in_abs_extended,
in_sqr_extended,
in_sqrt_extended,
in_ln_extended,
in_cos_extended:
begin
secondpass(p^.left);
case p^.left^.location.loc of
LOC_FPU:
;
LOC_CFPUREGISTER:
begin
emit_reg(A_FLD,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset));
inc(fpuvaroffset);
end;
LOC_REFERENCE,LOC_MEM:
floatload(pfloatdef(p^.left^.resulttype)^.typ,p^.left^.location.reference);
else
internalerror(309991);
end;
case p^.inlinenumber of
in_sin_extended,
in_cos_extended:
begin
getlabel(l1);
if p^.inlinenumber=in_sin_extended then
emit_none(A_FSIN,S_NO)
else
emit_none(A_FCOS,S_NO);
{
emit_reg(A_FNSTSW,S_NO,R_AX);
emit_none(A_SAHF,S_NO);
emitjmp(C_NP,l1);
emit_reg(A_FSTP,S_NO,R_ST0);
emit_none(A_FLDZ,S_NO);
emitlab(l1);
}
end;
in_arctan_extended:
begin
emit_none(A_FLD1,S_NO);
emit_none(A_FPATAN,S_NO);
end;
in_abs_extended:
emit_none(A_FABS,S_NO);
in_sqr_extended:
begin
emit_reg(A_FLD,S_NO,R_ST0);
emit_none(A_FMULP,S_NO);
end;
in_sqrt_extended:
emit_none(A_FSQRT,S_NO);
in_ln_extended:
begin
emit_none(A_FLDLN2,S_NO);
emit_none(A_FXCH,S_NO);
emit_none(A_FYL2X,S_NO);
end;
end;
end;
{$ifdef SUPPORT_MMX}
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
begin
@ -1336,7 +1401,14 @@ implementation
end.
{
$Log$
Revision 1.69 1999-08-28 15:34:16 florian
Revision 1.70 1999-09-15 20:35:38 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.69 1999/08/28 15:34:16 florian
* bug 519 fixed
Revision 1.68 1999/08/19 13:08:47 pierre

11
compiler/cgai386.pas
View File

@ -3063,7 +3063,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
exprasmlist^.insert(new(pai_align,init_op(16,$90)))
else
if not(cs_littlesize in aktglobalswitches) then
exprasmlist^.insert(new(pai_align,init(4)));
exprasmlist^.insert(new(pai_align,init_op(32,$90)));
end;
exprasmlist:=oldexprasmlist;
end;
@ -3349,7 +3349,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end.
{
$Log$
Revision 1.42 1999-09-14 07:59:47 florian
Revision 1.43 1999-09-15 20:35:38 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.42 1999/09/14 07:59:47 florian
* finally!? fixed
with <function with result in temp> do
My last and also Peter's fix before were wrong :(

11
compiler/cpubase.pas
View File

@ -769,8 +769,8 @@ const
frame_pointer = R_EBP;
self_pointer = R_ESI;
accumulator = R_EAX;
{ the register where the vmt offset is passed to the destructor }
{ helper routine }
vmt_offset_reg = R_EDI;
scratch_regs : array[1..1] of tregister = (R_EDI);
@ -1091,7 +1091,14 @@ end;
end.
{
$Log$
Revision 1.12 1999-09-10 18:48:01 florian
Revision 1.13 1999-09-15 20:35:39 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.12 1999/09/10 18:48:01 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* most things for stored properties fixed

17
compiler/innr.inc
View File

@ -73,6 +73,14 @@ const
in_const_sin = 116;
in_lo_qword = 117;
in_hi_qword = 118;
in_cos_extended = 119;
in_pi = 121;
in_abs_extended = 122;
in_sqr_extended = 123;
in_sqrt_extended = 124;
in_arctan_extended = 125;
in_ln_extended = 126;
in_sin_extended = 127;
{ MMX functions }
{ these contants are used by the mmx unit }
@ -91,7 +99,14 @@ const
{
$Log$
Revision 1.13 1999-08-28 15:34:19 florian
Revision 1.14 1999-09-15 20:35:40 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.13 1999/08/28 15:34:19 florian
* bug 519 fixed
Revision 1.12 1999/07/01 15:49:14 florian

20
compiler/new/alpha/cgcpu.pas
View File

@ -200,7 +200,14 @@ end;
end.
{
$Log$
Revision 1.7 1999-08-25 12:00:17 jonas
Revision 1.8 1999-09-15 20:35:47 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.7 1999/08/25 12:00:17 jonas
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
Revision 1.6 1999/08/06 18:05:57 florian
@ -229,15 +236,4 @@ end.
Revision 1.1 1999/08/01 22:08:26 florian
* reorganisation of directory structure
Revision 1.3 1999/08/01 18:22:31 florian
* made it again compilable
Revision 1.2 1999/01/23 23:29:43 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.1 1998/12/15 22:17:02 florian
* first version
}

15
compiler/new/i386/cgcpu.pas
View File

@ -49,7 +49,12 @@ unit cgcpu;
implementation
uses
<<<<<<< cgcpu.pas
globtype,globals,cpuasm,symconst,symtable,cgbase,
verbose;
=======
globtype,globals,cpuasm,symconst,symtable,cgbase,verbose;
>>>>>>> 1.6
constructor tcg386.init;
@ -140,7 +145,14 @@ unit cgcpu;
end.
{
$Log$
Revision 1.6 1999-09-10 18:48:11 florian
Revision 1.7 1999-09-15 20:35:47 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.6 1999/09/10 18:48:11 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* most things for stored properties fixed
@ -171,5 +183,4 @@ end.
Revision 1.1 1998/12/15 22:17:02 florian
* first version
}

11
compiler/new/i386/tgcpu.pas
View File

@ -68,7 +68,14 @@ begin
end.
{
$Log$
Revision 1.4 1999-09-10 18:48:11 florian
Revision 1.5 1999-09-15 20:35:47 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.4 1999/09/10 18:48:11 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* most things for stored properties fixed
@ -80,4 +87,4 @@ end.
Revision 1.1 1999/08/02 17:14:14 florian
+ changed the temp. generator to an object
}
}

15
compiler/new/nmem.pas
View File

@ -146,7 +146,7 @@ unit nmem;
{$ifdef dummy}
{ DLL variable, DLL variables are only available on the win32 target }
{ maybe we've to add this later for the alpha WinNT }
else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then
else if vo_is_dll_var in pvarsym(symtableentry)^.varoptions then
begin
hregister:=tg.getregisterint;
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
@ -162,7 +162,7 @@ unit nmem;
{ in case it is a register variable: }
if pvarsym(symtableentry)^.reg<>R_NO then
begin
if pvarsym(p^.symtableentry)^.reg in fpureg then
if pvarsym(symtableentry)^.reg in fpuregs then
begin
location.loc:=LOC_CFPUREGISTER;
tg.unusedregsfpu:=tg.unusedregsfpu-[pvarsym(symtableentry)^.reg];
@ -221,7 +221,7 @@ unit nmem;
end;
objectsymtable:
begin
if (pvarsym(symtableentry)^.properties and sp_static)<>0 then
if sp_static in pvarsym(symtableentry)^.symoptions then
begin
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
end
@ -711,7 +711,14 @@ unit nmem;
end.
{
$Log$
Revision 1.12 1999-09-14 11:16:09 florian
Revision 1.13 1999-09-15 20:35:46 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.12 1999/09/14 11:16:09 florian
* only small updates to work with the current compiler
Revision 1.11 1999/08/25 12:00:12 jonas

11
compiler/new/powerpc/cgcpu.pas
View File

@ -569,13 +569,20 @@ const
var p: paicpu;
begin
p := new(paicpu,op_sym(op,newasmsymbol(l^.name)));
p^.condition := create_cond_norm(c,0);
create_cond_norm(c,0,p^.condition);
list^.concat(p)
end;
end.
{
$Log$
Revision 1.5 1999-09-03 13:14:11 jonas
Revision 1.6 1999-09-15 20:35:47 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.5 1999/09/03 13:14:11 jonas
+ implemented some parameter passing methods, but they require\n some more helper routines\n * fix for loading symbol addresses (still needs to be done in a_loadaddress)\n * several changes to the way conditional branches are handled
Revision 1.4 1999/08/26 14:53:41 jonas

27
compiler/new/powerpc/cpubase.pas
View File

@ -428,9 +428,9 @@ const
function is_calljmp(o:tasmop):boolean;
function inverse_cond(c: TAsmCond): TAsmCond;
function create_cond_imm(BO,BI:byte): TAsmCond;
function create_cond_norm(cond: TAsmCondFlags; cr: byte): TasmCond;
procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
{*****************************************************************************
Init/Done
@ -499,26 +499,26 @@ implementation
end;
function inverse_cond(c: TAsmCond): TAsmCond;
procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
const
inv_condflags:array[TAsmCondFlags] of TAsmCondFlags=(CF_None,
CF_GE,CF_GT,CF_NE,CF_LT,CF_LE,CF_LT,CF_EQ,CF_GT,CF_NS,CF_SO,CF_NU,CF_UN,
CF_F,CF_T,CF_DNZ,CF_DNZF,CF_DNZT,CF_DZ,CF_DZF,CF_DZT);
begin
c.cond := inv_condflags[c.cond];
inverse_cond := c;
r := c;
end;
function create_cond_imm(BO,BI:byte): TAsmCond;
procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
var c: tasmcond;
begin
c.simple := false;
c.bo := bo;
c.bi := bi;
create_cond_imm := c
r := c
end;
function create_cond_norm(cond: TAsmCondFlags; cr: byte): TasmCond;
procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond);
const cr2reg: array[0..7] of tregister =
(R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7);
var c: tasmcond;
@ -530,7 +530,7 @@ implementation
CF_T..CF_DZF: c.crbit := cr
else c.cr := cr2reg[cr];
end;
create_cond_norm := c;
r := c;
end;
{*****************************************************************************
@ -548,7 +548,14 @@ implementation
end.
{
$Log$
Revision 1.6 1999-09-03 13:11:59 jonas
Revision 1.7 1999-09-15 20:35:47 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.6 1999/09/03 13:11:59 jonas
* several changes to the way conditional branches are handled\n * some typos fixed
Revision 1.5 1999/08/23 23:27:54 pierre

11
compiler/options.pas
View File

@ -1037,7 +1037,7 @@ begin
def_symbol('HASRESOURCESTRINGS');
def_symbol('HASSAVEREGISTERS');
def_symbol('NEWVMTOFFSET');
def_symbol('HASINTERNMATH');
{ some stuff for TP compatibility }
{$ifdef i386}
def_symbol('CPU86');
@ -1217,7 +1217,14 @@ end;
end.
{
$Log$
Revision 1.20 1999-09-03 09:31:22 peter
Revision 1.21 1999-09-15 20:35:40 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.20 1999/09/03 09:31:22 peter
* reading of search paths fixed to work as expected
Revision 1.19 1999/09/01 22:07:20 peter

36
compiler/pass_2.pas
View File

@ -474,6 +474,7 @@ implementation
end;
end;
*)
{ $ifdef dummy}
if (p^.registers32<4) then
begin
for i:=1 to maxvarregs do
@ -590,7 +591,8 @@ implementation
end;
end;
end;
if (p^.registersfpu<maxfpuvarregs-2) then
{ $endif dummy}
if ((p^.registersfpu+1)<maxfpuvarregs) then
begin
for i:=1 to maxfpuvarregs do
regvars[i]:=nil;
@ -602,14 +604,31 @@ implementation
symtablestack^.next^.foreach({$ifndef TP}@{$endif}searchregvars);
{$endif dummy}
{ hold needed registers free }
for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu+1 do
regvars[i]:=nil;
{ in non leaf procedures we must be very careful }
{ with assigning registers }
if (procinfo.flags and pi_do_call)<>0 then
begin
for i:=maxfpuvarregs downto 2 do
regvars[i]:=nil;
end
else
begin
for i:=maxfpuvarregs downto maxfpuvarregs-p^.registersfpu do
regvars[i]:=nil;
end;
{ now assign register }
for i:=1 to maxfpuvarregs-p^.registersfpu do
for i:=1 to maxfpuvarregs do
begin
if assigned(regvars[i]) then
begin
regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
{ reserve place on the FPU stack }
{$ifdef i386}
procinfo.aktentrycode^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
{ ... and clean it up }
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
{$endif i386}
{$ifdef dummy}
{ parameter must be load }
if regvars_para[i] then
@ -672,7 +691,14 @@ implementation
end.
{
$Log$
Revision 1.36 1999-09-07 14:12:35 jonas
Revision 1.37 1999-09-15 20:35:41 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.36 1999/09/07 14:12:35 jonas
* framepointer cannot be changed to esp for methods
Revision 1.35 1999/08/27 10:46:26 pierre

19
compiler/pexpr.pas
View File

@ -1787,9 +1787,17 @@ _KLAMMERAFFE : begin
consume(_LKLAMMER);
p1:=factor(true);
consume(_RKLAMMER);
if token in [_CARET,_POINT,_LECKKLAMMER] then
begin
{ we need the resulttype }
{ of the expression in pd }
do_firstpass(p1);
pd:=p1^.resulttype;
again:=true;
postfixoperators;
end;
end
else
p1:=factor(true);
got_addrn:=false;
p1:=gensinglenode(addrn,p1);
@ -2092,7 +2100,14 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.142 1999-09-13 16:26:32 peter
Revision 1.143 1999-09-15 20:35:41 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.142 1999/09/13 16:26:32 peter
* fix crash with empty object as childs
Revision 1.141 1999/09/11 19:47:26 florian

13
compiler/psub.pas
View File

@ -1045,7 +1045,7 @@ const
handler : {$ifndef TP}@{$endif}pd_intern;
pocall : [pocall_internconst];
pooption : [];
mutexclpocall : [pocall_internproc];
mutexclpocall : [];
mutexclpotype : [potype_operator];
mutexclpo : []
),(
@ -1054,7 +1054,7 @@ const
handler : {$ifndef TP}@{$endif}pd_intern;
pocall : [pocall_internproc];
pooption : [];
mutexclpocall : [pocall_internconst,pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl];
mutexclpocall : [pocall_inline,pocall_clearstack,pocall_leftright,pocall_cdecl];
mutexclpotype : [potype_constructor,potype_destructor,potype_operator];
mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck]
),(
@ -2053,7 +2053,14 @@ end.
{
$Log$
Revision 1.20 1999-09-10 18:48:09 florian
Revision 1.21 1999-09-15 20:35:42 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.20 1999/09/10 18:48:09 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* most things for stored properties fixed

11
compiler/ra386int.pas
View File

@ -337,7 +337,7 @@ begin
Begin
actasmpattern:=actasmpattern+c;
c:=current_scanner^.asmgetchar;
if c in ['0'..'9'] then
if c in ['0'..'7'] then
actasmpattern:=actasmpattern + c
else
Message(asmr_e_invalid_fpu_register);
@ -1752,7 +1752,14 @@ begin
end.
{
$Log$
Revision 1.46 1999-09-08 16:04:03 peter
Revision 1.47 1999-09-15 20:35:43 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.46 1999/09/08 16:04:03 peter
* better support for object fields and more error checks for
field accesses which create buggy code

125
compiler/symdef.inc
View File

@ -3008,64 +3008,68 @@ Const local_symtable_index : longint = $8001;
pdc, pdc2, pdcbefore : pdefcoll;
methodkind, paracount, paraspec : byte;
begin
{ write method id and name }
rttilist^.concat(new(pai_const,init_8bit(tkmethod)));
write_rtti_name;
{ write kind of method (can only be function or procedure)}
if retdef = pdef(voiddef) then { ### typecast shoudln't be necessary! (sg) }
methodkind := mkProcedure
else
methodkind := mkFunction;
rttilist^.concat(new(pai_const,init_8bit(methodkind)));
{ get # of parameters }
paracount:=0;
pdc:=para1;
while assigned(pdc) do
if po_methodpointer in procoptions then
begin
inc(paracount);
pdc:=pdc^.next;
{ write method id and name }
rttilist^.concat(new(pai_const,init_8bit(tkmethod)));
write_rtti_name;
{ write kind of method (can only be function or procedure)}
if retdef = pdef(voiddef) then { ### typecast shoudln't be necessary! (sg) }
methodkind := mkProcedure
else
methodkind := mkFunction;
rttilist^.concat(new(pai_const,init_8bit(methodkind)));
{ get # of parameters }
paracount:=0;
pdc:=para1;
while assigned(pdc) do
begin
inc(paracount);
pdc:=pdc^.next;
end;
rttilist^.concat(new(pai_const,init_8bit(paracount)));
{ write parameter info. The parameters must be written in reverse order
if this method uses right to left parameter pushing! }
pdc:=para1;
if assigned(pdc) and not (pocall_leftright in proccalloptions) then
while assigned(pdc^.next) do pdc := pdc^.next;
while assigned(pdc) do
begin
case pdc^.paratyp of
vs_value: paraspec := 0;
vs_const: paraspec := pfConst;
vs_var : paraspec := pfVar;
end;
{ write flags for current parameter }
rttilist^.concat(new(pai_const,init_8bit(paraspec)));
{ write name of current parameter ### how can I get this??? (sg)}
rttilist^.concat(new(pai_const,init_8bit(0)));
{ write name of type of current parameter }
pdc^.data^.write_rtti_name;
if pocall_leftright in proccalloptions then
pdc:=pdc^.next
else
begin
{ find previous argument }
pdcbefore := nil;
pdc2 := para1;
while pdc2 <> pdc do
begin
pdcbefore := pdc2;
pdc2 := pdc2^.next;
end;
pdc := pdcbefore;
end;
end;
{ write name of result type }
retdef^.write_rtti_name;
end;
rttilist^.concat(new(pai_const,init_8bit(paracount)));
{ write parameter info. The parameters must be written in reverse order
if this method uses right to left parameter pushing! }
pdc:=para1;
if assigned(pdc) and not (pocall_leftright in proccalloptions) then
while assigned(pdc^.next) do pdc := pdc^.next;
while assigned(pdc) do
begin
case pdc^.paratyp of
vs_value: paraspec := 0;
vs_const: paraspec := pfConst;
vs_var : paraspec := pfVar;
end;
{ write flags for current parameter }
rttilist^.concat(new(pai_const,init_8bit(paraspec)));
{ write name of current parameter ### how can I get this??? (sg)}
rttilist^.concat(new(pai_const,init_8bit(0)));
{ write name of type of current parameter }
pdc^.data^.write_rtti_name;
if pocall_leftright in proccalloptions then
pdc:=pdc^.next
else
begin
{ find previous argument }
pdcbefore := nil;
pdc2 := para1;
while pdc2 <> pdc do
begin
pdcbefore := pdc2;
pdc2 := pdc2^.next;
end;
pdc := pdcbefore;
end;
end;
{ write name of result type }
retdef^.write_rtti_name;
end;
@ -3746,7 +3750,14 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.162 1999-09-12 08:48:09 florian
Revision 1.163 1999-09-15 20:35:44 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.162 1999/09/12 08:48:09 florian
* bugs 593 and 607 fixed
* some other potential bugs with array constructors fixed
* for classes compiled in $M+ and it's childs, the default access method

13
compiler/tcadd.pas
View File

@ -104,6 +104,8 @@ implementation
if (p^.treetype=starstarn) or
(ld^.deftype=recorddef) or
((ld^.deftype=arraydef) and
not((cs_mmx in aktlocalswitches) and
is_mmx_able_array(ld)) and
(not (rd^.deftype in [setdef,orddef])) and
(not is_chararray(ld))
) or
@ -115,6 +117,8 @@ implementation
) or
(rd^.deftype=recorddef) or
((rd^.deftype=arraydef) and
not((cs_mmx in aktlocalswitches) and
is_mmx_able_array(rd)) and
(not (ld^.deftype in [setdef,orddef])) and
(not is_chararray(rd))
) or
@ -1135,7 +1139,14 @@ implementation
end.
{
$Log$
Revision 1.47 1999-09-13 16:28:05 peter
Revision 1.48 1999-09-15 20:35:45 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.47 1999/09/13 16:28:05 peter
* typo in previous commit open_array -> chararray :(
Revision 1.46 1999/09/10 15:40:46 peter

135
compiler/tcinl.pas
View File

@ -94,6 +94,49 @@ implementation
end;
end;
function getconstrealvalue : bestreal;
begin
case p^.left^.treetype of
ordconstn:
getconstrealvalue:=p^.left^.value;
realconstn:
getconstrealvalue:=p^.left^.value_real;
else
internalerror(309992);
end;
end;
procedure setconstrealvalue(r : bestreal);
var
hp : ptree;
begin
hp:=genrealconstnode(r,bestrealdef^);
disposetree(p);
p:=hp;
firstpass(p);
end;
procedure handleextendedfunction;
begin
p^.location.loc:=LOC_FPU;
p^.resulttype:=s80floatdef;
if (p^.left^.resulttype^.deftype<>floatdef) or
(pfloatdef(p^.left^.resulttype)^.typ<>s80real) then
begin
p^.left:=gentypeconvnode(p^.left,s80floatdef);
firstpass(p^.left);
end;
p^.registers32:=p^.left^.registers32;
p^.registersfpu:=p^.left^.registersfpu;
{$ifdef SUPPORT_MMX}
p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
end;
begin
store_valid:=must_be_valid;
store_count_ref:=count_ref;
@ -1079,6 +1122,89 @@ implementation
CGMessage(type_e_varid_or_typeid_expected);
end;
in_cos_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
setconstrealvalue(cos(getconstrealvalue))
else
handleextendedfunction;
end;
in_sin_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
setconstrealvalue(sin(getconstrealvalue))
else
handleextendedfunction;
end;
in_arctan_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
setconstrealvalue(arctan(getconstrealvalue))
else
handleextendedfunction;
end;
in_pi:
if block_type=bt_const then
setconstrealvalue(pi)
else
begin
p^.location.loc:=LOC_FPU;
p^.resulttype:=s80floatdef;
end;
in_abs_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
setconstrealvalue(abs(getconstrealvalue))
else
handleextendedfunction;
end;
in_sqr_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
setconstrealvalue(sqr(getconstrealvalue))
else
handleextendedfunction;
end;
in_sqrt_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
begin
vr:=getconstrealvalue;
if vr<0.0 then
begin
CGMessage(type_e_wrong_math_argument);
setconstrealvalue(0);
end
else
setconstrealvalue(sqrt(vr));
end
else
handleextendedfunction;
end;
in_ln_extended:
begin
if p^.left^.treetype in [ordconstn,realconstn] then
begin
vr:=getconstrealvalue;
if vr<=0.0 then
begin
CGMessage(type_e_wrong_math_argument);
setconstrealvalue(0);
end
else
setconstrealvalue(ln(vr));
end
else
handleextendedfunction;
end;
{$ifdef SUPPORT_MMX}
in_mmx_pcmpeqb..in_mmx_pcmpgtw:
begin
@ -1124,7 +1250,14 @@ implementation
end.
{
$Log$
Revision 1.50 1999-09-07 14:05:11 pierre
Revision 1.51 1999-09-15 20:35:46 florian
* small fix to operator overloading when in MMX mode
+ the compiler uses now fldz and fld1 if possible
+ some fixes to floating point registers
+ some math. functions (arctan, ln, sin, cos, sqrt, sqr, pi) are now inlined
* .... ???
Revision 1.50 1999/09/07 14:05:11 pierre
* halt removed in do_lowhigh
Revision 1.49 1999/08/28 15:34:21 florian