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

* first running version of the new code generator

Browse Source 
* when compiling exceptions under Linux fixed
This commit is contained in:
florian 1999-01-23 23:29:31 +00:00
parent 3316a50471
commit 90d0bea35a
11 changed files with 249 additions and 180 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
compiler/i386.pas
View File

@ -207,10 +207,17 @@ unit i386;
R_ST,R_ST0,R_ST1,R_ST2,R_ST3,R_ST4,R_ST5,R_ST6,R_ST7,
R_MM0,R_MM1,R_MM2,R_MM3,R_MM4,R_MM5,R_MM6,R_MM7,
R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7);
tregisterset = set of tregister;
const
firstreg = low(tregister);
lastreg = high(tregister);
regset8bit : tregisterset = [R_AL..R_DH];
regset16bit : tregisterset = [R_AX..R_DI,R_CS..R_SS];
regset32bit : tregisterset = [R_EAX..R_EDI];
type
{ S_NO = No Size of operand }
{ S_B = Byte size operand }
@ -463,6 +470,9 @@ unit i386;
{ can be ignored on 32 bit systems }
function regtoreg64(reg : tregister) : tregister;
{ returns the operand prefix for a given register }
function regsize(reg : tregister) : topsize;
{ resets all values of ref to defaults }
procedure reset_reference(var ref : treference);
{ set mostly used values of a new reference }
@ -1327,6 +1337,17 @@ unit i386;
internalerror(6464);
end;
function regsize(reg : tregister) : topsize;
begin
if reg in regset8bit then
regsize:=S_B
else if reg in regset16bit then
regsize:=S_W
else if reg in regset32bit then
regsize:=S_L;
end;
procedure reset_reference(var ref : treference);
begin
@ -1954,7 +1975,11 @@ Begin
end.
{
$Log$
Revision 1.30 1999-01-19 10:50:01 pierre
Revision 1.31 1999-01-23 23:29:31 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.30 1999/01/19 10:50:01 pierre
* avoid result no set warning in regtoreg64
Revision 1.29 1999/01/19 10:19:02 florian

65
compiler/new/cg386.pas
View File

@ -25,7 +25,9 @@ unit cg386;
interface
uses
cgobj;
cgobj,aasm
{$i cpuunit.inc}
;
type
pcg386 = ^tcg386;
@ -35,26 +37,35 @@ unit cg386;
procedure a_call_name(list : paasmoutput;const s : string;
offset : longint);virtual;
procedure a_load_const8_ref(list : paasmoutput;b : byte;ref : treference);virtual;
procedure a_load_const16_ref(list : paasmoutput;w : word;ref : treference);virtual;
procedure a_load_const32_ref(list : paasmoutput;l : longint;ref : treference);virtual;
procedure a_load_const64_ref(list : paasmoutput;{ q : qword; }ref : treference);virtual;
procedure a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);virtual;
procedure a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);virtual;
procedure a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);virtual;
procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual;
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
constructor init;
end;
implementation
uses
globtype,globals;
constructor tcg386.init;
begin
inherited init;
end;
procedure tcg386.g_stackframe_entry(list : paasmoutput;localsize : longint);
begin
if localsize<>0 then
begin
if (cs_littlesize in aktglobalswitches) and (stackframe<=65535) then
list^.insert(new(pai386,op_const_const(A_ENTER,S_NO,stackframe,0)))
if (cs_littlesize in aktglobalswitches) and (localsize<=65535) then
list^.insert(new(pai386,op_const_const(A_ENTER,S_NO,localsize,0)))
else
begin
g_stackframe_entry(list,stackframe);
list^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EBP)));
list^.concat(new(pai386,op_reg_reg(A_MOV,S_L,R_ESP,R_EBP)));
list^.concat(new(pai386,op_const_reg(A_SUB,S_L,localsize,R_ESP)));
@ -74,10 +85,44 @@ unit cg386;
list^.concat(new(pai386,op_csymbol(A_CALL,S_NO,newcsymbol(s,offset))));
end;
procedure tcg386.a_push_reg(list : paasmoutput;r : tregister);
begin
list^.concat(new(pai386,op_reg(A_PUSH,regsize(r),r)));
end;
procedure tcg386.a_load_const8_ref(list : paasmoutput;b : byte;const ref : treference);
begin
abstract;
end;
procedure tcg386.a_load_const16_ref(list : paasmoutput;w : word;const ref : treference);
begin
abstract;
end;
procedure tcg386.a_load_const32_ref(list : paasmoutput;l : longint;const ref : treference);
begin
abstract;
end;
procedure tcg386.a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);
begin
abstract;
end;
end.
{
$Log$
Revision 1.1 1998-12-15 22:17:02 florian
Revision 1.2 1999-01-23 23:29:43 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.1 1998/12/15 22:17:02 florian
* first version
}

7
compiler/new/cgbase.pas
View File

@ -272,7 +272,6 @@ unit cgbase;
end;
procedure codegen_donemodule;
begin
dispose(exprasmlist,done);
@ -395,7 +394,11 @@ unit cgbase;
end.
{
$Log$
Revision 1.3 1999-01-06 22:58:48 florian
Revision 1.4 1999-01-23 23:29:45 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.3 1999/01/06 22:58:48 florian
+ some stuff for the new code generator
Revision 1.2 1998/12/26 15:20:28 florian

128
compiler/new/cgobj.pas
View File

@ -34,6 +34,9 @@ unit cgobj;
pcg = ^tcg;
tcg = object
constructor init;
destructor done;virtual;
procedure a_call_name_ext(list : paasmoutput;const s : string;
offset : longint;m : texternal_typ);
@ -75,7 +78,7 @@ unit cgobj;
procedure a_load_const64_ref(list : paasmoutput;q : qword;const ref : treference);virtual;
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure g_maybe_loadself(list : paasmoutput);virtual;
{********************************************************}
@ -113,6 +116,16 @@ unit cgobj;
{$endif i386}
;
constructor tcg.init;
begin
end;
destructor tcg.done;
begin
end;
{*****************************************************************************
per default, this methods nothing, can overriden
*****************************************************************************}
@ -534,7 +547,7 @@ unit cgobj;
var
hs : string;
hp : pused_unit;
unitinits,initcode : taasmoutput;
initcode : taasmoutput;
{$ifdef GDB}
stab_function_name : Pai_stab_function_name;
{$endif GDB}
@ -552,61 +565,6 @@ unit cgobj;
if not(cs_littlesize in aktglobalswitches) then
list^.insert(new(pai_align,init(4)));
end;
if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then
begin
{ 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');
if apptype=at_cui then
a_load_const8_ref(list,1,hr)
else
a_load_const8_ref(list,0,hr);
stringdispose(hr.symbol);
end;
{ Call the unit init procedures }
unitinits.init;
hp:=pused_unit(usedunits.first);
while assigned(hp) do
begin
{ call the unit init code and make it external }
if (hp^.u^.flags and uf_init)<>0 then
a_call_name_ext(@unitinits,
'INIT$$'+hp^.u^.modulename^,0,EXT_NEAR);
hp:=Pused_unit(hp^.next);
end;
list^.insertlist(@unitinits);
unitinits.done;
end;
{ a constructor needs a help procedure }
if (aktprocsym^.definition^.options and poconstructor)<>0 then
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);
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;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list^.insert(new(pai_force_line,init));
{$endif GDB}
{ save registers on cdecl }
if ((aktprocsym^.definition^.options and pocdecl)<>0) then
begin
@ -622,7 +580,6 @@ unit cgobj;
a_push_reg(list,r);
end;
end;
{ omit stack frame ? }
if not inlined then
if procinfo.framepointer=stack_pointer then
@ -654,6 +611,55 @@ unit cgobj;
if cs_profile in aktmoduleswitches then
g_profilecode(@initcode);
if (not inlined) and ((aktprocsym^.definition^.options and poproginit)<>0) then
begin
{ 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');
if apptype=at_cui then
a_load_const8_ref(list,1,hr)
else
a_load_const8_ref(list,0,hr);
stringdispose(hr.symbol);
end;
hp:=pused_unit(usedunits.first);
while assigned(hp) do
begin
{ 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);
hp:=Pused_unit(hp^.next);
end;
end;
{ a constructor needs a help procedure }
if (aktprocsym^.definition^.options and poconstructor)<>0 then
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);
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;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) then
list^.insert(new(pai_force_line,init));
{$endif GDB}
{ initialize return value }
if is_ansistring(procinfo.retdef) or
@ -925,7 +931,11 @@ unit cgobj;
end.
{
$Log$
Revision 1.4 1999-01-13 22:52:36 florian
Revision 1.5 1999-01-23 23:29:46 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.4 1999/01/13 22:52:36 florian
+ YES, finally the new code generator is compilable, but it doesn't run yet :(
Revision 1.3 1998/12/26 15:20:30 florian

8
compiler/new/convtree.pas
View File

@ -34,7 +34,7 @@ unit convtree;
implementation
uses
verbose;
verbose,nstatmnt;
function convtree2node(p : ptree) : pnode;
@ -59,7 +59,11 @@ unit convtree;
end.
{
$Log$
Revision 1.2 1999-01-19 10:19:04 florian
Revision 1.3 1999-01-23 23:29:47 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.2 1999/01/19 10:19:04 florian
* bug with mul. of dwords fixed, reported by Alexander Stohr
* some changes to compile with TP
+ small enhancements for the new code generator

84
compiler/new/pass_1.pas
View File

@ -108,84 +108,6 @@ implementation
end;
procedure firstblock(var p : ptree);
var
hp : ptree;
count : longint;
begin
count:=0;
hp:=p^.left;
while assigned(hp) do
begin
if cs_regalloc in aktglobalswitches then
begin
{ Codeumstellungen }
{ Funktionsresultate an exit anh„ngen }
{ this is wrong for string or other complex
result types !!! }
if ret_in_acc(procinfo.retdef) and
assigned(hp^.left) and
(hp^.left^.right^.treetype=exitn) and
(hp^.right^.treetype=assignn) and
(hp^.right^.left^.treetype=funcretn) then
begin
if assigned(hp^.left^.right^.left) then
CGMessage(cg_n_inefficient_code)
else
begin
hp^.left^.right^.left:=getcopy(hp^.right^.right);
disposetree(hp^.right);
hp^.right:=nil;
end;
end
{ warning if unreachable code occurs and elimate this }
else if (hp^.right^.treetype in
[exitn,breakn,continuen,goton]) and
assigned(hp^.left) and
(hp^.left^.treetype<>labeln) then
begin
{ use correct line number }
aktfilepos:=hp^.left^.fileinfo;
disposetree(hp^.left);
hp^.left:=nil;
CGMessage(cg_w_unreachable_code);
{ old lines }
aktfilepos:=hp^.right^.fileinfo;
end;
end;
if assigned(hp^.right) then
begin
cleartempgen;
firstpass(hp^.right);
if (not (cs_extsyntax in aktmoduleswitches)) and
assigned(hp^.right^.resulttype) and
(hp^.right^.resulttype<>pdef(voiddef)) then
CGMessage(cg_e_illegal_expression);
if codegenerror then
exit;
hp^.registers32:=hp^.right^.registers32;
hp^.registersfpu:=hp^.right^.registersfpu;
{$ifdef SUPPORT_MMX}
hp^.registersmmx:=hp^.right^.registersmmx;
{$endif SUPPORT_MMX}
end
else
hp^.registers32:=0;
if hp^.registers32>p^.registers32 then
p^.registers32:=hp^.registers32;
if hp^.registersfpu>p^.registersfpu then
p^.registersfpu:=hp^.registersfpu;
{$ifdef SUPPORT_MMX}
if hp^.registersmmx>p^.registersmmx then
p^.registersmmx:=hp^.registersmmx;
{$endif}
inc(count);
hp:=hp^.left;
end;
end;
procedure firstasm(var p : ptree);
begin
@ -298,7 +220,11 @@ implementation
end.
{
$Log$
Revision 1.2 1999-01-13 22:52:37 florian
Revision 1.3 1999-01-23 23:29:48 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.2 1999/01/13 22:52:37 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

38
compiler/new/tree.pas
View File

@ -281,12 +281,13 @@ unit tree;
tunarynode = object(tnode)
left : pnode;
procedure dowrite;virtual;
constructor init(l : pnode);
constructor init(l : pnode);
end;
pbinarynode = ^tbinarynode;
tbinarynode = object(tunarynode)
right : pnode;
constructor init(l,r : pnode);
end;
pbinopnode = ^tbinopnode;
@ -294,11 +295,7 @@ unit tree;
{ is true, if the right and left operand are swaped }
{ against the original order }
swaped : boolean;
end;
pblocknode = ^tblocknode;
tblocknode = object(tunarynode)
constructor init(l : pnode);
constructor init(l,r : pnode);
end;
{$ifdef dummy}
@ -460,7 +457,9 @@ unit tree;
procedure tnode.pass_1;
begin
det_resulttype;
if not(assigned(resulttype)) then
det_resulttype;
det_temp;
end;
@ -623,20 +622,31 @@ unit tree;
end;
{****************************************************************************
TBLOCKNODE
TBINARYNODE
****************************************************************************}
constructor tblocknode.init(l : pnode);
constructor tbinarynode.init(l,r : pnode);
begin
inherited init(l);
treetype:=blockn;
right:=r
end;
{****************************************************************************
TBINOPYNODE
****************************************************************************}
constructor tbinopnode.init(l,r : pnode);
begin
inherited init(l,r);
swaped:=false;
end;
{$ifdef dummy}
{ clean up the contents of a node }
case p^.treetype of
asmn : if assigned(p^.p_asm) then
asmn : if assigned(p^.p_asm) then
dispose(p^.p_asm,done);
stringconstn : begin
ansistringdispose(p^.value_str,p^.length);
@ -1925,7 +1935,11 @@ unit tree;
end.
{
$Log$
Revision 1.4 1999-01-19 10:19:06 florian
Revision 1.5 1999-01-23 23:29:49 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.4 1999/01/19 10:19:06 florian
* bug with mul. of dwords fixed, reported by Alexander Stohr
* some changes to compile with TP
+ small enhancements for the new code generator

34
compiler/parser.pas
View File

@ -44,7 +44,7 @@ unit parser;
const
parser_current_file : string = '';
implementation
uses
@ -61,6 +61,12 @@ unit parser;
{$ifdef UseExcept}
tpexcept,compiler,
{$endif UseExcept}
{$ifdef newcg}
cgobj,
{$ifdef i386}
cg386,
{$endif i386}
{$endif newcg}
tree,scanner,pbase,pdecl,psystem,pmodules;
@ -169,6 +175,9 @@ unit parser;
recoverpos : jmp_buf;
oldrecoverpos : pjmp_buf;
{$endif useexcept}
{$ifdef newcg}
oldcg : pcg;
{$endif newcg}
begin
inc(compile_level);
@ -214,7 +223,9 @@ unit parser;
oldaktasmmode:=aktasmmode;
oldaktfilepos:=aktfilepos;
oldaktmodeswitches:=aktmodeswitches;
{$ifdef newcg}
oldcg:=cg;
{$endif newcg}
{ show info }
Message1(parser_i_compiling,filename);
@ -267,7 +278,11 @@ unit parser;
{ init code generator for a new module }
codegen_newmodule;
{$ifdef newcg}
{$ifdef i386}
cg:=new(pcg386,init);
{$endif i386}
{$endif newcg}
{ Handle things which need to be once }
if (compile_level=1) then
begin
@ -314,6 +329,10 @@ unit parser;
it's the default to release the trees }
codegen_donemodule;
{$ifdef newcg}
dispose(cg,done);
{$endif newcg}
{ free ppu }
if assigned(current_module^.ppufile) then
begin
@ -333,6 +352,9 @@ unit parser;
if (compile_level>1) then
begin
{$ifdef newcg}
cg:=oldcg;
{$endif newcg}
{ restore scanner }
c:=oldc;
pattern:=oldpattern;
@ -424,7 +446,11 @@ unit parser;
end.
{
$Log$
Revision 1.65 1999-01-22 12:19:31 pierre
Revision 1.66 1999-01-23 23:29:35 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.65 1999/01/22 12:19:31 pierre
+ currently compiled file name added on errors
Revision 1.64 1999/01/12 14:25:29 peter

8
compiler/pass_2.pas
View File

@ -386,7 +386,7 @@ implementation
begin
{ it is nonsens, to copy the variable to }
{ a register because we need then much }
{ pushes ? }
{ too pushes ? }
if reg_pushes[varregs[i]]>=regvars[i]^.refs then
begin
regvars[i]:=nil;
@ -495,7 +495,11 @@ implementation
end.
{
$Log$
Revision 1.13 1998-12-30 13:41:09 peter
Revision 1.14 1999-01-23 23:29:37 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.13 1998/12/30 13:41:09 peter
* released valuepara
Revision 1.12 1998/12/19 00:23:51 florian

13
compiler/pstatmnt.pas
View File

@ -551,9 +551,6 @@ unit pstatmnt;
{ is a explicit name for the exception given ? }
if token=COLON then
begin
sym:=new(pvarsym,init(objname,nil));
exceptsymtable:=new(psymtable,init(stt_exceptsymtable));
exceptsymtable^.insert(sym);
consume(COLON);
getsym(pattern,false);
consume(ID);
@ -571,7 +568,9 @@ unit pstatmnt;
message(type_e_class_type_expected);
ot:=pobjectdef(generrordef);
end;
sym^.definition:=ot;
sym:=new(pvarsym,init(objname,ot));
exceptsymtable:=new(psymtable,init(stt_exceptsymtable));
exceptsymtable^.insert(sym);
{ insert the exception symtable stack }
exceptsymtable^.next:=symtablestack;
symtablestack:=exceptsymtable;
@ -1247,7 +1246,11 @@ unit pstatmnt;
end.
{
$Log$
Revision 1.59 1999-01-21 16:41:02 pierre
Revision 1.60 1999-01-23 23:29:38 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.59 1999/01/21 16:41:02 pierre
* fix for constructor inside with statements
Revision 1.58 1999/01/05 08:20:07 florian

17
compiler/symsym.inc
View File

@ -846,10 +846,12 @@
var_options:=0;
{ can we load the value into a register ? }
case p^.deftype of
pointerdef,
pointerdef,
enumdef,
procvardef : var_options:=var_options or vo_regable;
orddef : case porddef(p)^.typ of
procvardef:
var_options:=var_options or vo_regable;
orddef: case porddef(p)^.typ of
u8bit,u16bit,u32bit,
bool8bit,bool16bit,bool32bit,
s8bit,s16bit,s32bit :
@ -857,6 +859,9 @@
else
var_options:=var_options and not vo_regable;
end;
setdef:
if psetdef(p)^.settype=smallset then
var_options:=var_options or vo_regable;
else
var_options:=var_options and not vo_regable;
end;
@ -1764,7 +1769,11 @@
{
$Log$
Revision 1.70 1999-01-21 22:10:48 peter
Revision 1.71 1999-01-23 23:29:41 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.70 1999/01/21 22:10:48 peter
* fixed array of const
* generic platform independent high() support