paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 02:32:51 +02:00
Code Issues Packages Projects Releases Wiki Activity

* procinfo is now a pointer

Browse Source 
* support for result setting in sub procedure
This commit is contained in:
peter 1999-09-27 23:44:46 +00:00
parent eb72952214
commit 6b1ab5eb31
36 changed files with 2123 additions and 1965 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
compiler/cg386cal.pas
View File

@ -104,7 +104,7 @@ implementation
{ always a register }
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
emit_reg_ref(A_MOV,S_L,
p^.left^.location.register,r);
end
@ -122,7 +122,7 @@ implementation
begin
emit_ref_reg(A_LEA,S_L,
newreference(p^.left^.location.reference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
emit_reg_ref(A_MOV,S_L,R_EDI,r);
end
else
@ -142,7 +142,7 @@ implementation
begin
emit_ref_reg(A_LEA,S_L,
newreference(p^.left^.location.reference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
emit_reg_ref(A_MOV,S_L,R_EDI,r);
end
else
@ -167,7 +167,7 @@ implementation
begin
emit_ref_reg(A_LEA,S_L,
newreference(p^.left^.location.reference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
emit_reg_ref(A_MOV,S_L,
R_EDI,r);
end
@ -365,7 +365,7 @@ implementation
begin
reset_reference(funcretref);
funcretref.offset:=gettempofsizepersistant(p^.procdefinition^.retdef^.size);
funcretref.base:=procinfo.framepointer;
funcretref.base:=procinfo^.framepointer;
end
else
gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
@ -404,7 +404,7 @@ implementation
begin
emit_ref_reg(A_LEA,S_L,
newreference(funcretref),R_EDI);
r:=new_reference(procinfo.framepointer,inlinecode^.retoffset);
r:=new_reference(procinfo^.framepointer,inlinecode^.retoffset);
emit_reg_ref(A_MOV,S_L,
R_EDI,r);
end
@ -441,7 +441,7 @@ implementation
else
begin
r^.offset:=p^.symtable^.datasize;
r^.base:=procinfo.framepointer;
r^.base:=procinfo^.framepointer;
end; }
r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.withreference^;
if (not pwithsymtable(p^.symtable)^.direct_with) or
@ -688,23 +688,23 @@ implementation
begin
new(r);
reset_reference(r^);
r^.offset:=procinfo.framepointer_offset;
r^.base:=procinfo.framepointer;
r^.offset:=procinfo^.framepointer_offset;
r^.base:=procinfo^.framepointer;
emit_ref(A_PUSH,S_L,r)
end
{ this is only true if the difference is one !!
but it cannot be more !! }
else if (lexlevel=pprocdef(p^.procdefinition)^.parast^.symtablelevel-1) then
begin
emit_reg(A_PUSH,S_L,procinfo.framepointer)
emit_reg(A_PUSH,S_L,procinfo^.framepointer)
end
else if (lexlevel>pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
begin
hregister:=getregister32;
new(r);
reset_reference(r^);
r^.offset:=procinfo.framepointer_offset;
r^.base:=procinfo.framepointer;
r^.offset:=procinfo^.framepointer_offset;
r^.base:=procinfo^.framepointer;
emit_ref_reg(A_MOV,S_L,r,hregister);
for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
begin
@ -712,7 +712,7 @@ implementation
reset_reference(r^);
{we should get the correct frame_pointer_offset at each level
how can we do this !!! }
r^.offset:=procinfo.framepointer_offset;
r^.offset:=procinfo^.framepointer_offset;
r^.base:=hregister;
emit_ref_reg(A_MOV,S_L,r,hregister);
end;
@ -881,7 +881,7 @@ implementation
else if (pushedparasize=8) and
not(cs_littlesize in aktglobalswitches) and
(aktoptprocessor=ClassP5) and
(procinfo._class=nil) then
(procinfo^._class=nil) then
begin
emit_reg(A_POP,S_L,R_EDI);
emit_reg(A_POP,S_L,R_ESI);
@ -1149,7 +1149,7 @@ implementation
var st : psymtable;
oldprocsym : pprocsym;
para_size : longint;
oldprocinfo : tprocinfo;
oldprocinfo : pprocinfo;
{ just dummies for genentrycode }
nostackframe,make_global : boolean;
proc_names : tstringcontainer;
@ -1165,8 +1165,8 @@ implementation
oldprocinfo:=procinfo;
{ set the return value }
aktprocsym:=p^.inlineprocsym;
procinfo.retdef:=aktprocsym^.definition^.retdef;
procinfo.retoffset:=p^.retoffset;
procinfo^.retdef:=aktprocsym^.definition^.retdef;
procinfo^.retoffset:=p^.retoffset;
{ arg space has been filled by the parent secondcall }
st:=aktprocsym^.definition^.localst;
{ set it to the same lexical level }
@ -1217,7 +1217,11 @@ implementation
end.
{
$Log$
Revision 1.105 1999-09-26 13:26:02 florian
Revision 1.106 1999-09-27 23:44:46 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.105 1999/09/26 13:26:02 florian
* exception patch of Romio nevertheless the excpetion handling
needs some corections regarding register saving
* gettempansistring is again a procedure

28
compiler/cg386flw.pas
View File

@ -416,10 +416,10 @@ implementation
else
internalerror(2001);
end;
case procinfo.retdef^.deftype of
case procinfo^.retdef^.deftype of
orddef,
enumdef : begin
case procinfo.retdef^.size of
case procinfo^.retdef^.size of
4 : if is_mem then
emit_ref_reg(A_MOV,S_L,
newreference(p^.left^.location.reference),R_EAX)
@ -447,7 +447,7 @@ implementation
p^.left^.location.register,R_EAX);
end;
floatdef : begin
if pfloatdef(procinfo.retdef)^.typ=f32bit then
if pfloatdef(procinfo^.retdef)^.typ=f32bit then
begin
if is_mem then
emit_ref_reg(A_MOV,S_L,
@ -457,7 +457,7 @@ implementation
end
else
if is_mem then
floatload(pfloatdef(procinfo.retdef)^.typ,p^.left^.location.reference);
floatload(pfloatdef(procinfo^.retdef)^.typ,p^.left^.location.reference);
end;
end;
do_jmp:
@ -766,12 +766,12 @@ do_jmp:
new(hp);
reset_reference(hp^);
hp^.offset:=8;
hp^.base:=procinfo.framepointer;
hp^.base:=procinfo^.framepointer;
emit_const_ref(A_CMP,S_L,-1,hp);
emitjmp(C_NE,nofreememcall);
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo._class^.vmt_offset;
hp^.offset:=procinfo^._class^.vmt_offset;
hp^.base:=R_ESI;
emit_ref_reg(A_MOV,S_L,hp,R_EDI);
new(hp);
@ -781,8 +781,8 @@ do_jmp:
emit_ref(A_PUSH,S_L,hp);
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.ESI_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.ESI_offset;
hp^.base:=procinfo^.framepointer;
emit_ref_reg(A_LEA,S_L,hp,R_EDI);
emit_reg(A_PUSH,S_L,R_EDI);
emitcall('FPC_FREEMEM');
@ -793,7 +793,7 @@ do_jmp:
{ reset VMT field for static object }
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo._class^.vmt_offset;
hp^.offset:=procinfo^._class^.vmt_offset;
hp^.base:=R_ESI;
emit_const_ref(A_MOV,S_L,0,hp);
emitlab(afterfreememcall);
@ -801,8 +801,8 @@ do_jmp:
{ also reset to zero in the stack }
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.ESI_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.ESI_offset;
hp^.base:=procinfo^.framepointer;
emit_reg_ref(A_MOV,S_L,R_ESI,hp); *)
emitjmp(C_None,faillabel);
end;
@ -811,7 +811,11 @@ do_jmp:
end.
{
$Log$
Revision 1.51 1999-09-26 13:26:05 florian
Revision 1.52 1999-09-27 23:44:46 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.51 1999/09/26 13:26:05 florian
* exception patch of Romio nevertheless the excpetion handling
needs some corections regarding register saving
* gettempansistring is again a procedure

31
compiler/cg386ld.pas
View File

@ -165,7 +165,7 @@ implementation
if (symtabletype in [parasymtable,inlinelocalsymtable,
inlineparasymtable,localsymtable]) then
begin
p^.location.reference.base:=procinfo.framepointer;
p^.location.reference.base:=procinfo^.framepointer;
p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address+p^.symtable^.address_fixup;
if (symtabletype in [localsymtable,inlinelocalsymtable]) then
@ -181,8 +181,8 @@ implementation
hregister:=getregister32;
{ make a reference }
hp:=new_reference(procinfo.framepointer,
procinfo.framepointer_offset);
hp:=new_reference(procinfo^.framepointer,
procinfo^.framepointer_offset);
emit_ref_reg(A_MOV,S_L,hp,hregister);
@ -207,7 +207,7 @@ implementation
end;
stt_exceptsymtable:
begin
p^.location.reference.base:=procinfo.framepointer;
p^.location.reference.base:=procinfo^.framepointer;
p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
end;
objectsymtable:
@ -228,7 +228,7 @@ implementation
{ symtable datasize field
contains the offset of the temp
stored }
{ hp:=new_reference(procinfo.framepointer,
{ hp:=new_reference(procinfo^.framepointer,
p^.symtable^.datasize);
emit_ref_reg(A_MOV,S_L,hp,hregister);}
@ -783,14 +783,14 @@ implementation
begin
reset_reference(p^.location.reference);
hr_valid:=false;
if @procinfo<>pprocinfo(p^.funcretprocinfo) then
if procinfo<>pprocinfo(p^.funcretprocinfo) then
begin
hr:=getregister32;
hr_valid:=true;
hp:=new_reference(procinfo.framepointer,
procinfo.framepointer_offset);
hp:=new_reference(procinfo^.framepointer,
procinfo^.framepointer_offset);
emit_ref_reg(A_MOV,S_L,hp,hr);
pp:=procinfo.parent;
pp:=procinfo^.parent;
{ walk up the stack frame }
while pp<>pprocinfo(p^.funcretprocinfo) do
begin
@ -800,10 +800,13 @@ implementation
pp:=pp^.parent;
end;
p^.location.reference.base:=hr;
p^.location.reference.offset:=pp^.retoffset;
end
else
p^.location.reference.base:=procinfo.framepointer;
p^.location.reference.offset:=procinfo.retoffset;
begin
p^.location.reference.base:=procinfo^.framepointer;
p^.location.reference.offset:=procinfo^.retoffset;
end;
if ret_in_param(p^.retdef) then
begin
if not hr_valid then
@ -986,7 +989,11 @@ implementation
end.
{
$Log$
Revision 1.87 1999-09-26 13:26:06 florian
Revision 1.88 1999-09-27 23:44:47 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.87 1999/09/26 13:26:06 florian
* exception patch of Romio nevertheless the excpetion handling
needs some corections regarding register saving
* gettempansistring is again a procedure

8
compiler/cg386set.pas
View File

@ -753,7 +753,7 @@ implementation
getlabel(endlabel);
getlabel(elselabel);
if (cs_create_smart in aktmoduleswitches) then
jumpsegment:=procinfo.aktlocaldata
jumpsegment:=procinfo^.aktlocaldata
else
jumpsegment:=datasegment;
with_sign:=is_signed(p^.left^.resulttype);
@ -919,7 +919,11 @@ implementation
end.
{
$Log$
Revision 1.41 1999-09-20 16:38:52 peter
Revision 1.42 1999-09-27 23:44:48 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.41 1999/09/20 16:38:52 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.

20
compiler/cg68kcal.pas
View File

@ -525,7 +525,7 @@ implementation
new(r);
reset_reference(r^);
r^.offset:=p^.symtable^.datasize;
r^.base:=procinfo.framepointer;
r^.base:=procinfo^.framepointer;
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,R_A5)));
end;
@ -750,23 +750,23 @@ implementation
begin
new(r);
reset_reference(r^);
r^.offset:=procinfo.framepointer_offset;
r^.base:=procinfo.framepointer;
r^.offset:=procinfo^.framepointer_offset;
r^.base:=procinfo^.framepointer;
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)))
end
{ this is only true if the difference is one !!
but it cannot be more !! }
else if lexlevel=(pprocdef(p^.procdefinition)^.parast^.symtablelevel)-1 then
begin
exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,procinfo.framepointer,R_SPPUSH)))
exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,procinfo^.framepointer,R_SPPUSH)))
end
else if lexlevel>(pprocdef(p^.procdefinition)^.parast^.symtablelevel) then
begin
hregister:=getaddressreg;
new(r);
reset_reference(r^);
r^.offset:=procinfo.framepointer_offset;
r^.base:=procinfo.framepointer;
r^.offset:=procinfo^.framepointer_offset;
r^.base:=procinfo^.framepointer;
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,hregister)));
for i:=(pprocdef(p^.procdefinition)^.parast^.symtablelevel) to lexlevel-1 do
begin
@ -774,7 +774,7 @@ implementation
reset_reference(r^);
{we should get the correct frame_pointer_offset at each level
how can we do this !!! }
r^.offset:=procinfo.framepointer_offset;
r^.offset:=procinfo^.framepointer_offset;
r^.base:=hregister;
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,hregister)));
end;
@ -1069,7 +1069,11 @@ implementation
end.
{
$Log$
Revision 1.19 1999-09-16 23:05:51 florian
Revision 1.20 1999-09-27 23:44:48 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.19 1999/09/16 23:05:51 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.18 1999/09/16 11:34:52 pierre

24
compiler/cg68kflw.pas
View File

@ -412,10 +412,10 @@ implementation
end;
else internalerror(2001);
end;
case procinfo.retdef^.deftype of
case procinfo^.retdef^.deftype of
orddef,
enumdef : begin
case procinfo.retdef^.size of
case procinfo^.retdef^.size of
4 : if is_mem then
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
newreference(p^.left^.location.reference),R_D0)))
@ -444,15 +444,15 @@ implementation
floatdef : begin
{ floating point return values .... }
{ single are returned in d0 }
if (pfloatdef(procinfo.retdef)^.typ=f32bit) or
(pfloatdef(procinfo.retdef)^.typ=s32real) then
if (pfloatdef(procinfo^.retdef)^.typ=f32bit) or
(pfloatdef(procinfo^.retdef)^.typ=s32real) then
begin
if is_mem then
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
newreference(p^.left^.location.reference),R_D0)))
else
begin
if pfloatdef(procinfo.retdef)^.typ=f32bit then
if pfloatdef(procinfo^.retdef)^.typ=f32bit then
emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)
else
begin
@ -472,7 +472,7 @@ implementation
if is_mem then
begin
exprasmlist^.concat(new(paicpu,op_ref_reg(A_FMOVE,
getfloatsize(pfloatdef(procinfo.retdef)^.typ),
getfloatsize(pfloatdef(procinfo^.retdef)^.typ),
newreference(p^.left^.location.reference),R_FP0)));
end
else
@ -481,7 +481,7 @@ implementation
{ convert from extended to correct type }
{ when storing }
exprasmlist^.concat(new(paicpu,op_reg_reg(A_FMOVE,
getfloatsize(pfloatdef(procinfo.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
getfloatsize(pfloatdef(procinfo^.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
end;
end;
end;
@ -770,8 +770,8 @@ do_jmp:
{ also reset to zero in the stack }
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.ESI_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.ESI_offset;
hp^.base:=procinfo^.framepointer;
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVE,S_L,R_A5,hp)));
exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
end;
@ -779,7 +779,11 @@ do_jmp:
end.
{
$Log$
Revision 1.10 1999-09-16 23:05:51 florian
Revision 1.11 1999-09-27 23:44:48 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.10 1999/09/16 23:05:51 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.9 1999/08/25 11:59:49 jonas

172
compiler/cga68k.pas
View File

@ -549,7 +549,7 @@ begin
if (cs_check_stack in aktlocalswitches) and
(target_info.target=target_m68k_linux) then
begin
procinfo.aktentrycode^.insert(new(paicpu,
procinfo^.aktentrycode^.insert(new(paicpu,
op_csymbol(A_JSR,S_NO,newcsymbol('FPC_INIT_STACK_CHECK',0))));
end
else
@ -557,9 +557,9 @@ begin
{ with a value of ZERO, and the comparison will directly check! }
if (cs_check_stack in aktlocalswitches) then
begin
procinfo.aktentrycode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
procinfo^.aktentrycode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
newcsymbol('FPC_STACKCHECK',0))));
procinfo.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,
procinfo^.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,
0,R_D0)));
end;
@ -577,25 +577,25 @@ begin
end;
hp:=pused_unit(hp^.next);
end;
procinfo.aktentrycode^.insertlist(@unitinits);
procinfo^.aktentrycode^.insertlist(@unitinits);
unitinits.done;
end;
{ a constructor needs a help procedure }
if potype_constructor=aktprocsym^.definition^.proctypeoption then
begin
if procinfo._class^.is_class then
if procinfo^._class^.is_class then
begin
procinfo.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel)));
procinfo.aktentrycode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
procinfo^.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel)));
procinfo^.aktentrycode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
newcsymbol('FPC_NEW_CLASS',0))));
end
else
begin
procinfo.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel)));
procinfo.aktentrycode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
procinfo^.aktentrycode^.insert(new(pai_labeled,init(A_BEQ,quickexitlabel)));
procinfo^.aktentrycode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
procinfo.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,procinfo._class^.vmt_offset,R_D0)));
procinfo^.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,procinfo^._class^.vmt_offset,R_D0)));
end;
end;
{ don't load ESI, does the caller }
@ -606,7 +606,7 @@ begin
{$endif GDB}
{ omit stack frame ? }
if procinfo.framepointer=stack_pointer then
if procinfo^.framepointer=stack_pointer then
begin
CGMessage(cg_d_stackframe_omited);
nostackframe:=true;
@ -615,7 +615,7 @@ begin
(aktprocsym^.definition^.proctypeoption=potype_unitfinalize) then
parasize:=0
else
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset;
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.call_offset;
end
else
begin
@ -624,7 +624,7 @@ begin
(aktprocsym^.definition^.proctypeoption=potype_unitfinalize) then
parasize:=0
else
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-8;
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.call_offset-8;
nostackframe:=false;
if stackframe<>0 then
begin
@ -636,16 +636,16 @@ begin
{ If only not in main program, do we setup stack checking }
if (aktprocsym^.definition^.proctypeoption<>potype_proginit) then
Begin
procinfo.aktentrycode^.insert(new(paicpu,
procinfo^.aktentrycode^.insert(new(paicpu,
op_csymbol(A_JSR,S_NO,newcsymbol('FPC_STACKCHECK',0))));
procinfo.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,stackframe,R_D0)));
procinfo^.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,stackframe,R_D0)));
end;
end;
{ to allocate stack space }
{ here we allocate space using link signed 16-bit version }
{ -ve offset to allocate stack space! }
if (stackframe > -32767) and (stackframe < 32769) then
procinfo.aktentrycode^.insert(new(paicpu,op_reg_const(A_LINK,S_W,R_A6,-stackframe)))
procinfo^.aktentrycode^.insert(new(paicpu,op_reg_const(A_LINK,S_W,R_A6,-stackframe)))
else
CGMessage(cg_e_stacklimit_in_local_routine);
end
@ -656,18 +656,18 @@ begin
{ exceed 32K in size. }
if (stackframe > -32767) and (stackframe < 32769) then
begin
procinfo.aktentrycode^.insert(new(paicpu,op_const_reg(A_SUB,S_L,stackframe,R_SP)));
procinfo^.aktentrycode^.insert(new(paicpu,op_const_reg(A_SUB,S_L,stackframe,R_SP)));
{ IF only NOT in main program do we check the stack normally }
if (cs_check_stack in aktlocalswitches) and
(aktprocsym^.definition^.proctypeoption<>potype_proginit) then
begin
procinfo.aktentrycode^.insert(new(paicpu,
procinfo^.aktentrycode^.insert(new(paicpu,
op_csymbol(A_JSR,S_NO,newcsymbol('FPC_STACKCHECK',0))));
procinfo.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,
procinfo^.aktentrycode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,
stackframe,R_D0)));
end;
procinfo.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_SP,R_A6)));
procinfo.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A6,R_SPPUSH)));
procinfo^.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_SP,R_A6)));
procinfo^.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A6,R_SPPUSH)));
end
else
CGMessage(cg_e_stacklimit_in_local_routine);
@ -675,8 +675,8 @@ begin
end {endif stackframe<>0 }
else
begin
procinfo.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_SP,R_A6)));
procinfo.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A6,R_SPPUSH)));
procinfo^.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_SP,R_A6)));
procinfo^.aktentrycode^.insert(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A6,R_SPPUSH)));
end;
end;
@ -687,7 +687,7 @@ begin
{proc_names.insert(aktprocsym^.definition^.mangledname);}
if (aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
((procinfo._class<>nil) and (procinfo._class^.owner^.
((procinfo^._class<>nil) and (procinfo^._class^.owner^.
symtabletype=globalsymtable)) then
make_global:=true;
hs:=proc_names.get;
@ -701,9 +701,9 @@ begin
while hs<>'' do
begin
if make_global then
procinfo.aktentrycode^.insert(new(pai_symbol,initname_global(hs,0)))
procinfo^.aktentrycode^.insert(new(pai_symbol,initname_global(hs,0)))
else
procinfo.aktentrycode^.insert(new(pai_symbol,initname(hs,0)));
procinfo^.aktentrycode^.insert(new(pai_symbol,initname(hs,0)));
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
begin
@ -723,14 +723,14 @@ begin
if (cs_debuginfo in aktmoduleswitches) then
begin
if target_os.use_function_relative_addresses then
procinfo.aktentrycode^.insert(stab_function_name);
if make_global or ((procinfo.flags and pi_is_global) <> 0) then
procinfo^.aktentrycode^.insert(stab_function_name);
if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
aktprocsym^.is_global := True;
aktprocsym^.isstabwritten:=true;
end;
{$endif GDB}
{ Alignment required for Motorola }
procinfo.aktentrycode^.insert(new(pai_align,init(2)));
procinfo^.aktentrycode^.insert(new(pai_align,init(2)));
end;
{Generate the exit code for a procedure.}
@ -742,21 +742,21 @@ var hr:Preference; {This is for function results.}
begin
{ !!!! insert there automatic destructors }
procinfo.aktexitcode^.insert(new(pai_label,init(aktexitlabel)));
procinfo^.aktexitcode^.insert(new(pai_label,init(aktexitlabel)));
{ call the destructor help procedure }
if potype_destructor=aktprocsym^.definition^.proctypeoption then
begin
if procinfo._class^.is_class then
if procinfo^._class^.is_class then
begin
procinfo.aktexitcode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
procinfo^.aktexitcode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
newcsymbol('FPC_DISPOSE_CLASS',0))));
end
else
begin
procinfo.aktexitcode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
procinfo^.aktexitcode^.insert(new(paicpu,op_csymbol(A_JSR,S_NO,
newcsymbol('FPC_HELP_DESTRUCTOR',0))));
procinfo.aktexitcode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,procinfo._class^.vmt_offset,R_D0)));
procinfo^.aktexitcode^.insert(new(paicpu,op_const_reg(A_MOVE,S_L,procinfo^._class^.vmt_offset,R_D0)));
end;
end;
@ -765,60 +765,60 @@ begin
if (potype_proginit=aktprocsym^.definition^.proctypeoption) and
(target_info.target<>target_m68k_PalmOS) then
begin
procinfo.aktexitcode^.concat(new(paicpu,op_csymbol(A_JSR,S_NO,newcsymbol('FPC_DO_EXIT',0))));
procinfo^.aktexitcode^.concat(new(paicpu,op_csymbol(A_JSR,S_NO,newcsymbol('FPC_DO_EXIT',0))));
end;
{ handle return value }
if po_assembler in aktprocsym^.definition^.procoptions then
if (aktprocsym^.definition^.proctypeoption<>potype_constructor) then
begin
if procinfo.retdef<>pdef(voiddef) then
if procinfo^.retdef<>pdef(voiddef) then
begin
if not procinfo.funcret_is_valid then
if not procinfo^.funcret_is_valid then
CGMessage(sym_w_function_result_not_set);
new(hr);
reset_reference(hr^);
hr^.offset:=procinfo.retoffset;
hr^.base:=procinfo.framepointer;
if (procinfo.retdef^.deftype in [orddef,enumdef]) then
hr^.offset:=procinfo^.retoffset;
hr^.base:=procinfo^.framepointer;
if (procinfo^.retdef^.deftype in [orddef,enumdef]) then
begin
case procinfo.retdef^.size of
4 : procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hr,R_D0)));
2 : procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_W,hr,R_D0)));
1 : procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_B,hr,R_D0)));
case procinfo^.retdef^.size of
4 : procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hr,R_D0)));
2 : procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_W,hr,R_D0)));
1 : procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_B,hr,R_D0)));
end;
end
else
if (procinfo.retdef^.deftype in [pointerdef,enumdef,procvardef]) or
((procinfo.retdef^.deftype=setdef) and
(psetdef(procinfo.retdef)^.settype=smallset)) then
procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hr,R_D0)))
if (procinfo^.retdef^.deftype in [pointerdef,enumdef,procvardef]) or
((procinfo^.retdef^.deftype=setdef) and
(psetdef(procinfo^.retdef)^.settype=smallset)) then
procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hr,R_D0)))
else
if (procinfo.retdef^.deftype=floatdef) then
if (procinfo^.retdef^.deftype=floatdef) then
begin
if pfloatdef(procinfo.retdef)^.typ=f32bit then
if pfloatdef(procinfo^.retdef)^.typ=f32bit then
begin
{ Isnt this missing ? }
procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hr,R_D0)));
procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hr,R_D0)));
end
else
begin
{ how the return value is handled }
{ if single value, then return in d0, otherwise return in }
{ TRUE FPU register (does not apply in emulation mode) }
if (pfloatdef(procinfo.retdef)^.typ = s32real) then
if (pfloatdef(procinfo^.retdef)^.typ = s32real) then
begin
procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,
procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,
S_L,hr,R_D0)))
end
else
begin
if cs_fp_emulation in aktmoduleswitches then
procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,
procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_MOVE,
S_L,hr,R_D0)))
else
procinfo.aktexitcode^.concat(new(paicpu,op_ref_reg(A_FMOVE,
getfloatsize(pfloatdef(procinfo.retdef)^.typ),hr,R_FP0)));
procinfo^.aktexitcode^.concat(new(paicpu,op_ref_reg(A_FMOVE,
getfloatsize(pfloatdef(procinfo^.retdef)^.typ),hr,R_FP0)));
end;
end;
end
@ -830,15 +830,15 @@ begin
begin
{ successful constructor deletes the zero flag }
{ and returns self in accumulator }
procinfo.aktexitcode^.concat(new(pai_label,init(quickexitlabel)));
procinfo^.aktexitcode^.concat(new(pai_label,init(quickexitlabel)));
{ eax must be set to zero if the allocation failed !!! }
procinfo.aktexitcode^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A5,R_D0)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,R_A5,R_D0)));
{ faster then OR on mc68000/mc68020 }
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_TST,S_L,R_D0)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_TST,S_L,R_D0)));
end;
procinfo.aktexitcode^.concat(new(pai_label,init(aktexit2label)));
procinfo^.aktexitcode^.concat(new(pai_label,init(aktexit2label)));
if not(nostackframe) then
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_UNLK,S_NO,R_A6)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_UNLK,S_NO,R_A6)));
{ at last, the return is generated }
@ -848,12 +848,12 @@ begin
if (parasize=0) or (pocall_clearstack in aktprocsym^.definition^.proccalloptions) then
{Routines with the poclearstack flag set use only a ret.}
{ also routines with parasize=0 }
procinfo.aktexitcode^.concat(new(paicpu,op_none(A_RTS,S_NO)))
procinfo^.aktexitcode^.concat(new(paicpu,op_none(A_RTS,S_NO)))
else
{ return with immediate size possible here }
{ signed! }
if (aktoptprocessor = MC68020) and (parasize < $7FFF) then
procinfo.aktexitcode^.concat(new(paicpu,op_const(
procinfo^.aktexitcode^.concat(new(paicpu,op_const(
A_RTD,S_NO,parasize)))
{ manually restore the stack }
else
@ -863,40 +863,40 @@ begin
{ point to nowhere! }
{ save the PC counter (pop it from the stack) }
procinfo.aktexitcode^.concat(new(paicpu,op_reg_reg(
procinfo^.aktexitcode^.concat(new(paicpu,op_reg_reg(
A_MOVE,S_L,R_SPPULL,R_A0)));
{ can we do a quick addition ... }
if (parasize > 0) and (parasize < 9) then
procinfo.aktexitcode^.concat(new(paicpu,op_const_reg(
procinfo^.aktexitcode^.concat(new(paicpu,op_const_reg(
A_ADD,S_L,parasize,R_SP)))
else { nope ... }
procinfo.aktexitcode^.concat(new(paicpu,op_const_reg(
procinfo^.aktexitcode^.concat(new(paicpu,op_const_reg(
A_ADD,S_L,parasize,R_SP)));
{ endif }
{ restore the PC counter (push it on the stack) }
procinfo.aktexitcode^.concat(new(paicpu,op_reg_reg(
procinfo^.aktexitcode^.concat(new(paicpu,op_reg_reg(
A_MOVE,S_L,R_A0,R_SPPUSH)));
procinfo.aktexitcode^.concat(new(paicpu,op_none(
procinfo^.aktexitcode^.concat(new(paicpu,op_none(
A_RTS,S_NO)))
end;
{$ifdef GDB}
if cs_debuginfo in aktmoduleswitches then
begin
aktprocsym^.concatstabto(procinfo.aktexitcode);
if assigned(procinfo._class) then
procinfo.aktexitcode^.concat(new(pai_stabs,init(strpnew(
'"$t:v'+procinfo._class^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.esi_offset)))));
aktprocsym^.concatstabto(procinfo^.aktexitcode);
if assigned(procinfo^._class) then
procinfo^.aktexitcode^.concat(new(pai_stabs,init(strpnew(
'"$t:v'+procinfo^._class^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.esi_offset)))));
if (porddef(aktprocsym^.definition^.retdef) <> voiddef) then
procinfo.aktexitcode^.concat(new(pai_stabs,init(strpnew(
procinfo^.aktexitcode^.concat(new(pai_stabs,init(strpnew(
'"'+aktprocsym^.name+':X'+aktprocsym^.definition^.retdef^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.retoffset)))));
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))));
procinfo.aktexitcode^.concat(new(pai_stabn,init(strpnew('192,0,0,'
procinfo^.aktexitcode^.concat(new(pai_stabn,init(strpnew('192,0,0,'
+aktprocsym^.definition^.mangledname))));
procinfo.aktexitcode^.concat(new(pai_stabn,init(strpnew('224,0,0,'
procinfo^.aktexitcode^.concat(new(pai_stabn,init(strpnew('224,0,0,'
+lab2str(aktexit2label)))));
end;
{$endif GDB}
@ -1145,16 +1145,16 @@ end;
i : longint;
begin
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
begin
if lexlevel>normal_function_level then
begin
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.framepointer_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.framepointer_offset;
hp^.base:=procinfo^.framepointer;
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,R_A5)));
p:=procinfo.parent;
p:=procinfo^.parent;
for i:=3 to lexlevel-1 do
begin
new(hp);
@ -1174,8 +1174,8 @@ end;
begin
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.ESI_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.ESI_offset;
hp^.base:=procinfo^.framepointer;
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,R_A5)));
end;
end;
@ -1391,7 +1391,11 @@ end;
end.
{
$Log$
Revision 1.34 1999-09-16 23:05:51 florian
Revision 1.35 1999-09-27 23:44:48 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.34 1999/09/16 23:05:51 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.33 1999/09/16 11:34:54 pierre

254
compiler/cgai386.pas
View File

@ -1169,7 +1169,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
hregister:=getregister32;
{$ifdef TEMPS_NOT_PUSH}
reset_reference(href);
href.base:=procinfo.frame_pointer;
href.base:=procinfo^.frame_pointer;
href.offset:=p^.temp_offset;
emit_ref_reg(A_MOV,S_L,href,hregister);
{$else TEMPS_NOT_PUSH}
@ -1215,7 +1215,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
hregister:=getregister32;
reset_reference(href);
href.base:=procinfo.frame_pointer;
href.base:=procinfo^.frame_pointer;
href.offset:=p^.temp_offset;
emit_ref_reg(A_MOV,S_L,href,hregister);
if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
@ -1265,10 +1265,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
inc(pushedparasize,8);
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
p^.location.registerlow,r)));
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize+4);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
p^.location.registerhigh,r)));
end
@ -1283,7 +1283,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
inc(pushedparasize,4);
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,
p^.location.register,r)));
end
@ -1308,7 +1308,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end;
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
end
else
@ -1332,7 +1332,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ we must push always 16 bit }
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
end
else
@ -1358,7 +1358,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ this is the easiest case for inlined !! }
if inlined then
begin
r^.base:=procinfo.framepointer;
r^.base:=procinfo^.framepointer;
r^.offset:=para_offset-pushedparasize;
end;
exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
@ -1382,7 +1382,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ this is the easiest case for inlined !! }
if inlined then
begin
r^.base:=procinfo.framepointer;
r^.base:=procinfo^.framepointer;
r^.offset:=para_offset-pushedparasize;
end;
exprasmlist^.concat(new(paicpu,op_ref(op,opsize,r)));
@ -1402,12 +1402,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
inc(tempreference.offset,4);
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize+4);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize+4);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1424,7 +1424,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1447,7 +1447,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,opsize,
newreference(tempreference),hreg);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
end
else
@ -1469,7 +1469,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1484,7 +1484,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1495,7 +1495,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1512,7 +1512,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1523,7 +1523,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1546,7 +1546,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,opsize,
newreference(tempreference),hreg);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
end
else
@ -1564,7 +1564,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
emit_ref_reg(A_MOV,S_L,
newreference(tempreference),R_EDI);
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,S_L,R_EDI,r)));
end
else
@ -1592,7 +1592,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
inc(pushedparasize,4);
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
concatcopy(tempreference,r^,4,false,false);
end
else
@ -1622,7 +1622,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
emitlab(truelabel);
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
emit_const_ref(A_MOV,opsize,1,r);
end
else
@ -1631,7 +1631,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
emitlab(falselabel);
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
emit_const_ref(A_MOV,opsize,0,r);
end
else
@ -1658,7 +1658,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end;
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,hreg,r)));
end
else
@ -1680,7 +1680,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{$endif GDB}
if inlined then
begin
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
r:=new_reference(procinfo^.framepointer,para_offset-pushedparasize);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVQ,S_NO,
p^.location.register,r)));
end
@ -2248,16 +2248,16 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
i : longint;
begin
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
begin
if lexlevel>normal_function_level then
begin
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.framepointer_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.framepointer_offset;
hp^.base:=procinfo^.framepointer;
emit_ref_reg(A_MOV,S_L,hp,R_ESI);
p:=procinfo.parent;
p:=procinfo^.parent;
for i:=3 to lexlevel-1 do
begin
new(hp);
@ -2277,8 +2277,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
new(hp);
reset_reference(hp^);
hp^.offset:=procinfo.ESI_offset;
hp^.base:=procinfo.framepointer;
hp^.offset:=procinfo^.ESI_offset;
hp^.base:=procinfo^.framepointer;
emit_ref_reg(A_MOV,S_L,hp,R_ESI);
end;
end;
@ -2365,21 +2365,21 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
{ restore the registers of an interrupt procedure }
{ this was all with entrycode instead of exitcode !!}
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EAX)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDX)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EAX)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EBX)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ECX)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDX)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_ESI)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_L,R_EDI)));
{ .... also the segment registers }
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_DS)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_ES)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_FS)));
procinfo.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_GS)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_DS)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_ES)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_FS)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_POP,S_W,R_GS)));
{ this restores the flags }
procinfo.aktexitcode^.concat(new(paicpu,op_none(A_IRET,S_NO)));
procinfo^.aktexitcode^.concat(new(paicpu,op_none(A_IRET,S_NO)));
end;
@ -2472,11 +2472,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
pobjectdef(pvarsym(p)^.definition)^.is_class) and
pvarsym(p)^.definition^.needs_inittable then
begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
reset_reference(hr);
if psym(p)^.owner^.symtabletype=localsymtable then
begin
hr.base:=procinfo.framepointer;
hr.base:=procinfo^.framepointer;
hr.offset:=-pvarsym(p)^.address;
end
else
@ -2502,13 +2502,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
(pvarsym(p)^.varspez=vs_const) and
not(dont_copy_const_param(pvarsym(p)^.definition))}) then
begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
reset_reference(hr);
hr.symbol:=pvarsym(p)^.definition^.get_inittable_label;
emitpushreferenceaddr(hr);
reset_reference(hr);
hr.base:=procinfo.framepointer;
hr.offset:=pvarsym(p)^.address+procinfo.call_offset;
hr.base:=procinfo^.framepointer;
hr.offset:=pvarsym(p)^.address+procinfo^.call_offset;
emitpushreferenceaddr(hr);
reset_reference(hr);
@ -2536,18 +2536,18 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
(pvarsym(p)^.varspez=vs_const) { and
(dont_copy_const_param(pvarsym(p)^.definition)) } ) then
exit;
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
reset_reference(hr);
case psym(p)^.owner^.symtabletype of
localsymtable:
begin
hr.base:=procinfo.framepointer;
hr.base:=procinfo^.framepointer;
hr.offset:=-pvarsym(p)^.address;
end;
parasymtable:
begin
hr.base:=procinfo.framepointer;
hr.offset:=pvarsym(p)^.address+procinfo.call_offset;
hr.base:=procinfo^.framepointer;
hr.offset:=pvarsym(p)^.address+procinfo^.call_offset;
end;
else
hr.symbol:=newasmsymbol(pvarsym(p)^.mangledname);
@ -2576,8 +2576,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ get stack space }
new(r);
reset_reference(r^);
r^.base:=procinfo.framepointer;
r^.offset:=pvarsym(p)^.address+4+procinfo.call_offset;
r^.base:=procinfo^.framepointer;
r^.offset:=pvarsym(p)^.address+4+procinfo^.call_offset;
exprasmlist^.concat(new(paicpu,
op_ref_reg(A_MOV,S_L,r,R_EDI)));
@ -2611,8 +2611,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ now reload EDI }
new(r);
reset_reference(r^);
r^.base:=procinfo.framepointer;
r^.offset:=pvarsym(p)^.address+4+procinfo.call_offset;
r^.base:=procinfo^.framepointer;
r^.offset:=pvarsym(p)^.address+4+procinfo^.call_offset;
exprasmlist^.concat(new(paicpu,
op_ref_reg(A_MOV,S_L,r,R_EDI)));
@ -2641,16 +2641,16 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ load count }
new(r);
reset_reference(r^);
r^.base:=procinfo.framepointer;
r^.offset:=pvarsym(p)^.address+4+procinfo.call_offset;
r^.base:=procinfo^.framepointer;
r^.offset:=pvarsym(p)^.address+4+procinfo^.call_offset;
exprasmlist^.concat(new(paicpu,
op_ref_reg(A_MOV,S_L,r,R_ECX)));
{ load source }
new(r);
reset_reference(r^);
r^.base:=procinfo.framepointer;
r^.offset:=pvarsym(p)^.address+procinfo.call_offset;
r^.base:=procinfo^.framepointer;
r^.offset:=pvarsym(p)^.address+procinfo^.call_offset;
exprasmlist^.concat(new(paicpu,
op_ref_reg(A_MOV,S_L,r,R_ESI)));
@ -2690,8 +2690,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ patch the new address }
new(r);
reset_reference(r^);
r^.base:=procinfo.framepointer;
r^.offset:=pvarsym(p)^.address+procinfo.call_offset;
r^.base:=procinfo^.framepointer;
r^.offset:=pvarsym(p)^.address+procinfo^.call_offset;
exprasmlist^.concat(new(paicpu,
op_reg_ref(A_MOV,S_L,R_ESP,r)));
end
@ -2699,20 +2699,20 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if is_shortstring(pvarsym(p)^.definition) then
begin
reset_reference(href1);
href1.base:=procinfo.framepointer;
href1.offset:=pvarsym(p)^.address+procinfo.call_offset;
href1.base:=procinfo^.framepointer;
href1.offset:=pvarsym(p)^.address+procinfo^.call_offset;
reset_reference(href2);
href2.base:=procinfo.framepointer;
href2.base:=procinfo^.framepointer;
href2.offset:=-pvarsym(p)^.localvarsym^.address;
copyshortstring(href2,href1,pstringdef(pvarsym(p)^.definition)^.len,true);
end
else
begin
reset_reference(href1);
href1.base:=procinfo.framepointer;
href1.offset:=pvarsym(p)^.address+procinfo.call_offset;
href1.base:=procinfo^.framepointer;
href1.offset:=pvarsym(p)^.address+procinfo^.call_offset;
reset_reference(href2);
href2.base:=procinfo.framepointer;
href2.base:=procinfo^.framepointer;
href2.offset:=-pvarsym(p)^.localvarsym^.address;
concatcopy(href1,href2,pvarsym(p)^.definition^.size,true,true);
end;
@ -2731,10 +2731,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
if hp^.temptype in [tt_ansistring,tt_freeansistring] then
begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
new(r);
reset_reference(r^);
r^.base:=procinfo.framepointer;
r^.base:=procinfo^.framepointer;
r^.offset:=hp^.pos;
emit_const_ref(A_MOV,S_L,0,r);
end;
@ -2753,9 +2753,9 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
if hp^.temptype in [tt_ansistring,tt_freeansistring] then
begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
reset_reference(hr);
hr.base:=procinfo.framepointer;
hr.base:=procinfo^.framepointer;
hr.offset:=hp^.pos;
emitpushreferenceaddr(hr);
emitcall('FPC_ANSISTR_DECR_REF');
@ -2819,7 +2819,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ a constructor needs a help procedure }
if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
begin
if procinfo._class^.is_class then
if procinfo^._class^.is_class then
begin
exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
emitinsertcall('FPC_NEW_CLASS');
@ -2828,7 +2828,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
exprasmlist^.insert(new(paicpu,op_cond_sym(A_Jcc,C_Z,S_NO,faillabel)));
emitinsertcall('FPC_HELP_CONSTRUCTOR');
exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI)));
exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
end;
end;
@ -2840,8 +2840,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
new(hr);
reset_reference(hr^);
hr^.offset:=procinfo.ESI_offset;
hr^.base:=procinfo.framepointer;
hr^.offset:=procinfo^.ESI_offset;
hr^.base:=procinfo^.framepointer;
exprasmlist^.insert(new(paicpu,op_ref_reg(A_MOV,S_L,hr,R_ESI)));
end;
{ should we save edi,esi,ebx like C ? }
@ -2862,14 +2862,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ omit stack frame ? }
if not inlined then
if procinfo.framepointer=stack_pointer then
if procinfo^.framepointer=stack_pointer then
begin
CGMessage(cg_d_stackframe_omited);
nostackframe:=true;
if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
parasize:=0
else
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-4;
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.call_offset-4;
if stackframe<>0 then
exprasmlist^.insert(new(paicpu,
op_const_reg(A_SUB,S_L,gettempsize,R_ESP)));
@ -2879,7 +2879,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if (aktprocsym^.definition^.proctypeoption in [potype_unitinit,potype_proginit,potype_unitfinalize]) then
parasize:=0
else
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo.call_offset-8;
parasize:=aktprocsym^.definition^.parast^.datasize+procinfo^.call_offset-8;
nostackframe:=false;
if stackframe<>0 then
begin
@ -2966,16 +2966,16 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
generate_interrupt_stackframe_entry;
{ initialize return value }
if (procinfo.retdef<>pdef(voiddef)) and
(procinfo.retdef^.needs_inittable) and
((procinfo.retdef^.deftype<>objectdef) or
not(pobjectdef(procinfo.retdef)^.is_class)) then
if (procinfo^.retdef<>pdef(voiddef)) and
(procinfo^.retdef^.needs_inittable) and
((procinfo^.retdef^.deftype<>objectdef) or
not(pobjectdef(procinfo^.retdef)^.is_class)) then
begin
procinfo.flags:=procinfo.flags or pi_needs_implicit_finally;
procinfo^.flags:=procinfo^.flags or pi_needs_implicit_finally;
reset_reference(r);
r.offset:=procinfo.retoffset;
r.base:=procinfo.framepointer;
initialize(procinfo.retdef,r,ret_in_param(procinfo.retdef));
r.offset:=procinfo^.retoffset;
r.base:=procinfo^.framepointer;
initialize(procinfo^.retdef,r,ret_in_param(procinfo^.retdef));
end;
{ generate copies of call by value parameters }
@ -2991,7 +2991,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
inittempansistrings;
{ do we need an exception frame because of ansi/widestrings ? }
if (procinfo.flags and pi_needs_implicit_finally)<>0 then
if (procinfo^.flags and pi_needs_implicit_finally)<>0 then
begin
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
@ -3011,7 +3011,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if (cs_profile in aktmoduleswitches) or
(aktprocsym^.definition^.owner^.symtabletype=globalsymtable) or
(assigned(procinfo._class) and (procinfo._class^.owner^.symtabletype=globalsymtable)) then
(assigned(procinfo^._class) and (procinfo^._class^.owner^.symtabletype=globalsymtable)) then
make_global:=true;
if not inlined then
@ -3048,7 +3048,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
if target_os.use_function_relative_addresses then
exprasmlist^.insert(stab_function_name);
if make_global or ((procinfo.flags and pi_is_global) <> 0) then
if make_global or ((procinfo^.flags and pi_is_global) <> 0) then
aktprocsym^.is_global := True;
exprasmlist^.insert(new(pai_stabs,init(aktprocsym^.stabstring)));
aktprocsym^.isstabwritten:=true;
@ -3075,23 +3075,23 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
op : Tasmop;
s : Topsize;
begin
if procinfo.retdef<>pdef(voiddef) then
if procinfo^.retdef<>pdef(voiddef) then
begin
if ((procinfo.flags and pi_operator)<>0) and
if ((procinfo^.flags and pi_operator)<>0) and
assigned(opsym) then
procinfo.funcret_is_valid:=
procinfo.funcret_is_valid or (opsym^.refs>0);
if not(procinfo.funcret_is_valid) and not inlined { and
((procinfo.flags and pi_uses_asm)=0)} then
procinfo^.funcret_is_valid:=
procinfo^.funcret_is_valid or (opsym^.refs>0);
if not(procinfo^.funcret_is_valid) and not inlined { and
((procinfo^.flags and pi_uses_asm)=0)} then
CGMessage(sym_w_function_result_not_set);
hr:=new_reference(procinfo.framepointer,procinfo.retoffset);
if (procinfo.retdef^.deftype in [orddef,enumdef]) then
hr:=new_reference(procinfo^.framepointer,procinfo^.retoffset);
if (procinfo^.retdef^.deftype in [orddef,enumdef]) then
begin
case procinfo.retdef^.size of
case procinfo^.retdef^.size of
8:
begin
emit_ref_reg(A_MOV,S_L,hr,R_EAX);
hr:=new_reference(procinfo.framepointer,procinfo.retoffset+4);
hr:=new_reference(procinfo^.framepointer,procinfo^.retoffset+4);
emit_ref_reg(A_MOV,S_L,hr,R_EDX);
end;
@ -3106,12 +3106,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end;
end
else
if ret_in_acc(procinfo.retdef) then
if ret_in_acc(procinfo^.retdef) then
emit_ref_reg(A_MOV,S_L,hr,R_EAX)
else
if (procinfo.retdef^.deftype=floatdef) then
if (procinfo^.retdef^.deftype=floatdef) then
begin
floatloadops(pfloatdef(procinfo.retdef)^.typ,op,s);
floatloadops(pfloatdef(procinfo^.retdef)^.typ,op,s);
exprasmlist^.concat(new(paicpu,op_ref(op,s,hr)))
end
else
@ -3140,14 +3140,14 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ call the destructor help procedure }
if (aktprocsym^.definition^.proctypeoption=potype_destructor) then
begin
if procinfo._class^.is_class then
if procinfo^._class^.is_class then
begin
emitinsertcall('FPC_DISPOSE_CLASS');
end
else
begin
emitinsertcall('FPC_HELP_DESTRUCTOR');
exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI)));
exprasmlist^.insert(new(paicpu,op_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI)));
end;
end;
@ -3162,7 +3162,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}finalize_data);
{ do we need to handle exceptions because of ansi/widestrings ? }
if (procinfo.flags and pi_needs_implicit_finally)<>0 then
if (procinfo^.flags and pi_needs_implicit_finally)<>0 then
begin
getlabel(noreraiselabel);
emitcall('FPC_POPADDRSTACK');
@ -3172,15 +3172,15 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
emitjmp(C_E,noreraiselabel);
{ must be the return value finalized before reraising the exception? }
if (procinfo.retdef<>pdef(voiddef)) and
(procinfo.retdef^.needs_inittable) and
((procinfo.retdef^.deftype<>objectdef) or
not(pobjectdef(procinfo.retdef)^.is_class)) then
if (procinfo^.retdef<>pdef(voiddef)) and
(procinfo^.retdef^.needs_inittable) and
((procinfo^.retdef^.deftype<>objectdef) or
not(pobjectdef(procinfo^.retdef)^.is_class)) then
begin
reset_reference(hr);
hr.offset:=procinfo.retoffset;
hr.base:=procinfo.framepointer;
finalize(procinfo.retdef,hr,ret_in_param(procinfo.retdef));
hr.offset:=procinfo^.retoffset;
hr.base:=procinfo^.framepointer;
finalize(procinfo^.retdef,hr,ret_in_param(procinfo^.retdef));
end;
emitcall('FPC_RERAISE');
@ -3205,8 +3205,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
getlabel(okexitlabel);
emitjmp(C_NONE,okexitlabel);
emitlab(faillabel);
emit_ref_reg(A_MOV,S_L,new_reference(procinfo.framepointer,12),R_ESI);
emit_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI);
emit_ref_reg(A_MOV,S_L,new_reference(procinfo^.framepointer,12),R_ESI);
emit_const_reg(A_MOV,S_L,procinfo^._class^.vmt_offset,R_EDI);
emitcall('FPC_HELP_FAIL');
emitlab(okexitlabel);
emit_reg_reg(A_MOV,S_L,R_ESI,R_EAX);
@ -3281,15 +3281,15 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if (cs_debuginfo in aktmoduleswitches) and not inlined then
begin
aktprocsym^.concatstabto(exprasmlist);
if assigned(procinfo._class) then
if (not assigned(procinfo.parent) or
not assigned(procinfo.parent^._class)) then
if assigned(procinfo^._class) then
if (not assigned(procinfo^.parent) or
not assigned(procinfo^.parent^._class)) then
exprasmlist^.concat(new(pai_stabs,init(strpnew(
'"$t:v'+procinfo._class^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.esi_offset)))))
'"$t:v'+procinfo^._class^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.esi_offset)))))
else
exprasmlist^.concat(new(pai_stabs,init(strpnew(
'"$t:r'+procinfo._class^.numberstring+'",'+
'"$t:r'+procinfo^._class^.numberstring+'",'+
tostr(N_RSYM)+',0,0,'+tostr(GDB_i386index[R_ESI])))));
if (pdef(aktprocsym^.definition^.retdef) <> pdef(voiddef)) then
@ -3297,20 +3297,20 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if ret_in_param(aktprocsym^.definition^.retdef) then
exprasmlist^.concat(new(pai_stabs,init(strpnew(
'"'+aktprocsym^.name+':X*'+aktprocsym^.definition^.retdef^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.retoffset)))))
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))))
else
exprasmlist^.concat(new(pai_stabs,init(strpnew(
'"'+aktprocsym^.name+':X'+aktprocsym^.definition^.retdef^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.retoffset)))));
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))));
if (m_result in aktmodeswitches) then
if ret_in_param(aktprocsym^.definition^.retdef) then
exprasmlist^.concat(new(pai_stabs,init(strpnew(
'"RESULT:X*'+aktprocsym^.definition^.retdef^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.retoffset)))))
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))))
else
exprasmlist^.concat(new(pai_stabs,init(strpnew(
'"RESULT:X'+aktprocsym^.definition^.retdef^.numberstring+'",'+
tostr(N_PSYM)+',0,0,'+tostr(procinfo.retoffset)))));
tostr(N_PSYM)+',0,0,'+tostr(procinfo^.retoffset)))));
end;
mangled_length:=length(aktprocsym^.definition^.mangledname);
getmem(p,mangled_length+50);
@ -3359,7 +3359,11 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end.
{
$Log$
Revision 1.46 1999-09-26 13:26:07 florian
Revision 1.47 1999-09-27 23:44:50 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.46 1999/09/26 13:26:07 florian
* exception patch of Romio nevertheless the excpetion handling
needs some corections regarding register saving
* gettempansistring is again a procedure

10
compiler/csopt386.pas
View File

@ -82,9 +82,9 @@ Begin {CheckSequence}
While (RegCounter <= R_EDI) Do
Begin
FillChar(RegInfo, SizeOf(RegInfo), 0);
RegInfo.NewRegsEncountered := [ProcInfo.FramePointer, R_ESP];
RegInfo.NewRegsEncountered := [procinfo^.FramePointer, R_ESP];
RegInfo.OldRegsEncountered := RegInfo.NewRegsEncountered;
RegInfo.New2OldReg[ProcInfo.FramePointer] := ProcInfo.FramePointer;
RegInfo.New2OldReg[procinfo^.FramePointer] := procinfo^.FramePointer;
RegInfo.New2OldReg[R_ESP] := R_ESP;
Found := 0;
hp2 := PPaiProp(PrevNonRemovablePai^.OptInfo)^.Regs[RegCounter].StartMod;
@ -553,7 +553,11 @@ End.
{
$Log$
Revision 1.24 1999-08-25 11:59:58 jonas
Revision 1.25 1999-09-27 23:44:50 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.24 1999/08/25 11:59:58 jonas
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
Revision 1.23 1999/08/04 00:22:58 florian

34
compiler/daopt386.pas
View File

@ -1315,7 +1315,7 @@ Begin
Begin
If (Paicpu(p)^.oper[0].typ = top_ref) Then
With Paicpu(p)^.oper[0].ref^ Do
If (Base = ProcInfo.FramePointer) And
If (Base = procinfo^.FramePointer) And
(Index = R_NO)
Then
Begin
@ -1383,27 +1383,27 @@ Begin
Begin
Case Paicpu(p)^.oper[0].typ Of
top_reg:
If Not(Paicpu(p)^.oper[0].reg in [R_NO,R_ESP,ProcInfo.FramePointer]) Then
If Not(Paicpu(p)^.oper[0].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
RegSet := RegSet + [Paicpu(p)^.oper[0].reg];
top_ref:
With TReference(Paicpu(p)^.oper[0]^) Do
Begin
If Not(Base in [ProcInfo.FramePointer,R_NO,R_ESP])
If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
Then RegSet := RegSet + [Base];
If Not(Index in [ProcInfo.FramePointer,R_NO,R_ESP])
If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
Then RegSet := RegSet + [Index];
End;
End;
Case Paicpu(p)^.oper[1].typ Of
top_reg:
If Not(Paicpu(p)^.oper[1].reg in [R_NO,R_ESP,ProcInfo.FramePointer]) Then
If Not(Paicpu(p)^.oper[1].reg in [R_NO,R_ESP,procinfo^.FramePointer]) Then
If RegSet := RegSet + [TRegister(TwoWords(Paicpu(p)^.oper[1]).Word1];
top_ref:
With TReference(Paicpu(p)^.oper[1]^) Do
Begin
If Not(Base in [ProcInfo.FramePointer,R_NO,R_ESP])
If Not(Base in [procinfo^.FramePointer,R_NO,R_ESP])
Then RegSet := RegSet + [Base];
If Not(Index in [ProcInfo.FramePointer,R_NO,R_ESP])
If Not(Index in [procinfo^.FramePointer,R_NO,R_ESP])
Then RegSet := RegSet + [Index];
End;
End;
@ -1475,10 +1475,10 @@ Begin {checks whether two Paicpu instructions are equal}
Begin
With Paicpu(p2)^.oper[0].ref^ Do
Begin
If Not(Base in [ProcInfo.FramePointer, R_NO, R_ESP])
If Not(Base in [procinfo^.FramePointer, R_NO, R_ESP])
{it won't do any harm if the register is already in RegsLoadedForRef}
Then RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Base];
If Not(Index in [ProcInfo.FramePointer, R_NO, R_ESP])
If Not(Index in [procinfo^.FramePointer, R_NO, R_ESP])
Then RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef + [Index];
End;
{add the registers from the reference (.oper[0]) to the RegInfo, all registers
@ -1498,7 +1498,7 @@ Begin {checks whether two Paicpu instructions are equal}
Begin
With Paicpu(p2)^.oper[0].ref^ Do
Begin
If Not(Base in [ProcInfo.FramePointer,
If Not(Base in [procinfo^.FramePointer,
Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP])
{it won't do any harm if the register is already in RegsLoadedForRef}
Then
@ -1508,7 +1508,7 @@ Begin {checks whether two Paicpu instructions are equal}
Writeln(att_reg2str[base], ' added');
{$endif csdebug}
end;
If Not(Index in [ProcInfo.FramePointer,
If Not(Index in [procinfo^.FramePointer,
Reg32(Paicpu(p2)^.oper[1].reg),R_NO,R_ESP])
Then
Begin
@ -1519,7 +1519,7 @@ Begin {checks whether two Paicpu instructions are equal}
end;
End;
If Not(Reg32(Paicpu(p2)^.oper[1].reg) In [ProcInfo.FramePointer,R_NO,R_ESP])
If Not(Reg32(Paicpu(p2)^.oper[1].reg) In [procinfo^.FramePointer,R_NO,R_ESP])
Then
Begin
RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef -
@ -1629,7 +1629,7 @@ Var Counter: TRegister;
Begin
WhichReg := Reg32(WhichReg);
If (Ref.Index = R_NO) And
((Ref.base = ProcInfo.FramePointer) Or
((Ref.base = procinfo^.FramePointer) Or
(Assigned(Ref.Symbol) And
(Ref.base = R_NO)))
Then
@ -1679,7 +1679,7 @@ Begin
{don't destroy if reg contains a parameter, local or global variable}
Not((NrOfMods = 1) And
(Paicpu(StartMod)^.oper[0].typ = top_ref) And
((Paicpu(StartMod)^.oper[0].ref^.base = ProcInfo.FramePointer) Or
((Paicpu(StartMod)^.oper[0].ref^.base = procinfo^.FramePointer) Or
Assigned(Paicpu(StartMod)^.oper[0].ref^.Symbol)
)
)
@ -2351,7 +2351,11 @@ End.
{
$Log$
Revision 1.59 1999-09-21 15:46:58 jonas
Revision 1.60 1999-09-27 23:44:50 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.59 1999/09/21 15:46:58 jonas
* fixed bug in destroyrefs (indexes are now handled as pointers)
Revision 1.58 1999/09/05 12:37:50 jonas

32
compiler/hcodegen.pas
View File

@ -52,7 +52,8 @@ unit hcodegen;
retdef : pdef;
{ return type }
sym : pprocsym;
{ symbol of the function }
{ symbol of the function, and the sym for result variable }
resultfuncretsym,
funcretsym : pfuncretsym;
{ the definition of the proc itself }
{ why was this a pdef only ?? PM }
@ -103,7 +104,7 @@ unit hcodegen;
var
{ info about the current sub routine }
procinfo : tprocinfo;
procinfo : pprocinfo;
{ labels for BREAK and CONTINUE }
aktbreaklabel,aktcontinuelabel : pasmlabel;
@ -216,23 +217,28 @@ implementation
aktcontinuelabel:=nil;
{ aktexitlabel:=0; is store in oldaktexitlabel
so it must not be reset to zero before this storage !}
{ new procinfo }
new(procinfo);
fillchar(procinfo^,sizeof(tprocinfo),0);
{ the type of this lists isn't important }
{ because the code of this lists is }
{ copied to the code segment }
procinfo.aktentrycode:=new(paasmoutput,init);
procinfo.aktexitcode:=new(paasmoutput,init);
procinfo.aktproccode:=new(paasmoutput,init);
procinfo.aktlocaldata:=new(paasmoutput,init);
procinfo^.aktentrycode:=new(paasmoutput,init);
procinfo^.aktexitcode:=new(paasmoutput,init);
procinfo^.aktproccode:=new(paasmoutput,init);
procinfo^.aktlocaldata:=new(paasmoutput,init);
end;
procedure codegen_doneprocedure;
begin
dispose(procinfo.aktentrycode,done);
dispose(procinfo.aktexitcode,done);
dispose(procinfo.aktproccode,done);
dispose(procinfo.aktlocaldata,done);
dispose(procinfo^.aktentrycode,done);
dispose(procinfo^.aktexitcode,done);
dispose(procinfo^.aktproccode,done);
dispose(procinfo^.aktlocaldata,done);
dispose(procinfo);
procinfo:=nil;
end;
@ -309,7 +315,11 @@ end.
{
$Log$
Revision 1.42 1999-08-26 20:24:40 michael
Revision 1.43 1999-09-27 23:44:51 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.42 1999/08/26 20:24:40 michael
+ Hopefuly last fixes for resourcestrings
Revision 1.41 1999/08/24 13:14:03 peter

10
compiler/pass_1.pas
View File

@ -121,7 +121,7 @@ implementation
{ Funktionsresultate an exit anh„ngen }
{ this is wrong for string or other complex
result types !!! }
if ret_in_acc(procinfo.retdef) and
if ret_in_acc(procinfo^.retdef) and
assigned(hp^.left) and
(hp^.left^.right^.treetype=exitn) and
(hp^.right^.treetype=assignn) and
@ -188,7 +188,7 @@ implementation
procedure firstasm(var p : ptree);
begin
procinfo.flags:=procinfo.flags or pi_uses_asm;
procinfo^.flags:=procinfo^.flags or pi_uses_asm;
end;
@ -369,7 +369,11 @@ implementation
end.
{
$Log$
Revision 1.105 1999-09-26 21:30:16 peter
Revision 1.106 1999-09-27 23:44:51 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.105 1999/09/26 21:30:16 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts

66
compiler/pass_2.pas
View File

@ -437,7 +437,7 @@ implementation
{ only if no asm is used }
{ and no try statement }
if (cs_regalloc in aktglobalswitches) and
((procinfo.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin
{ can we omit the stack frame ? }
{ conditions:
@ -452,28 +452,28 @@ implementation
(*
if assigned(aktprocsym) then
begin
if not(assigned(procinfo._class)) and
if not(assigned(procinfo^._class)) and
not(aktprocsym^.definition^.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocsym^.definition^.procoptions) and
((procinfo.flags and pi_do_call)=0) and
((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then
begin
{ use ESP as frame pointer }
procinfo.framepointer:=stack_pointer;
procinfo^.framepointer:=stack_pointer;
use_esp_stackframe:=true;
{ calc parameter distance new }
dec(procinfo.framepointer_offset,4);
dec(procinfo.ESI_offset,4);
dec(procinfo^.framepointer_offset,4);
dec(procinfo^.ESI_offset,4);
{ is this correct ???}
{ retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive }
if procinfo.retoffset>=0 then
dec(procinfo.retoffset,4);
if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4);
dec(procinfo.call_offset,4);
aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
dec(procinfo^.call_offset,4);
aktprocsym^.definition^.parast^.address_fixup:=procinfo^.call_offset;
end;
end;
*)
@ -510,7 +510,7 @@ implementation
{ unused }
usableregs:=usableregs-[varregs[i]];
{$ifdef i386}
procinfo.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
procinfo^.aktentrycode^.concat(new(pairegalloc,alloc(varregs[i])));
{$endif i386}
is_reg_var[varregs[i]]:=true;
dec(c_usableregs);
@ -556,14 +556,14 @@ implementation
{ when loading parameter to reg }
new(hr);
reset_reference(hr^);
hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
hr^.base:=procinfo.framepointer;
hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.call_offset;
hr^.base:=procinfo^.framepointer;
{$ifdef i386}
procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
hr,regvars[i]^.reg)));
{$endif i386}
{$ifdef m68k}
procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
hr,regvars[i]^.reg)));
{$endif m68k}
unused:=unused - [regvars[i]^.reg];
@ -585,7 +585,7 @@ implementation
if assigned(regvars[i]) then
begin
if cs_asm_source in aktglobalswitches then
procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
reg2str(regvars[i]^.reg)))));
if (status.verbosity and v_debug)=v_debug then
@ -610,7 +610,7 @@ implementation
{ in non leaf procedures we must be very careful }
{ with assigning registers }
if (procinfo.flags and pi_do_call)<>0 then
if (procinfo^.flags and pi_do_call)<>0 then
begin
for i:=maxfpuvarregs downto 2 do
regvars[i]:=nil;
@ -628,9 +628,9 @@ implementation
{$ifdef i386}
{ reserve place on the FPU stack }
regvars[i]^.reg:=correct_fpuregister(R_ST0,i-1);
procinfo.aktentrycode^.concat(new(paicpu,op_none(A_FLDZ,S_NO)));
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)));
procinfo^.aktexitcode^.concat(new(paicpu,op_reg(A_FSTP,S_NO,R_ST0)));
{$endif i386}
{$ifdef m68k}
regvars[i]^.reg:=fpuvarregs[i];
@ -645,14 +645,14 @@ implementation
{ when loading parameter to reg }
new(hr);
reset_reference(hr^);
hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
hr^.base:=procinfo.framepointer;
hr^.offset:=pvarsym(regvars[i])^.address+procinfo^.call_offset;
hr^.base:=procinfo^.framepointer;
{$ifdef i386}
procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOV,regsize,
hr,regvars[i]^.reg)));
{$endif i386}
{$ifdef m68k}
procinfo.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
procinfo^.aktentrycode^.concat(new(paicpu,op_ref_reg(A_MOVE,regsize,
hr,regvars[i]^.reg)));
{$endif m68k}
end;
@ -660,14 +660,14 @@ implementation
end;
end;
if cs_asm_source in aktglobalswitches then
procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(tostr(p^.registersfpu)+
' registers on FPU stack used by temp. expressions'))));
for i:=1 to maxfpuvarregs do
begin
if assigned(regvars[i]) then
begin
if cs_asm_source in aktglobalswitches then
procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew(regvars[i]^.name+
' with weight '+tostr(regvars[i]^.refs)+' assigned to register '+
reg2str(regvars[i]^.reg)))));
if (status.verbosity and v_debug)=v_debug then
@ -676,7 +676,7 @@ implementation
end;
end;
if cs_asm_source in aktglobalswitches then
procinfo.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
procinfo^.aktentrycode^.insert(new(pai_asm_comment,init(strpnew('Register variable assignment:'))));
end;
end;
if assigned(aktprocsym) and
@ -684,20 +684,24 @@ implementation
make_const_global:=true;
do_secondpass(p);
if assigned(procinfo.def) then
procinfo.def^.fpu_used:=p^.registersfpu;
if assigned(procinfo^.def) then
procinfo^.def^.fpu_used:=p^.registersfpu;
{ all registers can be used again }
resetusableregisters;
end;
procinfo.aktproccode^.concatlist(exprasmlist);
procinfo^.aktproccode^.concatlist(exprasmlist);
make_const_global:=false;
end;
end.
{
$Log$
Revision 1.39 1999-09-26 21:30:17 peter
Revision 1.40 1999-09-27 23:44:52 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.39 1999/09/26 21:30:17 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts
@ -840,7 +844,7 @@ end.
* first working array of const things
Revision 1.5 1998/09/21 10:01:06 peter
* check if procinfo.def is assigned before storing registersfpu
* check if procinfo^.def is assigned before storing registersfpu
Revision 1.4 1998/09/21 08:45:16 pierre
+ added vmt_offset in tobjectdef.write for fututre use

21
compiler/pdecl.pas
View File

@ -1392,6 +1392,7 @@ unit pdecl;
hs : string;
pcrd : pclassrefdef;
hp1 : pdef;
oldprocinfo : pprocinfo;
oldprocsym : pprocsym;
oldparse_only : boolean;
methodnametable,intmessagetable,
@ -1591,10 +1592,16 @@ unit pdecl;
aktobjectdef:=aktclass;
aktclass^.symtable^.next:=symtablestack;
symtablestack:=aktclass^.symtable;
procinfo._class:=aktclass;
testcurobject:=1;
curobjectname:=n;
{ new procinfo }
oldprocinfo:=procinfo;
new(procinfo);
fillchar(procinfo^,sizeof(tprocinfo),0);
procinfo^._class:=aktclass;
{ short class declaration ? }
if (not is_a_class) or (token<>_SEMICOLON) then
begin
@ -1830,8 +1837,10 @@ unit pdecl;
{ restore old state }
symtablestack:=symtablestack^.next;
procinfo._class:=nil;
aktobjectdef:=nil;
{Restore procinfo}
dispose(procinfo);
procinfo:=oldprocinfo;
{Restore the aktprocsym.}
aktprocsym:=oldprocsym;
@ -2540,7 +2549,11 @@ unit pdecl;
end.
{
$Log$
Revision 1.156 1999-09-26 21:30:19 peter
Revision 1.157 1999-09-27 23:44:53 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.156 1999/09/26 21:30:19 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts
@ -2571,7 +2584,7 @@ end.
* some more fixes for stored properties
Revision 1.149 1999/09/10 18:48:07 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.148 1999/09/08 21:06:06 michael

62
compiler/pexpr.pas
View File

@ -565,8 +565,16 @@ unit pexpr;
begin
{ we must provide a method pointer, if it isn't given, }
{ it is self }
p1^.methodpointer:=genselfnode(procinfo._class);
p1^.methodpointer^.resulttype:=procinfo._class;
if assigned(procinfo) then
begin
p1^.methodpointer:=genselfnode(procinfo^._class);
p1^.methodpointer^.resulttype:=procinfo^._class;
end
else
begin
p1^.methodpointer:=genselfnode(nil);
p1^.methodpointer^.resulttype:=nil;
end;
end;
{ no postfix operators }
again:=false;
@ -865,14 +873,16 @@ unit pexpr;
begin
is_func_ret:=false;
if (sym^.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0) then
if not assigned(procinfo) or
((sym^.typ<>funcretsym) and ((procinfo^.flags and pi_operator)=0)) then
exit;
p:=@procinfo;
while system.assigned(p) do
p:=procinfo;
while assigned(p) do
begin
{ is this an access to a function result ? }
if assigned(p^.funcretsym) and
((pfuncretsym(sym)=p^.funcretsym) or
(pfuncretsym(sym)=p^.resultfuncretsym) or
((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0))) and
(p^.retdef<>pdef(voiddef)) and
@ -918,18 +928,6 @@ unit pexpr;
begin
{ allow post fix operators }
again:=true;
if (m_result in aktmodeswitches) and
(idtoken=_RESULT) and
assigned(aktprocsym) and
(procinfo.retdef<>pdef(voiddef)) then
begin
consume(_ID);
p1:=genzeronode(funcretn);
pd:=procinfo.retdef;
p1^.funcretprocinfo:=pointer(@procinfo);
p1^.retdef:=pd;
end
else
begin
if lastsymknown then
begin
@ -1041,10 +1039,11 @@ unit pexpr;
not(pobjectdef(pd)^.is_class) then
begin
consume(_POINT);
if assigned(procinfo._class) and
not(getaddr) then
if assigned(procinfo) and
assigned(procinfo^._class) and
not(getaddr) then
begin
if procinfo._class^.is_related(pobjectdef(pd)) then
if procinfo^._class^.is_related(pobjectdef(pd)) then
begin
p1:=gentypenode(pd,ptypesym(srsym));
p1^.resulttype:=pd;
@ -1072,9 +1071,6 @@ unit pexpr;
{ also allows static methods and variables }
p1:=genzeronode(typen);
p1^.resulttype:=pd;
{ srsymtable:=pobjectdef(pd)^.symtable;
sym:=pvarsym(srsymtable^.search(pattern)); }
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
@ -1654,7 +1650,7 @@ unit pexpr;
_SELF : begin
again:=true;
consume(_SELF);
if not assigned(procinfo._class) then
if not assigned(procinfo^._class) then
begin
p1:=genzeronode(errorn);
pd:=generrordef;
@ -1666,14 +1662,14 @@ unit pexpr;
if (po_classmethod in aktprocsym^.definition^.procoptions) then
begin
{ self in class methods is a class reference type }
pd:=new(pclassrefdef,init(procinfo._class));
pd:=new(pclassrefdef,init(procinfo^._class));
p1:=genselfnode(pd);
p1^.resulttype:=pd;
end
else
begin
p1:=genselfnode(procinfo._class);
p1^.resulttype:=procinfo._class;
p1:=genselfnode(procinfo^._class);
p1^.resulttype:=procinfo^._class;
end;
pd:=p1^.resulttype;
postfixoperators;
@ -1682,9 +1678,9 @@ unit pexpr;
_INHERITED : begin
again:=true;
consume(_INHERITED);
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
begin
classh:=procinfo._class^.childof;
classh:=procinfo^._class^.childof;
while assigned(classh) do
begin
srsymtable:=pobjectdef(classh)^.symtable;
@ -2108,7 +2104,11 @@ _LECKKLAMMER : begin
end.
{
$Log$
Revision 1.145 1999-09-27 11:59:42 peter
Revision 1.146 1999-09-27 23:44:54 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.145 1999/09/27 11:59:42 peter
* fix for pointer reading in const with @type.method
Revision 1.144 1999/09/26 21:30:19 peter
@ -2136,7 +2136,7 @@ end.
it is also allowed for objects !!
Revision 1.139 1999/09/10 18:48:07 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.138 1999/09/07 08:01:20 peter

19
compiler/pmodules.pas
View File

@ -859,7 +859,7 @@ unit pmodules;
{ and insert the procsym in symtable }
st^.insert(aktprocsym);
{ set some informations about the main program }
with procinfo do
with procinfo^ do
begin
retdef:=voiddef;
_class:=nil;
@ -1104,11 +1104,9 @@ unit pmodules;
Message1(parser_u_parsing_implementation,current_module^.modulename^);
{ Generate a procsym }
gen_main_procsym(current_module^.modulename^+'_init',potype_unitinit,st);
{ Compile the unit }
codegen_newprocedure;
gen_main_procsym(current_module^.modulename^+'_init',potype_unitinit,st);
names.init;
names.insert('INIT$$'+current_module^.modulename^);
names.insert(target_os.cprefix+current_module^.modulename^+'_init');
@ -1125,11 +1123,9 @@ unit pmodules;
{ set module options }
current_module^.flags:=current_module^.flags or uf_finalize;
{ Generate a procsym }
gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
{ Compile the finalize }
codegen_newprocedure;
gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
names.init;
names.insert('FINALIZE$$'+current_module^.modulename^);
names.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
@ -1359,8 +1355,6 @@ unit pmodules;
constsymtable:=st;
Message1(parser_u_parsing_implementation,current_module^.mainsource^);
{ Generate a procsym for main }
gen_main_procsym('main',potype_proginit,st);
{ reset }
procprefix:='';
@ -1368,6 +1362,7 @@ unit pmodules;
{The program intialization needs an alias, so it can be called
from the bootstrap code.}
codegen_newprocedure;
gen_main_procsym('main',potype_proginit,st);
names.init;
names.insert('program_init');
names.insert('PASCALMAIN');
@ -1464,7 +1459,11 @@ unit pmodules;
end.
{
$Log$
Revision 1.156 1999-09-20 16:39:00 peter
Revision 1.157 1999-09-27 23:44:54 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.156 1999/09/20 16:39:00 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.

18
compiler/popt386.pas
View File

@ -422,8 +422,8 @@ Begin
(hp2^.typ = ait_instruction) And
((Paicpu(hp2)^.opcode = A_LEAVE) Or
(Paicpu(hp2)^.opcode = A_RET)) And
(Paicpu(p)^.oper[0].ref^.Base = ProcInfo.FramePointer) And
(Paicpu(p)^.oper[0].ref^.Offset >= ProcInfo.RetOffset) And
(Paicpu(p)^.oper[0].ref^.Base = procinfo^.FramePointer) And
(Paicpu(p)^.oper[0].ref^.Offset >= procinfo^.RetOffset) And
(Paicpu(p)^.oper[0].ref^.Index = R_NO)
Then
Begin
@ -813,8 +813,8 @@ Begin
If ((Paicpu(hp1)^.opcode = A_LEAVE) Or
(Paicpu(hp1)^.opcode = A_RET)) And
(Paicpu(p)^.oper[1].typ = top_ref) And
(Paicpu(p)^.oper[1].ref^.base = ProcInfo.FramePointer) And
(Paicpu(p)^.oper[1].ref^.offset >= ProcInfo.RetOffset) And
(Paicpu(p)^.oper[1].ref^.base = procinfo^.FramePointer) And
(Paicpu(p)^.oper[1].ref^.offset >= procinfo^.RetOffset) And
(Paicpu(p)^.oper[1].ref^.index = R_NO) And
(Paicpu(p)^.oper[0].typ = top_reg)
Then
@ -1368,9 +1368,9 @@ Begin
(hp2^.typ = ait_instruction) And
((Paicpu(hp2)^.opcode = A_LEAVE) or
(Paicpu(hp2)^.opcode = A_RET)) And
(Paicpu(p)^.oper[0].ref^.Base = ProcInfo.FramePointer) And
(Paicpu(p)^.oper[0].ref^.Base = procinfo^.FramePointer) And
(Paicpu(p)^.oper[0].ref^.Index = R_NO) And
(Paicpu(p)^.oper[0].ref^.Offset >= ProcInfo.RetOffset) And
(Paicpu(p)^.oper[0].ref^.Offset >= procinfo^.RetOffset) And
(hp1^.typ = ait_instruction) And
(Paicpu(hp1)^.opcode = A_MOV) And
(Paicpu(hp1)^.opsize = S_B) And
@ -1603,7 +1603,11 @@ End.
{
$Log$
Revision 1.65 1999-09-05 14:27:19 florian
Revision 1.66 1999-09-27 23:44:55 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.65 1999/09/05 14:27:19 florian
+ fld reg;fxxx to fxxxr reg optimization
Revision 1.64 1999/08/25 12:00:02 jonas

97
compiler/pstatmnt.pas
View File

@ -519,7 +519,7 @@ unit pstatmnt;
objname : stringid;
begin
procinfo.flags:=procinfo.flags or
procinfo^.flags:=procinfo^.flags or
pi_uses_exceptions;
p_default:=nil;
@ -690,17 +690,17 @@ unit pstatmnt;
consume(_RKLAMMER);
if in_except_block then
Message(parser_e_exit_with_argument_not__possible);
if procinfo.retdef=pdef(voiddef) then
if procinfo^.retdef=pdef(voiddef) then
Message(parser_e_void_function);
{
else
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
}
end
else
p:=nil;
p:=gensinglenode(exitn,p);
p^.resulttype:=procinfo.retdef;
p^.resulttype:=procinfo^.retdef;
exit_statement:=p;
end;
@ -1096,8 +1096,7 @@ unit pstatmnt;
end;
else
begin
if (token=_INTCONST) or
((token=_ID) and not((m_result in aktmodeswitches) and (idtoken=_RESULT))) then
if (token in [_INTCONST,_ID]) then
begin
getsym(pattern,true);
lastsymknown:=true;
@ -1118,11 +1117,7 @@ unit pstatmnt;
lastsymknown:=false;
{ the pointer to the following instruction }
{ isn't a very clean way }
{$ifdef tp}
code:=gensinglenode(labeln,statement);
{$else}
code:=gensinglenode(labeln,statement());
{$endif}
code:=gensinglenode(labeln,statement{$ifndef tp}(){$endif});
code^.labelnr:=labelnr;
{ sorry, but there is a jump the easiest way }
goto ready;
@ -1156,62 +1151,68 @@ unit pstatmnt;
storepos : tfileposinfo;
begin
if procinfo.retdef<>pdef(voiddef) then
if procinfo^.retdef<>pdef(voiddef) then
begin
{ if the current is a function aktprocsym is non nil }
{ and there is a local symtable set }
storepos:=tokenpos;
tokenpos:=aktprocsym^.fileinfo;
funcretsym:=new(pfuncretsym,init(aktprocsym^.name,@procinfo));
funcretsym:=new(pfuncretsym,init(aktprocsym^.name,procinfo));
{ insert in local symtable }
symtablestack^.insert(funcretsym);
tokenpos:=storepos;
if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
procinfo.retoffset:=-funcretsym^.address;
procinfo.funcretsym:=funcretsym;
if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
procinfo^.retoffset:=-funcretsym^.address;
procinfo^.funcretsym:=funcretsym;
{ insert result also if support is on }
if (m_result in aktmodeswitches) then
begin
procinfo^.resultfuncretsym:=new(pfuncretsym,init('RESULT',procinfo));
symtablestack^.insert(procinfo^.resultfuncretsym);
end;
end;
read_declarations(islibrary);
{ temporary space is set, while the BEGIN of the procedure }
if (symtablestack^.symtabletype=localsymtable) then
procinfo.firsttemp := -symtablestack^.datasize
else procinfo.firsttemp := 0;
procinfo^.firsttemp := -symtablestack^.datasize
else procinfo^.firsttemp := 0;
{ space for the return value }
{ !!!!! this means that we can not set the return value
in a subfunction !!!!! }
{ because we don't know yet where the address is }
if procinfo.retdef<>pdef(voiddef) then
if procinfo^.retdef<>pdef(voiddef) then
begin
if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
{ if (procinfo.retdef^.deftype=orddef) or
(procinfo.retdef^.deftype=pointerdef) or
(procinfo.retdef^.deftype=enumdef) or
(procinfo.retdef^.deftype=procvardef) or
(procinfo.retdef^.deftype=floatdef) or
if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
{ if (procinfo^.retdef^.deftype=orddef) or
(procinfo^.retdef^.deftype=pointerdef) or
(procinfo^.retdef^.deftype=enumdef) or
(procinfo^.retdef^.deftype=procvardef) or
(procinfo^.retdef^.deftype=floatdef) or
(
(procinfo.retdef^.deftype=setdef) and
(psetdef(procinfo.retdef)^.settype=smallset)
(procinfo^.retdef^.deftype=setdef) and
(psetdef(procinfo^.retdef)^.settype=smallset)
) then }
begin
{ the space has been set in the local symtable }
procinfo.retoffset:=-funcretsym^.address;
if ((procinfo.flags and pi_operator)<>0) and
procinfo^.retoffset:=-funcretsym^.address;
if ((procinfo^.flags and pi_operator)<>0) and
assigned(opsym) then
{opsym^.address:=procinfo.call_offset; is wrong PM }
opsym^.address:=-procinfo.retoffset;
{opsym^.address:=procinfo^.call_offset; is wrong PM }
opsym^.address:=-procinfo^.retoffset;
{ eax is modified by a function }
{$ifndef newcg}
{$ifdef i386}
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
if is_64bitint(procinfo.retdef) then
if is_64bitint(procinfo^.retdef) then
usedinproc:=usedinproc or ($80 shr byte(R_EDX))
{$endif}
{$ifdef m68k}
usedinproc:=usedinproc or ($800 shr word(R_D0));
if is_64bitint(procinfo.retdef) then
if is_64bitint(procinfo^.retdef) then
usedinproc:=usedinproc or ($800 shr byte(R_D1))
{$endif}
{$endif newcg}
@ -1258,19 +1259,19 @@ unit pstatmnt;
read_declarations(false);
{ temporary space is set, while the BEGIN of the procedure }
if symtablestack^.symtabletype=localsymtable then
procinfo.firsttemp := -symtablestack^.datasize
procinfo^.firsttemp := -symtablestack^.datasize
else
procinfo.firsttemp := 0;
procinfo^.firsttemp := 0;
{ assembler code does not allocate }
{ space for the return value }
if procinfo.retdef<>pdef(voiddef) then
if procinfo^.retdef<>pdef(voiddef) then
begin
if ret_in_acc(procinfo.retdef) then
if ret_in_acc(procinfo^.retdef) then
begin
{ in assembler code the result should be directly in %eax
procinfo.retoffset:=procinfo.firsttemp-procinfo.retdef^.size;
procinfo.firsttemp:=procinfo.retoffset; }
procinfo^.retoffset:=procinfo^.firsttemp-procinfo^.retdef^.size;
procinfo^.firsttemp:=procinfo^.retoffset; }
{$ifndef newcg}
{$ifdef i386}
@ -1282,7 +1283,7 @@ unit pstatmnt;
{$endif newcg}
end
{
else if not is_fpu(procinfo.retdef) then
else if not is_fpu(procinfo^.retdef) then
should we allow assembler functions of big elements ?
YES (FK)!!
Message(parser_e_asm_incomp_with_function_return);
@ -1293,21 +1294,21 @@ unit pstatmnt;
{ added no parameter also (PM) }
{ disable for methods, because self pointer is expected }
{ at -8(%ebp) (JM) }
if not(assigned(procinfo._class)) and
if not(assigned(procinfo^._class)) and
(po_assembler in aktprocsym^.definition^.procoptions) and
(aktprocsym^.definition^.localst^.datasize=0) and
(aktprocsym^.definition^.parast^.datasize=0) and
not(ret_in_param(aktprocsym^.definition^.retdef)) then
begin
procinfo.framepointer:=stack_pointer;
procinfo^.framepointer:=stack_pointer;
{ set the right value for parameters }
dec(aktprocsym^.definition^.parast^.address_fixup,target_os.size_of_pointer);
dec(procinfo.call_offset,target_os.size_of_pointer);
dec(procinfo^.call_offset,target_os.size_of_pointer);
end;
{ force the asm statement }
if token<>_ASM then
consume(_ASM);
Procinfo.Flags := ProcInfo.Flags Or pi_is_assembler;
procinfo^.Flags := procinfo^.Flags Or pi_is_assembler;
assembler_block:=_asm_statement;
{ becuase the END is already read we need to get the
last_endtoken_filepos here (PFV) }
@ -1317,11 +1318,15 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.102 1999-09-16 23:05:54 florian
Revision 1.103 1999-09-27 23:44:56 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.102 1999/09/16 23:05:54 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.101 1999/09/10 18:48:09 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.100 1999/09/07 14:12:36 jonas

137
compiler/psub.pas
View File

@ -113,14 +113,14 @@ begin
if idtoken=_SELF then
begin
{ we parse the defintion in the class definition }
if assigned(procinfo._class) and procinfo._class^.is_class then
if assigned(procinfo^._class) and procinfo^._class^.is_class then
begin
{$ifndef UseNiceNames}
hs2:=hs2+'$'+'self';
{$else UseNiceNames}
hs2:=hs2+tostr(length('self'))+'self';
{$endif UseNiceNames}
vs:=new(Pvarsym,init('@',procinfo._class));
vs:=new(Pvarsym,init('@',procinfo^._class));
vs^.varspez:=vs_var;
{ insert the sym in the parasymtable }
aktprocsym^.definition^.parast^.insert(vs);
@ -129,7 +129,7 @@ begin
{$else}
aktprocsym^.definition^.procoptions:=aktprocsym^.definition^.procoptions+[po_containsself];
{$endif}
inc(procinfo.ESI_offset,vs^.address);
inc(procinfo^.ESI_offset,vs^.address);
consume(idtoken);
consume(_COLON);
p:=single_type(hs1);
@ -137,7 +137,7 @@ begin
aktprocsym^.definition^.concattypesym(readtypesym,vs_value)
else
aktprocsym^.definition^.concatdef(p,vs_value);
CheckTypes(p,procinfo._class);
CheckTypes(p,procinfo^._class);
end
else
consume(_ID);
@ -241,10 +241,10 @@ begin
{ search for duplicate ids in object members/methods }
{ but only the current class, I don't know why ... }
{ at least TP and Delphi do it in that way (FK) }
if assigned(procinfo._class) and
if assigned(procinfo^._class) and
(lexlevel=normal_function_level) then
begin
hsym:=procinfo._class^.symtable^.search(vs^.name);
hsym:=procinfo^._class^.symtable^.search(vs^.name);
if assigned(hsym) then
DuplicateSym(hsym);
end;
@ -324,11 +324,11 @@ begin
sp:=pattern;
realname:=orgpattern;
consume(_ID);
procinfo._class:=pobjectdef(ptypesym(sym)^.definition);
aktprocsym:=pprocsym(procinfo._class^.symtable^.search(sp));
procinfo^._class:=pobjectdef(ptypesym(sym)^.definition);
aktprocsym:=pprocsym(procinfo^._class^.symtable^.search(sp));
{The procedure has been found. So it is
a global one. Set the flags to mark this.}
procinfo.flags:=procinfo.flags or pi_is_global;
procinfo^.flags:=procinfo^.flags or pi_is_global;
aktobjectdef:=nil;
{ we solve this below }
if not(assigned(aktprocsym)) then
@ -377,22 +377,22 @@ begin
DuplicateSym(aktprocsym);
{The procedure has been found. So it is
a global one. Set the flags to mark this.}
procinfo.flags:=procinfo.flags or pi_is_global;
procinfo^.flags:=procinfo^.flags or pi_is_global;
end;
end;
end;
end;
{ problem with procedures inside methods }
{$ifndef UseNiceNames}
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
if (pos('_$$_',procprefix)=0) then
hs:=procprefix+'_$$_'+procinfo._class^.objname^+'_$$_'+sp
hs:=procprefix+'_$$_'+procinfo^._class^.objname^+'_$$_'+sp
else
hs:=procprefix+'_$'+sp;
{$else UseNiceNames}
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
if (pos('_5Class_',procprefix)=0) then
hs:=procprefix+'_5Class_'+procinfo._class^.name^+'_'+tostr(length(sp))+sp
hs:=procprefix+'_5Class_'+procinfo^._class^.name^+'_'+tostr(length(sp))+sp
else
hs:=procprefix+'_'+tostr(length(sp))+sp;
{$endif UseNiceNames}
@ -445,8 +445,8 @@ begin
pd:=new(pprocdef,init);
pd^.symtablelevel:=symtablestack^.symtablelevel;
if assigned(procinfo._class) then
pd^._class := procinfo._class;
if assigned(procinfo^._class) then
pd^._class := procinfo^._class;
{ set the options from the caller (podestructor or poconstructor) }
pd^.proctypeoption:=options;
@ -457,35 +457,35 @@ begin
{ calculate frame pointer offset }
if lexlevel>normal_function_level then
begin
procinfo.framepointer_offset:=paramoffset;
procinfo^.framepointer_offset:=paramoffset;
inc(paramoffset,target_os.size_of_pointer);
{ this is needed to get correct framepointer push for local
forward functions !! }
pd^.parast^.symtablelevel:=lexlevel;
end;
if assigned (Procinfo._Class) and
not(Procinfo._Class^.is_class) and
if assigned (procinfo^._Class) and
not(procinfo^._Class^.is_class) and
(pd^.proctypeoption in [potype_constructor,potype_destructor]) then
inc(paramoffset,target_os.size_of_pointer);
{ self pointer offset }
{ self isn't pushed in nested procedure of methods }
if assigned(procinfo._class) and (lexlevel=normal_function_level) then
if assigned(procinfo^._class) and (lexlevel=normal_function_level) then
begin
procinfo.ESI_offset:=paramoffset;
procinfo^.ESI_offset:=paramoffset;
if assigned(aktprocsym^.definition) and
not(po_containsself in aktprocsym^.definition^.procoptions) then
inc(paramoffset,target_os.size_of_pointer);
end;
{ destructor flag ? }
if assigned (Procinfo._Class) and
procinfo._class^.is_class and
if assigned (procinfo^._Class) and
procinfo^._class^.is_class and
(pd^.proctypeoption=potype_destructor) then
inc(paramoffset,target_os.size_of_pointer);
procinfo.call_offset:=paramoffset;
procinfo^.call_offset:=paramoffset;
pd^.parast^.datasize:=0;
@ -574,11 +574,11 @@ begin
_CONSTRUCTOR : begin
consume(_CONSTRUCTOR);
parse_proc_head(potype_constructor);
if assigned(procinfo._class) and
procinfo._class^.is_class then
if assigned(procinfo^._class) and
procinfo^._class^.is_class then
begin
{ CLASS constructors return the created instance }
aktprocsym^.definition^.retdef:=procinfo._class;
aktprocsym^.definition^.retdef:=procinfo^._class;
end
else
begin
@ -604,7 +604,7 @@ begin
Message(parser_e_overload_operator_failed);
optoken:=token;
consume(Token);
procinfo.flags:=procinfo.flags or pi_operator;
procinfo^.flags:=procinfo^.flags or pi_operator;
parse_proc_head(potype_operator);
if token<>_ID then
begin
@ -674,7 +674,7 @@ end;
procedure pd_export(const procnames:Tstringcontainer);
begin
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
Message(parser_e_methods_dont_be_export);
if lexlevel<>normal_function_level then
Message(parser_e_dont_nest_export);
@ -682,7 +682,7 @@ begin
if target_info.target=target_i386_os2 then
begin
procnames.insert(realname);
procinfo.exported:=true;
procinfo^.exported:=true;
if cs_link_deffile in aktglobalswitches then
deffile.AddExport(aktprocsym^.definition^.mangledname);
end;
@ -1472,7 +1472,7 @@ begin
end;
end;
{ insert opsym only in the right symtable }
if ((procinfo.flags and pi_operator)<>0) and assigned(opsym)
if ((procinfo^.flags and pi_operator)<>0) and assigned(opsym)
and not parse_only then
begin
if ret_in_param(aktprocsym^.definition^.retdef) then
@ -1549,18 +1549,18 @@ begin
aktcontinuelabel:=nil;
{ insert symtables for the class, by only if it is no nested function }
if assigned(procinfo._class) and not(parent_has_class) then
if assigned(procinfo^._class) and not(parent_has_class) then
begin
{ insert them in the reverse order ! }
hp:=nil;
repeat
_class:=procinfo._class;
_class:=procinfo^._class;
while _class^.childof<>hp do
_class:=_class^.childof;
hp:=_class;
_class^.symtable^.next:=symtablestack;
symtablestack:=_class^.symtable;
until hp=procinfo._class;
until hp=procinfo^._class;
end;
{ insert parasymtable in symtablestack}
@ -1625,9 +1625,9 @@ begin
{ but only if the are no local variables }
{ already done in assembler_block }
{$ifdef newcg}
tg.setfirsttemp(procinfo.firsttemp);
tg.setfirsttemp(procinfo^.firsttemp);
{$else newcg}
setfirsttemp(procinfo.firsttemp);
setfirsttemp(procinfo^.firsttemp);
{$endif newcg}
{ ... and generate assembler }
@ -1635,7 +1635,7 @@ begin
aktlocalswitches:=entryswitches;
{$ifndef NOPASS2}
{$ifdef newcg}
tg.setfirsttemp(procinfo.firsttemp);
tg.setfirsttemp(procinfo^.firsttemp);
{$else newcg}
if assigned(code) then
generatecode(code);
@ -1667,10 +1667,10 @@ begin
aktlocalswitches:=entryswitches;
{$ifdef newcg}
if assigned(code) then
cg^.g_entrycode(procinfo.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
cg^.g_entrycode(procinfo^.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
{$else newcg}
if assigned(code) then
genentrycode(procinfo.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
genentrycode(procinfo^.aktentrycode,proc_names,make_global,stackframe,parasize,nostackframe,false);
{$endif newcg}
{ now generate exit code with the correct position and switches }
@ -1679,33 +1679,33 @@ begin
if assigned(code) then
begin
{$ifdef newcg}
cg^.g_exitcode(procinfo.aktexitcode,parasize,nostackframe,false);
cg^.g_exitcode(procinfo^.aktexitcode,parasize,nostackframe,false);
{$else newcg}
genexitcode(procinfo.aktexitcode,parasize,nostackframe,false);
genexitcode(procinfo^.aktexitcode,parasize,nostackframe,false);
{$endif newcg}
procinfo.aktproccode^.insertlist(procinfo.aktentrycode);
procinfo.aktproccode^.concatlist(procinfo.aktexitcode);
procinfo^.aktproccode^.insertlist(procinfo^.aktentrycode);
procinfo^.aktproccode^.concatlist(procinfo^.aktexitcode);
{$ifdef i386}
{$ifndef NoOpt}
if (cs_optimize in aktglobalswitches) and
{ do not optimize pure assembler procedures }
((procinfo.flags and pi_is_assembler)=0) then
Optimize(procinfo.aktproccode);
((procinfo^.flags and pi_is_assembler)=0) then
Optimize(procinfo^.aktproccode);
{$endif NoOpt}
{$endif}
{ save local data (casetable) also in the same file }
if assigned(procinfo.aktlocaldata) and
(not procinfo.aktlocaldata^.empty) then
if assigned(procinfo^.aktlocaldata) and
(not procinfo^.aktlocaldata^.empty) then
begin
procinfo.aktproccode^.concat(new(pai_section,init(sec_data)));
procinfo.aktproccode^.concatlist(procinfo.aktlocaldata);
procinfo^.aktproccode^.concat(new(pai_section,init(sec_data)));
procinfo^.aktproccode^.concatlist(procinfo^.aktlocaldata);
end;
{ now we can insert a cut }
if (cs_create_smart in aktmoduleswitches) then
codesegment^.concat(new(pai_cut,init));
{ add the procedure to the codesegment }
codesegment^.concatlist(procinfo.aktproccode);
codesegment^.concatlist(procinfo^.aktproccode);
end;
{$else}
if assigned(code) then
@ -1730,7 +1730,7 @@ begin
aktprocsym^.definition^.localst^.check_forwards;
aktprocsym^.definition^.localst^.checklabels;
end;
if (procinfo.flags and pi_uses_asm)=0 then
if (procinfo^.flags and pi_uses_asm)=0 then
begin
{ not for unit init, becuase the var can be used in finalize,
it will be done in proc_unit }
@ -1900,7 +1900,7 @@ procedure read_proc;
var
oldprefix : string;
oldprocsym : Pprocsym;
oldprocinfo : tprocinfo;
oldprocinfo : pprocinfo;
oldconstsymtable : Psymtable;
oldfilepos : tfileposinfo;
names : Pstringcontainer;
@ -1915,16 +1915,17 @@ begin
{ create a new procedure }
new(names,init);
codegen_newprocedure;
with procinfo do
with procinfo^ do
begin
parent:=@oldprocinfo;
parent:=oldprocinfo;
{ clear flags }
flags:=0;
{ standard frame pointer }
framepointer:=frame_pointer;
funcret_is_valid:=false;
{ is this a nested function of a method ? }
_class:=oldprocinfo._class;
if assigned(oldprocinfo) then
_class:=oldprocinfo^._class;
end;
parse_proc_dec;
@ -1950,7 +1951,7 @@ begin
pdflags:=pdflags or pd_implemen;
if (not current_module^.is_unit) or (cs_create_smart in aktmoduleswitches) then
pdflags:=pdflags or pd_global;
procinfo.exported:=false;
procinfo^.exported:=false;
aktprocsym^.definition^.forwarddef:=false;
end;
@ -1967,7 +1968,7 @@ begin
if not check_identical(prevdef) then
begin
{ A method must be forward defined (in the object declaration) }
if assigned(procinfo._class) and (not assigned(oldprocinfo._class)) then
if assigned(procinfo^._class) and (not assigned(oldprocinfo^._class)) then
Message(parser_e_header_dont_match_any_member);
{ Give a better error if there is a forward def in the interface and only
a single implementation }
@ -1980,23 +1981,23 @@ begin
else
begin
{ check the global flag }
if (procinfo.flags and pi_is_global)<>0 then
if (procinfo^.flags and pi_is_global)<>0 then
Message(parser_e_overloaded_must_be_all_global);
end
end;
{ set return type here, becuase the aktprocsym^.definition can be
changed by check_identical (PFV) }
procinfo.retdef:=aktprocsym^.definition^.retdef;
procinfo^.retdef:=aktprocsym^.definition^.retdef;
{ pointer to the return value ? }
if ret_in_param(procinfo.retdef) then
if ret_in_param(procinfo^.retdef) then
begin
procinfo.retoffset:=procinfo.call_offset;
inc(procinfo.call_offset,target_os.size_of_pointer);
procinfo^.retoffset:=procinfo^.call_offset;
inc(procinfo^.call_offset,target_os.size_of_pointer);
end;
{ allows to access the parameters of main functions in nested functions }
aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
aktprocsym^.definition^.parast^.address_fixup:=procinfo^.call_offset;
{ when it is a value para and it needs a local copy then rename
the parameter and insert a copy in the localst. This is not done
@ -2018,7 +2019,7 @@ begin
if assigned(aktprocsym^.definition^._class) then
tokeninfo^[_SELF].keyword:=m_all;
compile_proc_body(names^,((pdflags and pd_global)<>0),assigned(oldprocinfo._class));
compile_proc_body(names^,((pdflags and pd_global)<>0),assigned(oldprocinfo^._class));
{ reset _FAIL as normal }
if (aktprocsym^.definition^.proctypeoption=potype_constructor) then
@ -2053,7 +2054,11 @@ end.
{
$Log$
Revision 1.22 1999-09-20 16:39:00 peter
Revision 1.23 1999-09-27 23:44:56 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.22 1999/09/20 16:39:00 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.
@ -2066,7 +2071,7 @@ end.
* .... ???
Revision 1.20 1999/09/10 18:48:09 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.19 1999/09/07 14:59:40 pierre

14
compiler/ra386att.pas
View File

@ -1726,10 +1726,10 @@ Var
Begin
Message1(asmr_d_start_reading,'AT&T');
firsttoken:=TRUE;
if assigned(procinfo.retdef) and
(is_fpu(procinfo.retdef) or
ret_in_acc(procinfo.retdef)) then
procinfo.funcret_is_valid:=true;
if assigned(procinfo^.retdef) and
(is_fpu(procinfo^.retdef) or
ret_in_acc(procinfo^.retdef)) then
procinfo^.funcret_is_valid:=true;
{ sets up all opcode and register tables in uppercase }
if not _asmsorted then
Begin
@ -1973,7 +1973,11 @@ begin
end.
{
$Log$
Revision 1.58 1999-09-08 16:04:01 peter
Revision 1.59 1999-09-27 23:44:57 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.58 1999/09/08 16:04:01 peter
* better support for object fields and more error checks for
field accesses which create buggy code

44
compiler/ra386dir.pas
View File

@ -65,21 +65,21 @@ unit Ra386dir;
if s<>'' then
code^.concat(new(pai_direct,init(strpnew(s))));
{ consider it set function set if the offset was loaded }
if assigned(procinfo.retdef) and
if assigned(procinfo^.retdef) and
(pos(retstr,upper(s))>0) then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
s:='';
end;
begin
ende:=false;
s:='';
if assigned(procinfo.retdef) and
is_fpu(procinfo.retdef) then
procinfo.funcret_is_valid:=true;
if assigned(procinfo.retdef) and
(procinfo.retdef<>pdef(voiddef)) then
retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
if assigned(procinfo^.retdef) and
is_fpu(procinfo^.retdef) then
procinfo^.funcret_is_valid:=true;
if assigned(procinfo^.retdef) and
(procinfo^.retdef<>pdef(voiddef)) then
retstr:=upper(tostr(procinfo^.retoffset)+'('+att_reg2str[procinfo^.framepointer]+')')
else
retstr:='';
c:=current_scanner^.asmgetchar;
@ -136,10 +136,10 @@ unit Ra386dir;
{ is the last written character an special }
{ char ? }
if (s[length(s)]='%') and
ret_in_acc(procinfo.retdef) and
ret_in_acc(procinfo^.retdef) and
((pos('AX',upper(hs))>0) or
(pos('AL',upper(hs))>0)) then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
if (s[length(s)]<>'%') and
(s[length(s)]<>'$') and
((s[length(s)]<>'0') or (hs[1]<>'x')) then
@ -167,7 +167,7 @@ unit Ra386dir;
if (vo_is_external in pvarsym(sym)^.varoptions) then
hs:=pvarsym(sym)^.mangledname
else
hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo.framepointer]+')';
hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo^.framepointer]+')';
end
else
{ call to local function }
@ -190,7 +190,7 @@ unit Ra386dir;
l:=pvarsym(sym)^.address;
{ set offset }
inc(l,aktprocsym^.definition^.parast^.address_fixup);
hs:=tostr(l)+'('+att_reg2str[procinfo.framepointer]+')';
hs:=tostr(l)+'('+att_reg2str[procinfo^.framepointer]+')';
if pos(',',s) > 0 then
pvarsym(sym)^.varstate:=vs_used;
end;
@ -229,15 +229,15 @@ unit Ra386dir;
{$endif TESTGLOBALVAR}
if upper(hs)='__SELF' then
begin
if assigned(procinfo._class) then
hs:=tostr(procinfo.ESI_offset)+'('+att_reg2str[procinfo.framepointer]+')'
if assigned(procinfo^._class) then
hs:=tostr(procinfo^.ESI_offset)+'('+att_reg2str[procinfo^.framepointer]+')'
else
Message(asmr_e_cannot_use_SELF_outside_a_method);
end
else if upper(hs)='__RESULT' then
begin
if assigned(procinfo.retdef) and
(procinfo.retdef<>pdef(voiddef)) then
if assigned(procinfo^.retdef) and
(procinfo^.retdef<>pdef(voiddef)) then
hs:=retstr
else
Message(asmr_e_void_function);
@ -247,8 +247,8 @@ unit Ra386dir;
{ complicate to check there }
{ we do it: }
if lexlevel>normal_function_level then
hs:=tostr(procinfo.framepointer_offset)+
'('+att_reg2str[procinfo.framepointer]+')'
hs:=tostr(procinfo^.framepointer_offset)+
'('+att_reg2str[procinfo^.framepointer]+')'
else
Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
end;
@ -261,7 +261,7 @@ unit Ra386dir;
end;
'{',';',#10,#13 : begin
if pos(retstr,s) > 0 then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
writeasmline;
c:=current_scanner^.asmgetchar;
end;
@ -290,7 +290,11 @@ unit Ra386dir;
end.
{
$Log$
Revision 1.23 1999-08-04 00:23:26 florian
Revision 1.24 1999-09-27 23:44:58 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.23 1999/08/04 00:23:26 florian
* renamed i386asm and i386base to cpuasm and cpubase
Revision 1.22 1999/08/03 22:03:11 peter

14
compiler/ra386int.pas
View File

@ -1632,10 +1632,10 @@ Begin
Message1(asmr_d_start_reading,'intel');
inexpression:=FALSE;
firsttoken:=TRUE;
if assigned(procinfo.retdef) and
(is_fpu(procinfo.retdef) or
ret_in_acc(procinfo.retdef)) then
procinfo.funcret_is_valid:=true;
if assigned(procinfo^.retdef) and
(is_fpu(procinfo^.retdef) or
ret_in_acc(procinfo^.retdef)) then
procinfo^.funcret_is_valid:=true;
{ sets up all opcode and register tables in uppercase }
if not _asmsorted then
Begin
@ -1751,7 +1751,11 @@ begin
end.
{
$Log$
Revision 1.48 1999-09-20 16:39:01 peter
Revision 1.49 1999-09-27 23:44:58 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.48 1999/09/20 16:39:01 peter
* cs_create_smart instead of cs_smartlink
* -CX is create smartlink
* -CD is create dynamic, but does nothing atm.

32
compiler/rautils.pas
View File

@ -672,13 +672,13 @@ Function TOperand.SetupResult:boolean;
Begin
SetupResult:=false;
{ replace by correct offset. }
if assigned(procinfo.retdef) and
(procinfo.retdef<>pdef(voiddef)) then
if assigned(procinfo^.retdef) and
(procinfo^.retdef<>pdef(voiddef)) then
begin
opr.ref.offset:=procinfo.retoffset;
opr.ref.base:= procinfo.framepointer;
opr.ref.offset:=procinfo^.retoffset;
opr.ref.base:= procinfo^.framepointer;
{ always assume that the result is valid. }
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
SetupResult:=true;
end
else
@ -689,11 +689,11 @@ end;
Function TOperand.SetupSelf:boolean;
Begin
SetupSelf:=false;
if assigned(procinfo._class) then
if assigned(procinfo^._class) then
Begin
opr.typ:=OPR_REFERENCE;
opr.ref.offset:=procinfo.ESI_offset;
opr.ref.base:=procinfo.framepointer;
opr.ref.offset:=procinfo^.ESI_offset;
opr.ref.base:=procinfo^.framepointer;
opr.ref.options:=ref_selffixup;
SetupSelf:=true;
end
@ -708,8 +708,8 @@ Begin
if lexlevel>normal_function_level then
Begin
opr.typ:=OPR_REFERENCE;
opr.ref.offset:=procinfo.framepointer_offset;
opr.ref.base:=procinfo.framepointer;
opr.ref.offset:=procinfo^.framepointer_offset;
opr.ref.base:=procinfo^.framepointer;
SetupOldEBP:=true;
end
else
@ -756,7 +756,7 @@ Begin
opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname);
parasymtable :
begin
opr.ref.base:=procinfo.framepointer;
opr.ref.base:=procinfo^.framepointer;
opr.ref.offset:=pvarsym(sym)^.address;
opr.ref.offsetfixup:=aktprocsym^.definition^.parast^.address_fixup;
opr.ref.options:=ref_parafixup;
@ -767,7 +767,7 @@ Begin
opr.ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname)
else
begin
opr.ref.base:=procinfo.framepointer;
opr.ref.base:=procinfo^.framepointer;
opr.ref.offset:=-(pvarsym(sym)^.address);
opr.ref.options:=ref_localfixup;
opr.ref.offsetfixup:=aktprocsym^.definition^.localst^.address_fixup;
@ -1160,7 +1160,7 @@ Begin
base:=Copy(s,1,i-1);
delete(s,1,i);
if base='SELF' then
st:=procinfo._class^.symtable
st:=procinfo^._class^.symtable
else
begin
getsym(base,false);
@ -1433,7 +1433,11 @@ end;
end.
{
$Log$
Revision 1.26 1999-09-08 16:04:04 peter
Revision 1.27 1999-09-27 23:44:58 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.26 1999/09/08 16:04:04 peter
* better support for object fields and more error checks for
field accesses which create buggy code

50
compiler/symsym.inc
View File

@ -742,14 +742,9 @@
procedure tfuncretsym.write;
begin
(*
Normally all references are
transfered to the function symbol itself !! PM *)
tsym.write;
writedefref(funcretdef);
writelong(address);
current_ppu^.writeentry(ibfuncretsym);
end;
@ -769,24 +764,31 @@
var
l : longint;
begin
{ allocate space in local if ret in acc or in fpu }
if ret_in_acc(procinfo.retdef) or (procinfo.retdef^.deftype=floatdef) then
begin
l:=funcretdef^.size;
inc(owner^.datasize,l);
{ if retoffset is already set then reuse it, this is needed
when inserting the result variable }
if procinfo^.retoffset<>0 then
address:=procinfo^.retoffset
else
begin
{ allocate space in local if ret in acc or in fpu }
if ret_in_acc(procinfo^.retdef) or (procinfo^.retdef^.deftype=floatdef) then
begin
l:=funcretdef^.size;
inc(owner^.datasize,l);
{$ifdef m68k}
{ word alignment required for motorola }
if (l=1) then
inc(owner^.datasize,1)
else
{ word alignment required for motorola }
if (l=1) then
inc(owner^.datasize,1)
else
{$endif}
if (l>=4) and ((owner^.datasize and 3)<>0) then
inc(owner^.datasize,4-(owner^.datasize and 3))
else if (l>=2) and ((owner^.datasize and 1)<>0) then
inc(owner^.datasize,2-(owner^.datasize and 1));
address:=owner^.datasize;
procinfo.retoffset:=-owner^.datasize;
end;
if (l>=4) and ((owner^.datasize and 3)<>0) then
inc(owner^.datasize,4-(owner^.datasize and 3))
else if (l>=2) and ((owner^.datasize and 1)<>0) then
inc(owner^.datasize,2-(owner^.datasize and 1));
address:=owner^.datasize;
procinfo^.retoffset:=-owner^.datasize;
end;
end;
end;
@ -2164,7 +2166,11 @@
{
$Log$
Revision 1.119 1999-09-26 21:30:22 peter
Revision 1.120 1999-09-27 23:44:58 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.119 1999/09/26 21:30:22 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts

18
compiler/symtable.pas
View File

@ -1534,16 +1534,16 @@ implementation
end;
{ check for duplicate id in para symtable of methods }
if (symtabletype=parasymtable) and
assigned(procinfo._class) and
assigned(procinfo^._class) and
{ but not in nested procedures !}
(not(assigned(procinfo.parent)) or
(assigned(procinfo.parent) and
not(assigned(procinfo.parent^._class)))
(not(assigned(procinfo^.parent)) or
(assigned(procinfo^.parent) and
not(assigned(procinfo^.parent^._class)))
) and
{ funcretsym is allowed !! }
(sym^.typ <> funcretsym) then
begin
hsym:=search_class_member(procinfo._class,sym^.name);
hsym:=search_class_member(procinfo^._class,sym^.name);
{ but private ids can be reused }
if assigned(hsym) and
(not(sp_private in hsym^.symoptions) or
@ -2410,7 +2410,11 @@ implementation
end.
{
$Log$
Revision 1.48 1999-09-12 21:35:38 florian
Revision 1.49 1999-09-27 23:44:59 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.48 1999/09/12 21:35:38 florian
* fixed a crash under Linux. Why doesn't have the damned Windows DPMI nil pointer
protection???
@ -2422,7 +2426,7 @@ end.
* fixed copyright message (it is now 1993-99)
Revision 1.46 1999/09/10 18:48:10 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.45 1999/09/08 08:05:44 peter

2702
compiler/tcadd.pas
View File

File diff suppressed because it is too large Load Diff

14
compiler/tccal.pas
View File

@ -177,7 +177,7 @@ implementation
begin
{ not completly proper, but avoids some warnings }
if (p^.left^.treetype=funcretn) and (defcoll^.paratyp=vs_var) then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
store_valid:=must_be_valid;
{ protected has nothing to do with read/write
@ -469,7 +469,7 @@ implementation
if assigned(p^.right) then
begin
{ procedure does a call }
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
{ calc the correture value for the register }
{$ifdef i386}
@ -1043,7 +1043,7 @@ implementation
end;
end
else
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
{ work trough all parameters to insert the type conversions }
{ !!! done now after internproc !! (PM) }
@ -1222,7 +1222,11 @@ implementation
end.
{
$Log$
Revision 1.65 1999-09-16 23:05:56 florian
Revision 1.66 1999-09-27 23:45:00 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.65 1999/09/16 23:05:56 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.64 1999/09/14 07:59:48 florian
@ -1231,7 +1235,7 @@ end.
My last and also Peter's fix before were wrong :(
Revision 1.63 1999/09/10 18:48:11 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.62 1999/08/23 23:42:52 pierre

10
compiler/tccnv.pas
View File

@ -276,7 +276,7 @@ implementation
exit;
end
else
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
end;
{ for simplicity lets first keep all ansistrings
as LOC_MEM, could also become LOC_REGISTER }
@ -648,7 +648,7 @@ implementation
aprocdef:=assignment_overloaded(p^.left^.resulttype,p^.resulttype);
if assigned(aprocdef) then
begin
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
hp:=gencallnode(overloaded_operators[_assignment],nil);
{ tell explicitly which def we must use !! (PM) }
hp^.procdefinition:=aprocdef;
@ -962,7 +962,11 @@ implementation
end.
{
$Log$
Revision 1.49 1999-09-26 21:30:22 peter
Revision 1.50 1999-09-27 23:45:00 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.49 1999/09/26 21:30:22 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts

10
compiler/tcflw.pas
View File

@ -324,7 +324,7 @@ implementation
if assigned(p^.left) then
begin
firstpass(p^.left);
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
if codegenerror then
exit;
{ Check the 2 types }
@ -495,11 +495,15 @@ implementation
end.
{
$Log$
Revision 1.19 1999-09-16 23:05:56 florian
Revision 1.20 1999-09-27 23:45:01 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.19 1999/09/16 23:05:56 florian
* m68k compiler is again compilable (only gas writer, no assembler reader)
Revision 1.18 1999/09/16 10:44:30 pierre
* firstexit must now set procinfo.funcret_is_valid
* firstexit must now set procinfo^.funcret_is_valid
Revision 1.17 1999/08/23 23:41:45 pierre
* for reg allocation corrected

20
compiler/tcinl.pas
View File

@ -619,7 +619,7 @@ implementation
in_writeln_x :
begin
{ needs a call }
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
p^.resulttype:=voiddef;
{ we must know if it is a typed file or not }
{ but we must first do the firstpass for it }
@ -805,7 +805,7 @@ implementation
in_reset_typedfile,
in_rewrite_typedfile :
begin
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
{ to be sure the right definition is loaded }
p^.left^.resulttype:=nil;
firstpass(p^.left);
@ -814,7 +814,7 @@ implementation
in_str_x_string :
begin
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
p^.resulttype:=voiddef;
{ check the amount of parameters }
if not(assigned(p^.left)) or
@ -831,7 +831,7 @@ implementation
firstcallparan(p^.left,nil);
{ remove warning when result is passed }
if (p^.left^.left^.treetype=funcretn) then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
must_be_valid:=true;
p^.left^.right:=hp;
firstcallparan(p^.left^.right,nil);
@ -914,7 +914,7 @@ implementation
in_val_x :
begin
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
p^.resulttype:=voiddef;
{ check the amount of parameters }
if not(assigned(p^.left)) or
@ -959,7 +959,7 @@ implementation
exit;
{ remove warning when result is passed }
if (hpp^.left^.treetype=funcretn) then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
hpp^.right := hp;
if (hpp^.left^.location.loc<>LOC_REFERENCE) then
CGMessage(type_e_variable_id_expected)
@ -1009,7 +1009,7 @@ implementation
{$endif SUPPORT_MMX}
{ remove warning when result is passed }
if (p^.left^.left^.treetype=funcretn) then
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
{ first param must be var }
if (p^.left^.left^.location.loc<>LOC_REFERENCE) and
(p^.left^.left^.location.loc<>LOC_CREGISTER) then
@ -1250,7 +1250,11 @@ implementation
end.
{
$Log$
Revision 1.51 1999-09-15 20:35:46 florian
Revision 1.52 1999-09-27 23:45:01 peter
* procinfo is now a pointer
* support for result setting in sub procedure
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

18
compiler/tcld.pas
View File

@ -195,7 +195,7 @@ implementation
if (m_tp_procvar in aktmodeswitches) and
not(assigned(p^.left)) and
(pprocsym(p^.symtableentry)^.owner^.symtabletype=objectsymtable) then
p^.left:=genselfnode(procinfo._class);
p^.left:=genselfnode(procinfo^._class);
{ method pointer ? }
if assigned(p^.left) then
begin
@ -291,7 +291,7 @@ implementation
exit;
end;
{ we call STRCOPY }
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
hp:=p^.right;
{ test for s:=s+anything ... }
{ the problem is for
@ -350,12 +350,12 @@ implementation
p^.resulttype:=p^.retdef;
p^.location.loc:=LOC_REFERENCE;
if ret_in_param(p^.retdef) or
(@procinfo<>pprocinfo(p^.funcretprocinfo)) then
(procinfo<>pprocinfo(p^.funcretprocinfo)) then
p^.registers32:=1;
{ no claim if setting higher return value_str }
if must_be_valid and
(@procinfo=pprocinfo(p^.funcretprocinfo)) and
not procinfo.funcret_is_valid then
(procinfo=pprocinfo(p^.funcretprocinfo)) and
not procinfo^.funcret_is_valid then
CGMessage(sym_w_function_result_not_set);
{
if count_ref then
@ -509,7 +509,11 @@ implementation
end.
{
$Log$
Revision 1.45 1999-09-17 17:14:12 peter
Revision 1.46 1999-09-27 23:45:01 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.45 1999/09/17 17:14:12 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error
@ -523,7 +527,7 @@ end.
it is also allowed for objects !!
Revision 1.42 1999/09/10 18:48:11 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.41 1999/08/16 23:23:41 peter

10
compiler/tcmem.pas
View File

@ -89,7 +89,7 @@ implementation
{$endif SUPPORT_MMX}
end;
{ result type is already set }
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
if assigned(p^.left) then
p^.location.loc:=LOC_REGISTER
else
@ -155,7 +155,7 @@ implementation
p^.registersmmx:=p^.left^.registersmmx;
{$endif SUPPORT_MMX}
p^.resulttype:=voiddef;
procinfo.flags:=procinfo.flags or pi_do_call;
procinfo^.flags:=procinfo^.flags or pi_do_call;
end;
@ -630,7 +630,11 @@ implementation
end.
{
$Log$
Revision 1.28 1999-09-17 17:14:12 peter
Revision 1.29 1999-09-27 23:45:02 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.28 1999/09/17 17:14:12 peter
* @procvar fixes for tp mode
* @<id>:= gives now an error

16
compiler/tcset.pas
View File

@ -81,7 +81,7 @@ implementation
var
t : ptree;
pst : pconstset;
function createsetconst(psd : psetdef) : pconstset;
var
pcs : pconstset;
@ -109,7 +109,7 @@ implementation
end;
createsetconst:=pcs;
end;
begin
p^.location.loc:=LOC_FLAGS;
p^.resulttype:=booldef;
@ -131,7 +131,7 @@ implementation
is in typenodetype PM }
if p^.right^.treetype=typen then
p^.right^.resulttype:=p^.right^.typenodetype;
if p^.right^.resulttype^.deftype<>setdef then
CGMessage(sym_e_set_expected);
if codegenerror then
@ -146,7 +146,7 @@ implementation
putnode(p^.right);
p^.right:=t;
end;
firstpass(p^.left);
if codegenerror then
exit;
@ -181,7 +181,7 @@ implementation
{ this is not allways true due to optimization }
{ but if we don't set this we get problems with optimizing self code }
if psetdef(p^.right^.resulttype)^.settype<>smallset then
procinfo.flags:=procinfo.flags or pi_do_call
procinfo^.flags:=procinfo^.flags or pi_do_call
else
begin
{ a smallset needs maybe an misc. register }
@ -301,7 +301,11 @@ implementation
end.
{
$Log$
Revision 1.13 1999-09-07 15:01:33 pierre
Revision 1.14 1999-09-27 23:45:02 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.13 1999/09/07 15:01:33 pierre
* elem in set_type did not work yet
Revision 1.12 1999/08/04 00:23:45 florian

14
compiler/temp_gen.pas
View File

@ -278,7 +278,7 @@ unit temp_gen;
{ do a reset, because the reference isn't used }
reset_reference(ref);
ref.offset:=gettempofsize(l);
ref.base:=procinfo.framepointer;
ref.base:=procinfo^.framepointer;
end;
@ -288,7 +288,7 @@ unit temp_gen;
begin
{ do a reset, because the reference isn't used }
reset_reference(ref);
ref.base:=procinfo.framepointer;
ref.base:=procinfo^.framepointer;
{ Reuse old ansi slot ? }
foundslot:=nil;
tl:=templist;
@ -368,10 +368,10 @@ unit temp_gen;
{ ref.index = R_NO was missing
led to problems with local arrays
with lower bound > 0 (PM) }
istemp:=((ref.base=procinfo.framepointer) and
istemp:=((ref.base=procinfo^.framepointer) and
{$ifndef alpha}
(ref.index=R_NO) and
{$endif}
{$endif}
(ref.offset<firsttemp));
end;
@ -527,7 +527,11 @@ begin
end.
{
$Log$
Revision 1.36 1999-09-26 13:26:08 florian
Revision 1.37 1999-09-27 23:45:02 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.36 1999/09/26 13:26:08 florian
* exception patch of Romio nevertheless the excpetion handling
needs some corections regarding register saving
* gettempansistring is again a procedure

9
compiler/tgeni386.pas
View File

@ -114,8 +114,9 @@ implementation
var
r : tregister;
{$ifdef SUPPORT_MMX}
hr : preference;
{$endif}
begin
usedinproc:=usedinproc or b;
for r:=R_EAX to R_EBX do
@ -614,7 +615,11 @@ begin
end.
{
$Log$
Revision 1.34 1999-08-27 10:38:32 pierre
Revision 1.35 1999-09-27 23:45:02 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.34 1999/08/27 10:38:32 pierre
+ EXTTEMPREGDEBUG code added
Revision 1.33 1999/08/25 12:00:06 jonas

10
compiler/tree.pas
View File

@ -1644,7 +1644,7 @@ unit tree;
begin
case p^.treetype of
funcretn:
procinfo.funcret_is_valid:=true;
procinfo^.funcret_is_valid:=true;
vecn,typeconvn,subscriptn,derefn:
set_funcret_is_valid(p^.left);
end;
@ -1790,7 +1790,11 @@ unit tree;
end.
{
$Log$
Revision 1.98 1999-09-26 21:30:22 peter
Revision 1.99 1999-09-27 23:45:03 peter
* procinfo is now a pointer
* support for result setting in sub procedure
Revision 1.98 1999/09/26 21:30:22 peter
+ constant pointer support which can happend with typecasting like
const p=pointer(1)
* better procvar parsing in typed consts
@ -1803,7 +1807,7 @@ end.
* typo correction
Revision 1.95 1999/09/10 18:48:11 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* some bug fixes (e.g. must_be_valid and procinfo^.funcret_is_valid)
* most things for stored properties fixed
Revision 1.94 1999/09/07 07:52:20 peter