mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 14:09:29 +02:00
* made it again compilable
This commit is contained in:
florian
parent
36c8c81845
commit
8e9d97e1fe
@ -82,7 +82,8 @@ unit cg386;
|
||||
offset : longint);
|
||||
|
||||
begin
|
||||
list^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol(s,offset))));
|
||||
list^.concat(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol(s))));
|
||||
{!!!!!!!!!1 offset is ignored }
|
||||
end;
|
||||
|
||||
procedure tcg386.a_push_reg(list : paasmoutput;r : tregister);
|
||||
@ -118,7 +119,10 @@ unit cg386;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-01-23 23:29:43 florian
|
||||
Revision 1.3 1999-08-01 18:22:31 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.2 1999/01/23 23:29:43 florian
|
||||
* first running version of the new code generator
|
||||
* when compiling exceptions under Linux fixed
|
||||
|
||||
|
||||
@ -103,19 +103,19 @@ unit cgbase;
|
||||
procinfo : tprocinfo;
|
||||
|
||||
{ labels for BREAK and CONTINUE }
|
||||
aktbreaklabel,aktcontinuelabel : plabel;
|
||||
aktbreaklabel,aktcontinuelabel : pasmlabel;
|
||||
|
||||
{ label when the result is true or false }
|
||||
truelabel,falselabel : plabel;
|
||||
truelabel,falselabel : pasmlabel;
|
||||
|
||||
{ label to leave the sub routine }
|
||||
aktexitlabel : plabel;
|
||||
aktexitlabel : pasmlabel;
|
||||
|
||||
{ also an exit label, only used we need to clear only the stack }
|
||||
aktexit2label : plabel;
|
||||
aktexit2label : pasmlabel;
|
||||
|
||||
{ only used in constructor for fail or if getmem fails }
|
||||
quickexitlabel : plabel;
|
||||
quickexitlabel : pasmlabel;
|
||||
|
||||
{ Boolean, wenn eine loadn kein Assembler erzeugt hat }
|
||||
simple_loadn : boolean;
|
||||
@ -262,13 +262,13 @@ unit cgbase;
|
||||
codesegment:=new(paasmoutput,init);
|
||||
bsssegment:=new(paasmoutput,init);
|
||||
debuglist:=new(paasmoutput,init);
|
||||
externals:=new(paasmoutput,init);
|
||||
internals:=new(paasmoutput,init);
|
||||
consts:=new(paasmoutput,init);
|
||||
rttilist:=new(paasmoutput,init);
|
||||
importssection:=nil;
|
||||
exportssection:=nil;
|
||||
resourcesection:=nil;
|
||||
asmsymbollist:=new(pasmsymbollist,init);
|
||||
asmsymbollist^.usehash;
|
||||
end;
|
||||
|
||||
|
||||
@ -279,8 +279,6 @@ unit cgbase;
|
||||
dispose(bsssegment,done);
|
||||
dispose(datasegment,done);
|
||||
dispose(debuglist,done);
|
||||
dispose(externals,done);
|
||||
dispose(internals,done);
|
||||
dispose(consts,done);
|
||||
dispose(rttilist,done);
|
||||
if assigned(importssection) then
|
||||
@ -289,6 +287,9 @@ unit cgbase;
|
||||
dispose(exportssection,done);
|
||||
if assigned(resourcesection) then
|
||||
dispose(resourcesection,done);
|
||||
if assigned(resourcestringlist) then
|
||||
dispose(resourcestringlist,done);
|
||||
dispose(asmsymbollist,done);
|
||||
end;
|
||||
|
||||
|
||||
@ -358,7 +359,7 @@ unit cgbase;
|
||||
begin
|
||||
if ((loc.loc=LOC_MEM) or (loc.loc=LOC_REFERENCE)) and
|
||||
assigned(loc.reference.symbol) then
|
||||
stringdispose(loc.reference.symbol);
|
||||
dispose(loc.reference.symbol,done);
|
||||
loc.loc:=LOC_INVALID;
|
||||
end;
|
||||
|
||||
@ -368,13 +369,13 @@ unit cgbase;
|
||||
{ this is needed if you want to be able to delete }
|
||||
{ the string with the nodes }
|
||||
if assigned(destloc.reference.symbol) then
|
||||
stringdispose(destloc.reference.symbol);
|
||||
dispose(destloc.reference.symbol,done);
|
||||
destloc:= sourceloc;
|
||||
if sourceloc.loc in [LOC_MEM,LOC_REFERENCE] then
|
||||
begin
|
||||
if assigned(sourceloc.reference.symbol) then
|
||||
destloc.reference.symbol:=
|
||||
stringdup(sourceloc.reference.symbol^);
|
||||
sourceloc.reference.symbol;
|
||||
end
|
||||
else
|
||||
destloc.reference.symbol:=nil;
|
||||
@ -394,7 +395,10 @@ unit cgbase;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1999-01-23 23:29:45 florian
|
||||
Revision 1.5 1999-08-01 18:22:32 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.4 1999/01/23 23:29:45 florian
|
||||
* first running version of the new code generator
|
||||
* when compiling exceptions under Linux fixed
|
||||
|
||||
|
||||
@ -38,7 +38,7 @@ unit cgobj;
|
||||
destructor done;virtual;
|
||||
|
||||
procedure a_call_name_ext(list : paasmoutput;const s : string;
|
||||
offset : longint;m : texternal_typ);
|
||||
offset : longint);
|
||||
|
||||
{************************************************}
|
||||
{ code generation for subroutine entry/exit code }
|
||||
@ -46,11 +46,11 @@ unit cgobj;
|
||||
{ helper routines }
|
||||
procedure g_initialize_data(p : psym);
|
||||
procedure g_incr_data(p : psym);
|
||||
procedure g_finalize_data(p : psym);
|
||||
procedure g_finalize_data(p : pnamedindexobject);
|
||||
{$ifndef VALUEPARA}
|
||||
procedure g_copyopenarrays(p : psym);
|
||||
procedure g_copyopenarrays(p : pnamedindexobject);
|
||||
{$else}
|
||||
procedure g_copyvalueparas(p : psym);
|
||||
procedure g_copyvalueparas(p : pnamedindexobject);
|
||||
{$endif}
|
||||
|
||||
procedure g_entrycode(list : paasmoutput;
|
||||
@ -179,15 +179,15 @@ unit cgobj;
|
||||
|
||||
begin
|
||||
a_param_const32(list,stackframesize,1);
|
||||
a_call_name_ext(list,'FPC_STACKCHECK',0,EXT_NEAR);
|
||||
a_call_name_ext(list,'FPC_STACKCHECK',0);
|
||||
end;
|
||||
|
||||
procedure tcg.a_call_name_ext(list : paasmoutput;const s : string;
|
||||
offset : longint;m : texternal_typ);
|
||||
offset : longint);
|
||||
|
||||
begin
|
||||
a_call_name(list,s,offset);
|
||||
concat_external(s,m);
|
||||
{ concat_external(s,m); }
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
@ -319,7 +319,7 @@ unit cgobj;
|
||||
end;
|
||||
|
||||
{ generates the code for finalisation of local data }
|
||||
procedure tcg.g_finalize_data(p : psym);
|
||||
procedure tcg.g_finalize_data(p : pnamedindexobject);
|
||||
|
||||
var
|
||||
hr : treference;
|
||||
@ -369,9 +369,9 @@ unit cgobj;
|
||||
|
||||
{ generates the code to make local copies of the value parameters }
|
||||
{$ifndef VALUEPARA}
|
||||
procedure tcg.g_copyopenarrays(p : psym);
|
||||
procedure tcg.g_copyopenarrays(p : pnamedindexobject);
|
||||
{$else}
|
||||
procedure tcg.g_copyvalueparas(p : psym);
|
||||
procedure tcg.g_copyvalueparas(p : pnamedindexobject);
|
||||
{$endif}
|
||||
var
|
||||
{$ifdef VALUEPARA}
|
||||
@ -516,27 +516,27 @@ unit cgobj;
|
||||
{ wrappers for the methods, because TP doesn't know procedures }
|
||||
{ of objects }
|
||||
|
||||
procedure _copyopenarrays(s : psym);{$ifndef FPC}far;{$endif}
|
||||
procedure _copyopenarrays(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
|
||||
|
||||
begin
|
||||
cg^.g_copyopenarrays(s);
|
||||
end;
|
||||
|
||||
procedure _finalize_data(s : psym);{$ifndef FPC}far;{$endif}
|
||||
procedure _finalize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
|
||||
|
||||
begin
|
||||
cg^.g_finalize_data(s);
|
||||
end;
|
||||
|
||||
procedure _incr_data(s : psym);{$ifndef FPC}far;{$endif}
|
||||
procedure _incr_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
|
||||
|
||||
begin
|
||||
cg^.g_incr_data(s);
|
||||
cg^.g_incr_data(psym(s));
|
||||
end;
|
||||
procedure _initialize_data(s : psym);{$ifndef FPC}far;{$endif}
|
||||
procedure _initialize_data(s : pnamedindexobject);{$ifndef FPC}far;{$endif}
|
||||
|
||||
begin
|
||||
cg^.g_initialize_data(s);
|
||||
cg^.g_initialize_data(psym(s));
|
||||
end;
|
||||
|
||||
{ generates the entry code for a procedure }
|
||||
@ -568,7 +568,7 @@ unit cgobj;
|
||||
{ save registers on cdecl }
|
||||
if ((aktprocsym^.definition^.options and pocdecl)<>0) then
|
||||
begin
|
||||
for r:=firstregister to lastregister do
|
||||
for r:=firstreg to lastreg do
|
||||
begin
|
||||
if (r in registers_saved_on_cdecl) then
|
||||
if (r in general_registers) then
|
||||
@ -617,12 +617,12 @@ unit cgobj;
|
||||
{ needs the target a console flags ? }
|
||||
if tf_needs_isconsole in target_info.flags then
|
||||
begin
|
||||
hr.symbol:=stringdup('U_'+target_info.system_unit+'_ISCONSOLE');
|
||||
hr.symbol:=newasmsymbol('U_'+target_info.system_unit+'_ISCONSOLE');
|
||||
if apptype=at_cui then
|
||||
a_load_const8_ref(list,1,hr)
|
||||
else
|
||||
a_load_const8_ref(list,0,hr);
|
||||
stringdispose(hr.symbol);
|
||||
dispose(hr.symbol,done);
|
||||
end;
|
||||
|
||||
hp:=pused_unit(usedunits.first);
|
||||
@ -631,7 +631,7 @@ unit cgobj;
|
||||
{ call the unit init code and make it external }
|
||||
if (hp^.u^.flags and uf_init)<>0 then
|
||||
a_call_name_ext(list,
|
||||
'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR);
|
||||
'INIT$$'+hp^.u^.modulename^,0);
|
||||
hp:=Pused_unit(hp^.next);
|
||||
end;
|
||||
end;
|
||||
@ -641,18 +641,18 @@ unit cgobj;
|
||||
begin
|
||||
if procinfo._class^.isclass then
|
||||
begin
|
||||
list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
|
||||
list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
|
||||
newcsymbol('FPC_NEW_CLASS',0))));
|
||||
concat_external('FPC_NEW_CLASS',EXT_NEAR);
|
||||
list^.insert(new(pai386,op_cond_sym(A_Jcc,C_Z,S_NO,quickexitlabel)));
|
||||
list^.insert(new(pai386,op_sym(A_CALL,S_NO,newasmsymbol('FPC_NEW_CLASS'))));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{
|
||||
list^.insert(new(pai_labeled,init(A_JZ,quickexitlabel)));
|
||||
list^.insert(new(pai386,op_csymbol(A_CALL,S_NO,
|
||||
newcsymbol('FPC_HELP_CONSTRUCTOR',0))));
|
||||
list^.insert(new(pai386,op_const_reg(A_MOV,S_L,procinfo._class^.vmt_offset,R_EDI)));
|
||||
concat_external('FPC_HELP_CONSTRUCTOR',EXT_NEAR);
|
||||
}
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -703,9 +703,9 @@ unit cgobj;
|
||||
while hs<>'' do
|
||||
begin
|
||||
if make_global then
|
||||
list^.insert(new(pai_symbol,init_global(hs)))
|
||||
exprasmlist^.insert(new(pai_symbol,initname_global(hs,0)))
|
||||
else
|
||||
list^.insert(new(pai_symbol,init(hs)));
|
||||
exprasmlist^.insert(new(pai_symbol,initname(hs,0)));
|
||||
|
||||
{$ifdef GDB}
|
||||
if (cs_debuginfo in aktmoduleswitches) then
|
||||
@ -931,7 +931,10 @@ unit cgobj;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1999-01-23 23:29:46 florian
|
||||
Revision 1.6 1999-08-01 18:22:33 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.5 1999/01/23 23:29:46 florian
|
||||
* first running version of the new code generator
|
||||
* when compiling exceptions under Linux fixed
|
||||
|
||||
|
||||
@ -21,7 +21,8 @@
|
||||
****************************************************************************
|
||||
}
|
||||
{$ifdef i386}
|
||||
,i386
|
||||
,i386base
|
||||
,i386asm
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
,m68k
|
||||
@ -44,7 +45,10 @@
|
||||
{$endif}
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-15 22:16:03 florian
|
||||
Revision 1.2 1999-08-01 18:22:34 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.1 1998/12/15 22:16:03 florian
|
||||
* first version, all planned processors (?) added
|
||||
|
||||
}
|
||||
@ -46,7 +46,7 @@ unit nmem;
|
||||
implementation
|
||||
|
||||
uses
|
||||
cobjects,aasm,cgbase,cgobj
|
||||
cobjects,aasm,cgbase,cgobj,types,verbose
|
||||
{$I cpuunit.inc}
|
||||
{$I tempgen.inc}
|
||||
;
|
||||
@ -106,8 +106,7 @@ unit nmem;
|
||||
location.reference.offset:=pabsolutesym(symtableentry)^.address;
|
||||
end
|
||||
else
|
||||
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
||||
maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
|
||||
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
|
||||
end;
|
||||
varsym :
|
||||
begin
|
||||
@ -115,9 +114,7 @@ unit nmem;
|
||||
{ C variable }
|
||||
if (pvarsym(symtableentry)^.var_options and vo_is_C_var)<>0 then
|
||||
begin
|
||||
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
||||
if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
|
||||
maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
|
||||
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
|
||||
end
|
||||
|
||||
{$ifdef i386}
|
||||
@ -126,13 +123,10 @@ unit nmem;
|
||||
else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then
|
||||
begin
|
||||
hregister:=getregister32;
|
||||
stringdispose(location.reference.symbol);
|
||||
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
||||
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(location.reference),hregister)));
|
||||
stringdispose(location.reference.symbol);
|
||||
location.reference.symbol:=nil;
|
||||
location.reference.base:=hregister;
|
||||
if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
|
||||
maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
|
||||
end
|
||||
{$endif i386}
|
||||
else
|
||||
@ -153,10 +147,8 @@ unit nmem;
|
||||
begin
|
||||
location.reference.base:=procinfo.framepointer;
|
||||
location.reference.offset:=pvarsym(symtableentry)^.address;
|
||||
if (symtabletype=localsymtable) or (symtabletype=inlinelocalsymtable) then
|
||||
if (symtabletype in [localsymtable,inlinelocalsymtable]) then
|
||||
location.reference.offset:=-location.reference.offset;
|
||||
if (symtabletype=parasymtable) or (symtabletype=inlineparasymtable) then
|
||||
inc(location.reference.offset,symtable^.call_offset);
|
||||
if (lexlevel>(symtable^.symtablelevel)) then
|
||||
begin
|
||||
hregister:=getregister32;
|
||||
@ -184,10 +176,7 @@ unit nmem;
|
||||
case symtabletype of
|
||||
unitsymtable,globalsymtable,
|
||||
staticsymtable : begin
|
||||
stringdispose(location.reference.symbol);
|
||||
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
||||
if symtabletype=unitsymtable then
|
||||
concat_external(symtableentry^.mangledname,EXT_NEAR);
|
||||
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
|
||||
end;
|
||||
stt_exceptsymtable:
|
||||
begin
|
||||
@ -198,11 +187,7 @@ unit nmem;
|
||||
begin
|
||||
if (pvarsym(symtableentry)^.properties and sp_static)<>0 then
|
||||
begin
|
||||
stringdispose(location.reference.symbol);
|
||||
location.reference.symbol:=
|
||||
stringdup(symtableentry^.mangledname);
|
||||
if symtable^.defowner^.owner^.symtabletype=unitsymtable then
|
||||
concat_external(symtableentry^.mangledname,EXT_NEAR);
|
||||
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -230,14 +215,10 @@ unit nmem;
|
||||
end;
|
||||
{ in case call by reference, then calculate: }
|
||||
if (pvarsym(symtableentry)^.varspez=vs_var) or
|
||||
is_open_array(pvarsym(symtableentry)^.definition) or
|
||||
is_array_of_const(pvarsym(symtableentry)^.definition) or
|
||||
((pvarsym(symtableentry)^.varspez=vs_const) and
|
||||
{$ifndef VALUEPARA}
|
||||
dont_copy_const_param(pvarsym(symtableentry)^.definition)) or
|
||||
{ call by value open arrays are also indirect addressed }
|
||||
is_open_array(pvarsym(symtableentry)^.definition) then
|
||||
{$else}
|
||||
push_addr_param(pvarsym(symtableentry)^.definition)) then
|
||||
{$endif}
|
||||
begin
|
||||
simple_loadn:=false;
|
||||
if hregister=R_NO then
|
||||
@ -270,51 +251,30 @@ unit nmem;
|
||||
newreference(location.reference),
|
||||
hregister)));
|
||||
end;
|
||||
clear_reference(location.reference);
|
||||
reset_reference(location.reference);
|
||||
location.reference.base:=hregister;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
procsym:
|
||||
begin
|
||||
if is_methodpointer then
|
||||
begin
|
||||
secondpass(left);
|
||||
stringdispose(location.reference.symbol);
|
||||
{ virtual method ? }
|
||||
if (pprocsym(symtableentry)^.definition^.options and povirtualmethod)<>0 then
|
||||
begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
|
||||
maybe_concat_external(symtable,symtableentry^.mangledname);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{!!!!! Be aware, work on virtual methods too }
|
||||
stringdispose(location.reference.symbol);
|
||||
location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
|
||||
maybe_concat_external(symtable,symtableentry^.mangledname);
|
||||
end;
|
||||
{!!!!!!!!!!}
|
||||
end;
|
||||
typedconstsym :
|
||||
begin
|
||||
stringdispose(location.reference.symbol);
|
||||
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
||||
maybe_concat_external(symtable,symtableentry^.mangledname);
|
||||
location.reference.symbol:=newasmsymbol(symtableentry^.mangledname);
|
||||
end;
|
||||
else internalerror(4);
|
||||
end;
|
||||
end;
|
||||
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1999-01-24 22:32:36 florian
|
||||
Revision 1.2 1999-08-01 18:22:35 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.1 1999/01/24 22:32:36 florian
|
||||
* well, more changes, especially parts of secondload ported
|
||||
|
||||
}
|
||||
@ -29,7 +29,8 @@ interface
|
||||
uses
|
||||
tree;
|
||||
|
||||
procedure firstpass(p : pnode);
|
||||
procedure firstpass(p : ptree);
|
||||
procedure firstpassnode(p : pnode);
|
||||
function do_firstpass(var p : ptree) : boolean;
|
||||
function do_firstpassnode(var p : pnode) : boolean;
|
||||
|
||||
@ -44,12 +45,7 @@ implementation
|
||||
htypechk,tcadd,tccal,tccnv,tccon,tcflw,
|
||||
tcinl,tcld,tcmat,tcmem,tcset
|
||||
}
|
||||
{$ifdef i386}
|
||||
,i386,tgeni386
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
,m68k,tgen68k
|
||||
{$endif}
|
||||
{$I cpuunit.inc}
|
||||
;
|
||||
|
||||
{*****************************************************************************
|
||||
@ -116,7 +112,7 @@ implementation
|
||||
|
||||
{$endif dummy}
|
||||
|
||||
procedure firstpass(p : pnode);
|
||||
procedure firstpassnode(p : pnode);
|
||||
|
||||
var
|
||||
oldcodegenerror : boolean;
|
||||
@ -208,11 +204,17 @@ implementation
|
||||
do_firstpass:=codegenerror;
|
||||
end;
|
||||
|
||||
procedure firstpass(p : ptree);
|
||||
|
||||
begin
|
||||
codegenerror:=false;
|
||||
end;
|
||||
|
||||
function do_firstpassnode(var p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
codegenerror:=false;
|
||||
firstpass(p);
|
||||
firstpassnode(p);
|
||||
do_firstpassnode:=codegenerror;
|
||||
end;
|
||||
|
||||
@ -220,7 +222,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1999-01-23 23:29:48 florian
|
||||
Revision 1.4 1999-08-01 18:22:36 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.3 1999/01/23 23:29:48 florian
|
||||
* first running version of the new code generator
|
||||
* when compiling exceptions under Linux fixed
|
||||
|
||||
|
||||
@ -159,24 +159,14 @@ uses
|
||||
{$O os2_targ}
|
||||
{$O win_targ}
|
||||
{$endif i386}
|
||||
{$O asmutils}
|
||||
{$ifdef gdb}
|
||||
{$O gdb}
|
||||
{$endif gdb}
|
||||
{$ifdef i386}
|
||||
{$O opts386}
|
||||
{$O i386}
|
||||
{$O cgai386}
|
||||
{$O i386base}
|
||||
{$O i386asm}
|
||||
{$O tgeni386}
|
||||
{$O cg386add}
|
||||
{$O cg386cal}
|
||||
{$O cg386cnv}
|
||||
{$O cg386con}
|
||||
{$O cg386flw}
|
||||
{$O cg386ld}
|
||||
{$O cg386inl}
|
||||
{$O cg386mat}
|
||||
{$O cg386set}
|
||||
{$ifndef NOOPT}
|
||||
{$O aopt386}
|
||||
{$endif}
|
||||
@ -265,7 +255,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-12-26 15:20:31 florian
|
||||
Revision 1.2 1999-08-01 18:22:37 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.1 1998/12/26 15:20:31 florian
|
||||
+ more changes for the new version
|
||||
|
||||
}
|
||||
|
||||
@ -54,7 +54,7 @@ uses
|
||||
,gdb
|
||||
{$endif GDB}
|
||||
{$ifdef i386}
|
||||
,i386,tgeni386
|
||||
,i386base,tgeni386
|
||||
{$ifndef NoOpt}
|
||||
,aopt386
|
||||
{$endif}
|
||||
@ -195,7 +195,6 @@ begin
|
||||
vs:=new(Pvarsym,init('val'+s,p));
|
||||
vs^.fileinfo:=filepos;
|
||||
vs^.varspez:=varspez;
|
||||
vs^.localaddress:=l;
|
||||
aktprocsym^.definition^.parast^.insert(vs);
|
||||
end
|
||||
else
|
||||
@ -315,7 +314,7 @@ begin
|
||||
{$ifndef UseNiceNames}
|
||||
if assigned(procinfo._class) then
|
||||
if (pos('_$$_',procprefix)=0) then
|
||||
hs:=procprefix+'_$$_'+procinfo._class^.name^+'_'+sp
|
||||
hs:=procprefix+'_$$_'+procinfo._class^.name+'_'+sp
|
||||
else
|
||||
hs:=procprefix+'_$'+sp;
|
||||
{$else UseNiceNames}
|
||||
@ -695,7 +694,6 @@ begin
|
||||
{ external shouldn't override the cdecl/system name }
|
||||
if (aktprocsym^.definition^.options and poclearstack)=0 then
|
||||
aktprocsym^.definition^.setmangledname(aktprocsym^.name);
|
||||
externals^.concat(new(pai_external,init(aktprocsym^.mangledname,EXT_NEAR)));
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -924,7 +922,7 @@ begin
|
||||
end;
|
||||
{ manglednames are equal? }
|
||||
if (m_repeat_forward in aktmodeswitches) or
|
||||
assigned(aktprocsym^.definition^.parast^.root) then
|
||||
aktprocsym^.definition^.haspara then
|
||||
if (hd^.mangledname<>aktprocsym^.definition^.mangledname) then
|
||||
begin
|
||||
if (aktprocsym^.definition^.options and poexternal)=0 then
|
||||
@ -950,29 +948,9 @@ begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
ad:=hd^.parast^.root;
|
||||
fd:=aktprocsym^.definition^.parast^.root;
|
||||
if assigned(ad) and assigned(fd) then
|
||||
begin
|
||||
while assigned(ad) and assigned(fd) do
|
||||
begin
|
||||
if ad^.name<>fd^.name then
|
||||
begin
|
||||
Message3(parser_e_header_different_var_names,
|
||||
aktprocsym^.name,ad^.name,fd^.name);
|
||||
break;
|
||||
end;
|
||||
{ it is impossible to have a nil pointer }
|
||||
{ for only one parameter - since they }
|
||||
{ have the same number of parameters. }
|
||||
{ Left = next parameter. }
|
||||
ad:=ad^.left;
|
||||
fd:=fd^.left;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{ also the call_offset }
|
||||
hd^.parast^.call_offset:=aktprocsym^.definition^.parast^.call_offset;
|
||||
hd^.parast^.address_fixup:=aktprocsym^.definition^.parast^.address_fixup;
|
||||
|
||||
{ remove pd^.nextoverloaded from the list }
|
||||
{ and add aktprocsym^.definition }
|
||||
@ -989,7 +967,7 @@ begin
|
||||
hd^.extnumber:=aktprocsym^.definition^.extnumber;
|
||||
{ switch parast for warning in implementation PM }
|
||||
if (m_repeat_forward in aktmodeswitches) or
|
||||
assigned(aktprocsym^.definition^.parast^.root) then
|
||||
aktprocsym^.definition^.haspara then
|
||||
begin
|
||||
storeparast:=hd^.parast;
|
||||
hd^.parast:=aktprocsym^.definition^.parast;
|
||||
@ -1040,7 +1018,7 @@ procedure compile_proc_body(const proc_names : tstringcontainer;
|
||||
Compile the body of a procedure
|
||||
}
|
||||
var
|
||||
oldexitlabel,oldexit2label,oldquickexitlabel:Plabel;
|
||||
oldexitlabel,oldexit2label,oldquickexitlabel:Pasmlabel;
|
||||
_class,hp:Pobjectdef;
|
||||
{ switches can change inside the procedure }
|
||||
entryswitches, exitswitches : tlocalswitches;
|
||||
@ -1413,7 +1391,7 @@ begin
|
||||
inc(procinfo.call_offset,target_os.size_of_pointer);
|
||||
end;
|
||||
{ allows to access the parameters of main functions in nested functions }
|
||||
aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
|
||||
aktprocsym^.definition^.parast^.address_fixup:=procinfo.call_offset;
|
||||
|
||||
{ compile procedure when a body is needed }
|
||||
if (pdflags and pd_body)<>0 then
|
||||
@ -1448,7 +1426,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1999-01-13 22:52:39 florian
|
||||
Revision 1.3 1999-08-01 18:22:38 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.2 1999/01/13 22:52:39 florian
|
||||
+ YES, finally the new code generator is compilable, but it doesn't run yet :(
|
||||
|
||||
Revision 1.1 1998/12/26 15:20:31 florian
|
||||
|
||||
@ -144,7 +144,8 @@ unit tree;
|
||||
tc_fix_2_real,
|
||||
tc_proc_2_procvar,
|
||||
tc_arrayconstructor_2_set,
|
||||
tc_load_smallset
|
||||
tc_load_smallset,
|
||||
tc_bool_2_bool
|
||||
);
|
||||
|
||||
{ different assignment types }
|
||||
@ -158,10 +159,10 @@ unit tree;
|
||||
_low,_high : longint;
|
||||
|
||||
{ only used by gentreejmp }
|
||||
_at : plabel;
|
||||
_at : pasmlabel;
|
||||
|
||||
{ label of instruction }
|
||||
statement : plabel;
|
||||
statement : pasmlabel;
|
||||
|
||||
{ is this the first of an case entry, needed to release statement
|
||||
label (PFV) }
|
||||
@ -207,7 +208,6 @@ unit tree;
|
||||
{$endif EXTDEBUG}
|
||||
end;
|
||||
|
||||
{$ifndef nooldtree}
|
||||
{ allows to determine which elementes are to be replaced }
|
||||
tdisposetyp = (dt_nothing,dt_leftright,dt_left,
|
||||
dt_mbleft,dt_typeconv,dt_inlinen,
|
||||
@ -217,8 +217,7 @@ unit tree;
|
||||
ttree = record
|
||||
error : boolean;
|
||||
disposetyp : tdisposetyp;
|
||||
{ is true, if the
|
||||
right and left operand are swaped }
|
||||
{ is true, if the right and left operand are swaped }
|
||||
swaped : boolean;
|
||||
|
||||
{ the location of the result of this node }
|
||||
@ -233,41 +232,45 @@ unit tree;
|
||||
resulttype : pdef;
|
||||
fileinfo : tfileposinfo;
|
||||
localswitches : tlocalswitches;
|
||||
{$ifdef EXTDEBUG}
|
||||
{$ifdef extdebug}
|
||||
firstpasscount : longint;
|
||||
{$endif EXTDEBUG}
|
||||
{$endif extdebug}
|
||||
{$ifdef TEMPS_NOT_PUSH}
|
||||
temp_offset : longint;
|
||||
{$endif TEMPS_NOT_PUSH}
|
||||
case treetype : ttreetyp of
|
||||
addn : (use_strconcat : boolean;string_typ : tstringtype);
|
||||
callparan : (is_colon_para : boolean;exact_match_found : boolean);
|
||||
callparan : (is_colon_para : boolean;exact_match_found,
|
||||
convlevel1found,convlevel2found:boolean;hightree:ptree);
|
||||
assignn : (assigntyp : tassigntyp;concat_string : boolean);
|
||||
loadn : (symtableentry : psym;symtable : psymtable;
|
||||
is_absolute,is_first,is_methodpointer : boolean);
|
||||
calln : (symtableprocentry : psym;
|
||||
symtableproc : psymtable;procdefinition : pprocdef;
|
||||
is_absolute,is_first : boolean);
|
||||
calln : (symtableprocentry : pprocsym;
|
||||
symtableproc : psymtable;procdefinition : pabstractprocdef;
|
||||
methodpointer : ptree;
|
||||
no_check,unit_specific,return_value_used : boolean);
|
||||
no_check,unit_specific,
|
||||
return_value_used,static_call : boolean);
|
||||
ordconstn : (value : longint);
|
||||
realconstn : (value_real : bestreal;lab_real : plabel;realtyp : tait);
|
||||
realconstn : (value_real : bestreal;lab_real : pasmlabel);
|
||||
fixconstn : (value_fix: longint);
|
||||
funcretn : (funcretprocinfo : pointer;retdef : pdef);
|
||||
subscriptn : (vs : pvarsym);
|
||||
vecn : (memindex,memseg:boolean;callunique : boolean);
|
||||
stringconstn : (value_str : pchar;length : longint; lab_str : plabel;stringtype : tstringtype);
|
||||
stringconstn : (value_str : pchar;length : longint; lab_str : pasmlabel;stringtype : tstringtype);
|
||||
typeconvn : (convtyp : tconverttype;explizit : boolean);
|
||||
typen : (typenodetype : pdef);
|
||||
typen : (typenodetype : pdef;typenodesym:ptypesym);
|
||||
inlinen : (inlinenumber : byte;inlineconst:boolean);
|
||||
procinlinen : (inlineprocdef : pprocdef;
|
||||
retoffset,para_offset,para_size : longint);
|
||||
setconstn : (value_set : pconstset;lab_set:plabel);
|
||||
procinlinen : (inlinetree:ptree;inlineprocsym:pprocsym;retoffset,para_offset,para_size : longint);
|
||||
setconstn : (value_set : pconstset;lab_set:pasmlabel);
|
||||
loopn : (t1,t2 : ptree;backward : boolean);
|
||||
asmn : (p_asm : paasmoutput;object_preserved : boolean);
|
||||
casen : (nodes : pcaserecord;elseblock : ptree);
|
||||
labeln,goton : (labelnr : plabel);
|
||||
withn : (withsymtable : psymtable;tablecount : longint);
|
||||
labeln,goton : (labelnr : pasmlabel);
|
||||
withn : (withsymtable : pwithsymtable;tablecount : longint;withreference:preference;islocal:boolean);
|
||||
onn : (exceptsymtable : psymtable;excepttype : pobjectdef);
|
||||
arrayconstructn : (cargs,cargswap: boolean);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
punarynode = ^tunarynode;
|
||||
tunarynode = object(tnode)
|
||||
left : pnode;
|
||||
@ -320,7 +323,7 @@ unit tree;
|
||||
{$endif dummy}
|
||||
|
||||
function gennode(t : ttreetyp;l,r : ptree) : ptree;
|
||||
function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
|
||||
function genlabelnode(t : ttreetyp;nr : pasmlabel) : ptree;
|
||||
function genloadnode(v : pvarsym;st : psymtable) : ptree;
|
||||
function genloadcallnode(v: pprocsym;st: psymtable): ptree;
|
||||
function gensinglenode(t : ttreetyp;l : ptree) : ptree;
|
||||
@ -328,11 +331,12 @@ unit tree;
|
||||
function genordinalconstnode(v : longint;def : pdef) : ptree;
|
||||
function genfixconstnode(v : longint;def : pdef) : ptree;
|
||||
function gentypeconvnode(node : ptree;t : pdef) : ptree;
|
||||
function gentypenode(t : pdef) : ptree;
|
||||
function gentypenode(t : pdef;sym:ptypesym) : ptree;
|
||||
function gencallparanode(expr,next : ptree) : ptree;
|
||||
function genrealconstnode(v : bestreal) : ptree;
|
||||
function genrealconstnode(v : bestreal;def : pdef) : ptree;
|
||||
function gencallnode(v : pprocsym;st : psymtable) : ptree;
|
||||
function genmethodcallnode(v : pprocsym;st : psymtable;mp : ptree) : ptree;
|
||||
function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
|
||||
|
||||
{ allow pchar or string for defining a pchar node }
|
||||
function genstringconstnode(const s : string) : ptree;
|
||||
@ -438,7 +442,7 @@ unit tree;
|
||||
{ reference info }
|
||||
if (location.loc in [LOC_MEM,LOC_REFERENCE]) and
|
||||
assigned(location.reference.symbol) then
|
||||
stringdispose(location.reference.symbol);
|
||||
dispose(location.reference.symbol,done);
|
||||
{$ifdef EXTDEBUG}
|
||||
if firstpasscount>maxfirstpasscount then
|
||||
maxfirstpasscount:=firstpasscount;
|
||||
@ -740,7 +744,7 @@ unit tree;
|
||||
begin
|
||||
if assigned(symt) then
|
||||
begin
|
||||
p^.withsymtable:=symt^.next;
|
||||
p^.withsymtable:=pwithsymtable(symt^.next);
|
||||
dispose(symt,done);
|
||||
end;
|
||||
symt:=p^.withsymtable;
|
||||
@ -798,7 +802,7 @@ unit tree;
|
||||
{ reference info }
|
||||
if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
|
||||
assigned(p^.location.reference.symbol) then
|
||||
stringdispose(p^.location.reference.symbol);
|
||||
dispose(p^.location.reference.symbol,done);
|
||||
{$ifdef extdebug}
|
||||
if p^.firstpasscount>maxfirstpasscount then
|
||||
maxfirstpasscount:=p^.firstpasscount;
|
||||
@ -815,7 +819,7 @@ unit tree;
|
||||
hp:=getnode;
|
||||
hp^:=p^;
|
||||
if assigned(p^.location.reference.symbol) then
|
||||
hp^.location.reference.symbol:=stringdup(p^.location.reference.symbol^);
|
||||
hp^.location.reference.symbol:=p^.location.reference.symbol;
|
||||
case p^.disposetyp of
|
||||
dt_leftright :
|
||||
begin
|
||||
@ -887,7 +891,6 @@ unit tree;
|
||||
p^.symtableentry:=v;
|
||||
p^.symtable:=st;
|
||||
p^.is_first := False;
|
||||
p^.is_methodpointer:=false;
|
||||
{ method pointer load nodes can use the left subtree }
|
||||
p^.disposetyp:=dt_left;
|
||||
p^.left:=nil;
|
||||
@ -913,7 +916,7 @@ unit tree;
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.resulttype:=nil;
|
||||
p^.withsymtable:=symtable;
|
||||
p^.withsymtable:=pwithsymtable(symtable);
|
||||
p^.tablecount:=count;
|
||||
set_file_line(l,p);
|
||||
genwithnode:=p;
|
||||
@ -1058,8 +1061,8 @@ unit tree;
|
||||
genenumnode:=p;
|
||||
end;
|
||||
|
||||
function genrealconstnode(v : bestreal;def : pdef) : ptree;
|
||||
|
||||
function genrealconstnode(v : bestreal) : ptree;
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
@ -1069,24 +1072,14 @@ unit tree;
|
||||
p^.disposetyp:=dt_nothing;
|
||||
p^.treetype:=realconstn;
|
||||
p^.registers32:=0;
|
||||
{ p^.registers16:=0;
|
||||
{ p^.registers16:=0;
|
||||
p^.registers8:=0; }
|
||||
p^.registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
{$ifdef i386}
|
||||
p^.resulttype:=c64floatdef;
|
||||
p^.resulttype:=def;
|
||||
p^.value_real:=v;
|
||||
{ default value is double }
|
||||
p^.realtyp:=ait_real_64bit;
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
p^.resulttype:=new(pfloatdef,init(s32real));
|
||||
p^.value_real:=v;
|
||||
{ default value is double }
|
||||
p^.realtyp:=ait_real_32bit;
|
||||
{$endif}
|
||||
p^.lab_real:=nil;
|
||||
genrealconstnode:=p;
|
||||
end;
|
||||
@ -1275,27 +1268,6 @@ unit tree;
|
||||
gentypeconvnode:=p;
|
||||
end;
|
||||
|
||||
function gentypenode(t : pdef) : ptree;
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
|
||||
begin
|
||||
p:=getnode;
|
||||
p^.disposetyp:=dt_nothing;
|
||||
p^.treetype:=typen;
|
||||
p^.registers32:=0;
|
||||
{ p^.registers16:=0;
|
||||
p^.registers8:=0; }
|
||||
p^.registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.resulttype:=generrordef;
|
||||
p^.typenodetype:=t;
|
||||
gentypenode:=p;
|
||||
end;
|
||||
|
||||
function gencallnode(v : pprocsym;st : psymtable) : ptree;
|
||||
|
||||
var
|
||||
@ -1392,7 +1364,7 @@ unit tree;
|
||||
genzeronode:=p;
|
||||
end;
|
||||
|
||||
function genlabelnode(t : ttreetyp;nr : plabel) : ptree;
|
||||
function genlabelnode(t : ttreetyp;nr : pasmlabel) : ptree;
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
@ -1459,6 +1431,51 @@ unit tree;
|
||||
end;
|
||||
|
||||
|
||||
function gentypenode(t : pdef;sym:ptypesym) : ptree;
|
||||
var
|
||||
p : ptree;
|
||||
begin
|
||||
p:=getnode;
|
||||
p^.disposetyp:=dt_nothing;
|
||||
p^.treetype:=typen;
|
||||
p^.registers32:=0;
|
||||
{ p^.registers16:=0;
|
||||
p^.registers8:=0; }
|
||||
p^.registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.resulttype:=generrordef;
|
||||
p^.typenodetype:=t;
|
||||
p^.typenodesym:=sym;
|
||||
gentypenode:=p;
|
||||
end;
|
||||
|
||||
function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
|
||||
var
|
||||
p : ptree;
|
||||
|
||||
begin
|
||||
p:=getnode;
|
||||
p^.registers32:=0;
|
||||
{ p^.registers16:=0;
|
||||
p^.registers8:=0; }
|
||||
p^.registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.treetype:=loadn;
|
||||
p^.left:=nil;
|
||||
p^.resulttype:=v^.definition;
|
||||
p^.symtableentry:=v;
|
||||
p^.symtable:=st;
|
||||
p^.is_first := False;
|
||||
p^.disposetyp:=dt_left;
|
||||
p^.left:=mp;
|
||||
genloadmethodcallnode:=p;
|
||||
end;
|
||||
|
||||
|
||||
{ uses the callnode to create the new procinline node }
|
||||
function genprocinlinenode(callp,code : ptree) : ptree;
|
||||
|
||||
@ -1466,23 +1483,6 @@ unit tree;
|
||||
p : ptree;
|
||||
|
||||
begin
|
||||
p:=getnode;
|
||||
p^.disposetyp:=dt_left;
|
||||
p^.treetype:=procinlinen;
|
||||
p^.inlineprocdef:=callp^.procdefinition;
|
||||
p^.retoffset:=-4; { less dangerous as zero (PM) }
|
||||
p^.para_offset:=0;
|
||||
p^.para_size:=p^.inlineprocdef^.para_size;
|
||||
if ret_in_param(p^.inlineprocdef^.retdef) then
|
||||
p^.para_size:=p^.para_size+target_os.size_of_pointer;
|
||||
{ copy args }
|
||||
p^.left:=getcopy(code);
|
||||
p^.registers32:=code^.registers32;
|
||||
p^.registersfpu:=code^.registersfpu;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p^.registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
p^.resulttype:=p^.inlineprocdef^.retdef;
|
||||
genprocinlinenode:=p;
|
||||
end;
|
||||
|
||||
@ -1734,11 +1734,6 @@ unit tree;
|
||||
comment(v_warning,'labnumber field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
if oldp^.realtyp<>p^.realtyp then
|
||||
begin
|
||||
comment(v_warning,'realtyp field different');
|
||||
error_found:=true;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if not error_found then
|
||||
@ -1896,7 +1891,10 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1999-01-24 22:32:36 florian
|
||||
Revision 1.7 1999-08-01 18:22:39 florian
|
||||
* made it again compilable
|
||||
|
||||
Revision 1.6 1999/01/24 22:32:36 florian
|
||||
* well, more changes, especially parts of secondload ported
|
||||
|
||||
Revision 1.5 1999/01/23 23:29:49 florian
|
||||
|
||||
Loading…
Reference in New Issue
Block a user