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

* isolated segment-related functionality of tabsolutevarsym into i386/i8086-

Browse Source 
specific descendent classes and moved the code that deals with this in the
    code generator also to target-specific classes -> only ifdefs left in
    pdecvar

git-svn-id: trunk@27379 -
This commit is contained in:
Jonas Maebe 2014-03-30 15:42:53 +00:00
parent 2474369dde
commit 4a79481c51
15 changed files with 417 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -211,6 +211,7 @@ compiler/i386/n386add.pas svneol=native#text/plain
compiler/i386/n386cal.pas svneol=native#text/plain
compiler/i386/n386flw.pas svneol=native#text/plain
compiler/i386/n386inl.pas svneol=native#text/plain
compiler/i386/n386ld.pas svneol=native#text/plain
compiler/i386/n386mat.pas svneol=native#text/plain
compiler/i386/n386mem.pas svneol=native#text/plain
compiler/i386/n386set.pas svneol=native#text/plain
@ -258,6 +259,7 @@ compiler/i8086/n8086cal.pas svneol=native#text/plain
compiler/i8086/n8086cnv.pas svneol=native#text/plain
compiler/i8086/n8086con.pas svneol=native#text/plain
compiler/i8086/n8086inl.pas svneol=native#text/plain
compiler/i8086/n8086ld.pas svneol=native#text/plain
compiler/i8086/n8086mat.pas svneol=native#text/plain
compiler/i8086/n8086mem.pas svneol=native#text/plain
compiler/i8086/r8086ari.inc svneol=native#text/plain
@ -782,6 +784,7 @@ compiler/x86/cpubase.pas svneol=native#text/plain
compiler/x86/hlcgx86.pas svneol=native#text/plain
compiler/x86/itcpugas.pas svneol=native#text/plain
compiler/x86/itx86int.pas svneol=native#text/plain
compiler/x86/ni86mem.pas svneol=native#text/plain
compiler/x86/nx86add.pas svneol=native#text/plain
compiler/x86/nx86cal.pas svneol=native#text/plain
compiler/x86/nx86cnv.pas svneol=native#text/plain
@ -794,6 +797,7 @@ compiler/x86/rax86.pas svneol=native#text/plain
compiler/x86/rax86att.pas svneol=native#text/plain
compiler/x86/rax86int.pas svneol=native#text/plain
compiler/x86/rgx86.pas svneol=native#text/plain
compiler/x86/symi86.pas svneol=native#text/plain
compiler/x86/x86ins.dat svneol=native#text/plain
compiler/x86/x86reg.dat svneol=native#text/plain
compiler/x86_64/aoptcpu.pas svneol=native#text/plain

1
compiler/i386/cpunode.pas
View File

@ -51,6 +51,7 @@ unit cpunode;
n386add,
n386cal,
n386ld,
n386mem,
n386set,
n386inl,

61
compiler/i386/n386ld.pas Normal file
View File

@ -0,0 +1,61 @@
{
Copyright (c) 1998-2014 by Florian Klaempfl
Generate i386 assembler for load nodes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit n386ld;
{$i fpcdefs.inc}
interface
uses
globtype,
symsym,
node,ncgld,pass_1;
type
ti386loadnode = class(tcgloadnode)
procedure generate_absaddr_access(vs: tabsolutevarsym); override;
end;
implementation
uses
globals,
symcpu,
nld,
cpubase;
{*****************************************************************************
TI386LOADNODE
*****************************************************************************}
procedure ti386loadnode.generate_absaddr_access(vs: tabsolutevarsym);
begin
if tcpuabsolutevarsym(symtableentry).absseg then
location.reference.segment:=NR_FS;
inherited;
end;
begin
cloadnode:=ti386loadnode;
end.

19
compiler/i386/n386mem.pas
View File

@ -28,10 +28,13 @@ interface
uses
globtype,
cgbase,cpuinfo,cpubase,
node,nmem,ncgmem,nx86mem;
node,nmem,ncgmem,nx86mem,ni86mem;
type
ti386addrnode = class(tcgaddrnode)
ti386addrnode = class(ti86addrnode)
protected
procedure set_absvarsym_resultdef; override;
public
procedure pass_generate_code;override;
end;
@ -44,7 +47,7 @@ implementation
uses
systems,
cutils,verbose,
symdef,paramgr,
symconst,symdef,paramgr,
aasmtai,aasmdata,
nld,ncon,nadd,
cgutils,cgobj;
@ -53,8 +56,16 @@ implementation
TI386ADDRNODE
*****************************************************************************}
procedure ti386addrnode.pass_generate_code;
procedure ti386addrnode.set_absvarsym_resultdef;
begin
if not(nf_typedaddr in flags) then
resultdef:=voidnearfspointertype
else
resultdef:=cpointerdef.createx86(left.resultdef,x86pt_near_fs);
end;
procedure ti386addrnode.pass_generate_code;
begin
inherited pass_generate_code;
{ for use of other segments, not used }

4
compiler/i386/symcpu.pas
View File

@ -26,7 +26,7 @@ unit symcpu;
interface
uses
symdef,symsym;
symdef,symsym,symi86;
type
{ defs }
@ -115,7 +115,7 @@ type
tcpustaticvarsym = class(tstaticvarsym)
end;
tcpuabsolutevarsym = class(tabsolutevarsym)
tcpuabsolutevarsym = class(ti86absolutevarsym)
end;
tcpupropertysym = class(tpropertysym)

1
compiler/i8086/cpunode.pas
View File

@ -50,6 +50,7 @@ unit cpunode;
n8086add,
n8086cal,
n8086cnv,
n8086ld,
n8086mem{,
n386set},
n8086inl,

64
compiler/i8086/n8086ld.pas Normal file
View File

@ -0,0 +1,64 @@
{
Copyright (c) 2002-2014 by Florian Klaempfl
Generate i8086 assembler for load nodes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit n8086ld;
{$i fpcdefs.inc}
interface
uses
globtype,
symsym,
node,ncgld;
type
ti8086loadnode = class(tcgloadnode)
procedure generate_absaddr_access(vs: tabsolutevarsym); override;
end;
implementation
uses
globals,aasmdata,
symcpu,
nld,
cgbase,cgobj;
{*****************************************************************************
TI8086LOADNODE
*****************************************************************************}
procedure ti8086loadnode.generate_absaddr_access(vs: tabsolutevarsym);
begin
if tcpuabsolutevarsym(symtableentry).absseg then
begin
location.reference.segment:=cg.getintregister(current_asmdata.CurrAsmList,OS_16);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_16,aint(tcpuabsolutevarsym(symtableentry).addrsegment),location.reference.segment);
end;
inherited;
end;
begin
cloadnode:=ti8086loadnode;
end.

38
compiler/i8086/n8086mem.pas
View File

@ -28,9 +28,15 @@ interface
uses
globtype,
cgbase,cpuinfo,cpubase,
node,nmem,ncgmem,nx86mem;
node,nmem,ncgmem,nx86mem,ni86mem;
type
ti8086addrnode = class(ti86addrnode)
protected
procedure set_absvarsym_resultdef; override;
function typecheck_non_proc(realsource: tnode; out res: tnode): boolean; override;
end;
ti8086derefnode = class(tx86derefnode)
procedure pass_generate_code;override;
end;
@ -48,6 +54,35 @@ implementation
defutil,hlcgobj,
pass_2,ncgutil;
{*****************************************************************************
TI8086ADDRNODE
*****************************************************************************}
procedure ti8086addrnode.set_absvarsym_resultdef;
begin
if not(nf_typedaddr in flags) then
resultdef:=voidfarpointertype
else
resultdef:=cpointerdef.createx86(left.resultdef,x86pt_far);
end;
function ti8086addrnode.typecheck_non_proc(realsource: tnode; out res: tnode): boolean;
begin
res:=nil;
if (realsource.nodetype=loadn) and
(tloadnode(realsource).symtableentry.typ=labelsym) then
begin
if current_settings.x86memorymodel in x86_far_code_models then
resultdef:=voidfarpointertype
else
resultdef:=voidnearpointertype;
result:=true
end
else
result:=inherited;
end;
{*****************************************************************************
TI8086DEREFNODE
*****************************************************************************}
@ -128,6 +163,7 @@ implementation
begin
caddrnode:=ti8086addrnode;
cderefnode:=ti8086derefnode;
{ override tx86vecnode, which doesn't work for i8086 }
cvecnode:=tcgvecnode;

25
compiler/i8086/symcpu.pas
View File

@ -26,7 +26,8 @@ unit symcpu;
interface
uses
symdef,symsym;
globtype,
symtype,symdef,symsym,symi86;
type
{ defs }
@ -115,7 +116,12 @@ type
tcpustaticvarsym = class(tstaticvarsym)
end;
tcpuabsolutevarsym = class(tabsolutevarsym)
tcpuabsolutevarsym = class(ti86absolutevarsym)
protected
procedure ppuload_platform(ppufile: tcompilerppufile); override;
procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
public
addrsegment : aword;
end;
tcpupropertysym = class(tpropertysym)
@ -133,6 +139,21 @@ type
implementation
procedure tcpuabsolutevarsym.ppuload_platform(ppufile: tcompilerppufile);
begin
inherited;
if absseg then
addrsegment:=ppufile.getaword;
end;
procedure tcpuabsolutevarsym.ppuwrite_platform(ppufile: tcompilerppufile);
begin
inherited;
if absseg then
ppufile.putaword(addrsegment);
end;
begin
{ used tdef classes }
cfiledef:=tcpufiledef;

25
compiler/ncgld.pas
View File

@ -28,7 +28,7 @@ interface
uses
globtype,
symtype,
symtype,symsym,
aasmdata,
node,nld,cgutils;
@ -36,6 +36,7 @@ interface
tcgloadnode = class(tloadnode)
protected
procedure generate_nested_access(vs: tsym);virtual;
procedure generate_absaddr_access(vs: tabsolutevarsym); virtual;
public
procedure pass_generate_code;override;
procedure changereflocation(const ref: treference);
@ -68,7 +69,7 @@ implementation
systems,
verbose,globals,constexp,
nutils,
symtable,symconst,symdef,symsym,defutil,paramgr,ncon,nbas,ncgrtti,
symtable,symconst,symdef,defutil,paramgr,ncon,nbas,ncgrtti,
aasmbase,
cgbase,pass_2,
procinfo,
@ -245,6 +246,12 @@ implementation
end;
procedure tcgloadnode.generate_absaddr_access(vs: tabsolutevarsym);
begin
location.reference.offset:=aint(vs.addroffset);
end;
procedure tcgloadnode.pass_generate_code;
var
hregister : tregister;
@ -268,19 +275,7 @@ implementation
{ this is only for toasm and toaddr }
case tabsolutevarsym(symtableentry).abstyp of
toaddr :
begin
{$if defined(i8086)}
if tabsolutevarsym(symtableentry).absseg then
begin
location.reference.segment:=cg.getintregister(current_asmdata.CurrAsmList,OS_16);
cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_16,aint(tabsolutevarsym(symtableentry).addrsegment),location.reference.segment);
end;
{$elseif defined(i386)}
if tabsolutevarsym(symtableentry).absseg then
location.reference.segment:=NR_FS;
{$endif}
location.reference.offset:=aint(tabsolutevarsym(symtableentry).addroffset);
end;
generate_absaddr_access(tabsolutevarsym(symtableentry));
toasm :
location.reference.symbol:=current_asmdata.RefAsmSymbol(tabsolutevarsym(symtableentry).mangledname);
else

121
compiler/nmem.pas
View File

@ -77,6 +77,7 @@ interface
function pass_typecheck:tnode;override;
protected
mark_read_written: boolean;
function typecheck_non_proc(realsource: tnode; out res: tnode): boolean; virtual;
end;
taddrnodeclass = class of taddrnode;
@ -477,10 +478,9 @@ implementation
function taddrnode.pass_typecheck:tnode;
var
hp : tnode;
hp : tnode;
hsym : tfieldvarsym;
isprocvar : boolean;
offset: asizeint;
begin
result:=nil;
typecheckpass(left);
@ -571,79 +571,17 @@ implementation
end
else
begin
{ what are we getting the address from an absolute sym? }
hp:=left;
while assigned(hp) and (hp.nodetype in [typeconvn,vecn,derefn,subscriptn]) do
hp:=tunarynode(hp).left;
if not assigned(hp) then
internalerror(200412042);
{$if defined(i386) or defined(i8086)}
if (hp.nodetype=loadn) and
((tloadnode(hp).symtableentry.typ=absolutevarsym) and
tabsolutevarsym(tloadnode(hp).symtableentry).absseg) then
if typecheck_non_proc(hp,result) then
begin
{$if defined(i8086)}
if not(nf_typedaddr in flags) then
resultdef:=voidfarpointertype
else
resultdef:=cpointerdef.createx86(left.resultdef,x86pt_far);
{$elseif defined(i386)}
if not(nf_typedaddr in flags) then
resultdef:=voidnearfspointertype
else
resultdef:=cpointerdef.createx86(left.resultdef,x86pt_near_fs);
{$endif}
if assigned(result) then
exit;
end
else
{$endif i386 or i8086}
if (hp.nodetype=loadn) and
(tloadnode(hp).symtableentry.typ=absolutevarsym) and
{$if defined(i386) or defined(i8086)}
not(tabsolutevarsym(tloadnode(hp).symtableentry).absseg) and
{$endif i386 or i8086}
(tabsolutevarsym(tloadnode(hp).symtableentry).abstyp=toaddr) then
begin
offset:=tabsolutevarsym(tloadnode(hp).symtableentry).addroffset;
hp:=left;
while assigned(hp)and(hp.nodetype=subscriptn) do
begin
hsym:=tsubscriptnode(hp).vs;
if tabstractrecordsymtable(hsym.owner).is_packed then
begin
{ can't calculate the address of a non-byte aligned field }
if (hsym.fieldoffset mod 8)<>0 then
exit;
inc(offset,hsym.fieldoffset div 8)
end
else
inc(offset,hsym.fieldoffset);
hp:=tunarynode(hp).left;
end;
if nf_typedaddr in flags then
result:=cpointerconstnode.create(offset,getpointerdef(left.resultdef))
else
result:=cpointerconstnode.create(offset,voidpointertype);
exit;
end
{$ifdef i8086}
else if (hp.nodetype=loadn) and
(tloadnode(hp).symtableentry.typ=labelsym) then
begin
if current_settings.x86memorymodel in x86_far_code_models then
resultdef:=voidfarpointertype
else
resultdef:=voidnearpointertype;
end
{$endif i8086}
else if (nf_internal in flags) or
valid_for_addr(left,true) then
begin
if not(nf_typedaddr in flags) then
resultdef:=voidpointertype
else
resultdef:=getpointerdef(left.resultdef);
end
else
CGMessage(type_e_variable_id_expected);
end;
@ -661,6 +599,55 @@ implementation
end;
function taddrnode.typecheck_non_proc(realsource: tnode; out res: tnode): boolean;
var
hp : tnode;
hsym : tfieldvarsym;
offset: asizeint;
begin
result:=false;
res:=nil;
if (realsource.nodetype=loadn) and
(tloadnode(realsource).symtableentry.typ=absolutevarsym) and
(tabsolutevarsym(tloadnode(realsource).symtableentry).abstyp=toaddr) then
begin
offset:=tabsolutevarsym(tloadnode(realsource).symtableentry).addroffset;
hp:=left;
while assigned(hp)and(hp.nodetype=subscriptn) do
begin
hsym:=tsubscriptnode(hp).vs;
if tabstractrecordsymtable(hsym.owner).is_packed then
begin
{ can't calculate the address of a non-byte aligned field }
if (hsym.fieldoffset mod 8)<>0 then
begin
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr);
exit
end;
inc(offset,hsym.fieldoffset div 8)
end
else
inc(offset,hsym.fieldoffset);
hp:=tunarynode(hp).left;
end;
if nf_typedaddr in flags then
res:=cpointerconstnode.create(offset,getpointerdef(left.resultdef))
else
res:=cpointerconstnode.create(offset,voidpointertype);
result:=true;
end
else if (nf_internal in flags) or
valid_for_addr(left,true) then
begin
if not(nf_typedaddr in flags) then
resultdef:=voidpointertype
else
resultdef:=getpointerdef(left.resultdef);
result:=true;
end
end;
function taddrnode.pass_1 : tnode;
begin
result:=nil;

9
compiler/pdecvar.pas
View File

@ -55,6 +55,9 @@ implementation
systems,
{ symtable }
symconst,symbase,symtype,defutil,defcmp,symcreat,
{$if defined(i386) or defined(i8086)}
symcpu,
{$endif}
{$ifdef jvm}
jvmdef,
{$endif}
@ -1268,7 +1271,7 @@ implementation
{$endif}
abssym.addroffset:=Tordconstnode(pt).value.svalue;
{$if defined(i386) or defined(i8086)}
abssym.absseg:=false;
tcpuabsolutevarsym(abssym).absseg:=false;
if (target_info.system in [system_i386_go32v2,system_i386_watcom,system_i8086_msdos]) and
try_to_consume(_COLON) then
begin
@ -1277,7 +1280,7 @@ implementation
if is_constintnode(pt) then
begin
{$if defined(i8086)}
abssym.addrsegment:=abssym.addroffset;
tcpuabsolutevarsym(abssym).addrsegment:=abssym.addroffset;
tmpaddr:=tordconstnode(pt).value.svalue;
if (tmpaddr<int64(low(abssym.addroffset))) or
(tmpaddr>int64(high(abssym.addroffset))) then
@ -1292,7 +1295,7 @@ implementation
else
abssym.addroffset:=tmpaddr;
{$endif}
abssym.absseg:=true;
tcpuabsolutevarsym(abssym).absseg:=true;
end
else
Message(type_e_ordinal_expr_expected);

31
compiler/symsym.pas
View File

@ -291,14 +291,8 @@ interface
tabsolutevarsym = class(tabstractvarsym)
public
abstyp : absolutetyp;
{$if defined(i386) or defined(i8086)}
absseg : boolean;
{$endif defined(i386) or defined(i8086)}
asmname : pshortstring;
addroffset : aword;
{$if defined(i8086)}
addrsegment : aword;
{$endif defined(i8086)}
ref : tpropaccesslist;
constructor create(const n : string;def:tdef);virtual;
constructor create_ref(const n : string;def:tdef;_ref:tpropaccesslist);virtual;
@ -2168,25 +2162,13 @@ implementation
ref:=nil;
asmname:=nil;
abstyp:=absolutetyp(ppufile.getbyte);
{$if defined(i386) or defined(i8086)}
absseg:=false;
{$endif i386 or i8086}
case abstyp of
tovar :
ref:=ppufile.getpropaccesslist;
toasm :
asmname:=stringdup(ppufile.getstring);
toaddr :
begin
addroffset:=ppufile.getaword;
{$if defined(i386)}
absseg:=boolean(ppufile.getbyte);
{$elseif defined(i8086)}
absseg:=boolean(ppufile.getbyte);
if absseg then
addrsegment:=ppufile.getaword;
{$endif}
end;
addroffset:=ppufile.getaword;
end;
ppuload_platform(ppufile);
end;
@ -2202,16 +2184,7 @@ implementation
toasm :
ppufile.putstring(asmname^);
toaddr :
begin
ppufile.putaword(addroffset);
{$if defined(i386)}
ppufile.putbyte(byte(absseg));
{$elseif defined(i8086)}
ppufile.putbyte(byte(absseg));
if absseg then
ppufile.putaword(addrsegment);
{$endif}
end;
ppufile.putaword(addroffset);
end;
writeentry(ppufile,ibabsolutevarsym);
end;

69
compiler/x86/ni86mem.pas Normal file
View File

@ -0,0 +1,69 @@
{
Copyright (c) 1998-2002 by Florian Klaempfl
Generate i386/i8086 assembler for memory related nodes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit ni86mem;
{$i fpcdefs.inc}
interface
uses
globtype,
cgbase,cpuinfo,cpubase,
node,nmem,ncgmem,nx86mem;
type
ti86addrnode = class(tcgaddrnode)
protected
procedure set_absvarsym_resultdef; virtual; abstract;
function typecheck_non_proc(realsource: tnode; out res: tnode): boolean; override;
end;
implementation
uses
cutils,verbose,
aasmtai,aasmdata,
cgutils,cgobj,
nld,
symconst,symdef,symcpu;
{*****************************************************************************
TI86ADDRNODE
*****************************************************************************}
function ti86addrnode.typecheck_non_proc(realsource: tnode; out res: tnode): boolean;
begin
res:=nil;
{ if we are getting the address of an absolute sym, check whether it's
a near or a far pointer }
if (realsource.nodetype=loadn) and
((tloadnode(realsource).symtableentry.typ=absolutevarsym) and
tcpuabsolutevarsym(tloadnode(realsource).symtableentry).absseg) then
begin
set_absvarsym_resultdef;
result:=true;
end
else
result:=inherited;
end;
end.

68
compiler/x86/symi86.pas Normal file
View File

@ -0,0 +1,68 @@
{
Copyright (c) 2014 by Florian Klaempfl
Symbol table overrides for i386 and i8086
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit symi86;
{$i fpcdefs.inc}
interface
uses
symtype,symdef,symsym;
type
{ ti86absolutevarsym }
ti86absolutevarsym = class(tabsolutevarsym)
protected
procedure ppuload_platform(ppufile: tcompilerppufile); override;
procedure ppuwrite_platform(ppufile: tcompilerppufile); override;
public
absseg : boolean;
end;
implementation
uses
symconst;
{ ti86absolutevarsym }
procedure ti86absolutevarsym.ppuload_platform(ppufile: tcompilerppufile);
begin
inherited;
if abstyp=toaddr then
absseg:=boolean(ppufile.getbyte)
else
absseg:=false;
end;
procedure ti86absolutevarsym.ppuwrite_platform(ppufile: tcompilerppufile);
begin
inherited;
if abstyp=toaddr then
ppufile.putbyte(byte(absseg));
end;
end.