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

all the extra i8086 units added

Browse Source 
git-svn-id: branches/i8086@23718 -
This commit is contained in:
nickysn 2013-03-08 00:04:45 +00:00
parent 0684e783ae
commit eff0894a66
14 changed files with 2630 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
.gitattributes vendored
View File

@ -237,8 +237,14 @@ compiler/i386/ra386att.pas svneol=native#text/plain
compiler/i386/ra386int.pas svneol=native#text/plain
compiler/i386/rgcpu.pas svneol=native#text/plain
compiler/i386/rropt386.pas svneol=native#text/plain
compiler/i8086/cgcpu.pas svneol=native#text/plain
compiler/i8086/cpubase.inc svneol=native#text/plain
compiler/i8086/cpuinfo.pas svneol=native#text/plain
compiler/i8086/cpunode.pas svneol=native#text/plain
compiler/i8086/cpupara.pas svneol=native#text/plain
compiler/i8086/cpupi.pas svneol=native#text/plain
compiler/i8086/cputarg.pas svneol=native#text/plain
compiler/i8086/hlcgcpu.pas svneol=native#text/plain
compiler/i8086/i386att.inc svneol=native#text/plain
compiler/i8086/i386atts.inc svneol=native#text/plain
compiler/i8086/i386int.inc svneol=native#text/plain
@ -262,6 +268,9 @@ compiler/i8086/r386rni.inc svneol=native#text/plain
compiler/i8086/r386sri.inc svneol=native#text/plain
compiler/i8086/r386stab.inc svneol=native#text/plain
compiler/i8086/r386std.inc svneol=native#text/plain
compiler/i8086/ra8086att.pas svneol=native#text/plain
compiler/i8086/ra8086int.pas svneol=native#text/plain
compiler/i8086/rgcpu.pas svneol=native#text/plain
compiler/ia64/aasmcpu.pas svneol=native#text/plain
compiler/ia64/cpubase.pas svneol=native#text/plain
compiler/ia64/cpuinfo.pas svneol=native#text/plain

4
compiler/compiler.pas
View File

@ -35,7 +35,7 @@ uses
{$endif WATCOM}
{$ifdef unix}
{ system code page stuff for unix }
unixcp,
// unixcp,
{$endif}
{$IFNDEF USE_FAKE_SYSUTILS}
sysutils,math,
@ -179,7 +179,7 @@ begin
DoneCompiler;
{$ifdef unix}
{ Set default code page for ansistrings on unix-like systems }
DefaultSystemCodePage:=GetSystemCodePage;
// DefaultSystemCodePage:=GetSystemCodePage;
{$endif}
{ inits which need to be done before the arguments are parsed }
InitSystems;

1179
compiler/i8086/cgcpu.pas Normal file
View File

File diff suppressed because it is too large Load Diff

60
compiler/i8086/cpunode.pas Normal file
View File

@ -0,0 +1,60 @@
{
Copyright (c) 2000-2002 by Florian Klaempfl
Includes the i8086 code generator
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 cpunode;
{$i fpcdefs.inc}
interface
implementation
uses
{ generic nodes }
ncgbas,
ncgld,
ncgflw,
ncgcnv,
ncgmem,
ncgmat,
ncgcon,
ncgcal,
ncgset,
ncginl,
ncgopt,
ncgobjc,
{ to be able to only parts of the generic code,
the processor specific nodes must be included
after the generic one (FK)
}
nx86set,
nx86con,
nx86cnv{,
n386add,
n386cal,
n386mem,
n386set,
n386inl,
n386mat}
;
end.

758
compiler/i8086/cpupara.pas Normal file
View File

@ -0,0 +1,758 @@
{
Copyright (c) 2002 by Florian Klaempfl
Generates the argument location information for i386
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 cpupara;
{$i fpcdefs.inc}
interface
uses
globtype,
aasmtai,aasmdata,cpubase,cgbase,cgutils,
symconst,symtype,symsym,symdef,
parabase,paramgr;
type
ti386paramanager = class(tparamanager)
function param_use_paraloc(const cgpara:tcgpara):boolean;override;
function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
function get_para_align(calloption : tproccalloption):byte;override;
function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override;
function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override;
{ Returns the location for the nr-st 32 Bit int parameter
if every parameter before is an 32 Bit int parameter as well
and if the calling conventions for the helper routines of the
rtl are used.
}
procedure getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);override;
function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override;
procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override;
function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;override;
private
procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parareg,parasize:longint);
end;
implementation
uses
cutils,
systems,verbose,
symtable,
defutil;
const
parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX);
{****************************************************************************
TI386PARAMANAGER
****************************************************************************}
function ti386paramanager.param_use_paraloc(const cgpara:tcgpara):boolean;
var
paraloc : pcgparalocation;
begin
if not assigned(cgpara.location) then
internalerror(200410102);
result:=true;
{ All locations are LOC_REFERENCE }
paraloc:=cgpara.location;
while assigned(paraloc) do
begin
if (paraloc^.loc<>LOC_REFERENCE) then
begin
result:=false;
exit;
end;
paraloc:=paraloc^.next;
end;
end;
function ti386paramanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
var
size: longint;
begin
if handle_common_ret_in_param(def,pd,result) then
exit;
case target_info.system of
system_i386_win32 :
begin
case def.typ of
recorddef :
begin
{ Win32 GCC returns small records in the FUNCTION_RETURN_REG up to 8 bytes in registers.
For stdcall and register we follow delphi instead of GCC which returns
only records of a size of 1,2 or 4 bytes in FUNCTION_RETURN_REG }
if ((pd.proccalloption in [pocall_stdcall,pocall_register]) and
(def.size in [1,2,4])) or
((pd.proccalloption in [pocall_cdecl,pocall_cppdecl]) and
(def.size>0) and
(def.size<=8)) then
begin
result:=false;
exit;
end;
end;
end;
end;
system_i386_freebsd,
system_i386_openbsd,
system_i386_darwin,
system_i386_iphonesim :
begin
if pd.proccalloption in cdecl_pocalls then
begin
case def.typ of
recorddef :
begin
size:=def.size;
if (size>0) and
(size<=8) and
{ only if size is a power of 2 }
((size and (size-1)) = 0) then
begin
result:=false;
exit;
end;
end;
procvardef:
begin
result:=false;
exit;
end;
end;
end;
end;
end;
result:=inherited ret_in_param(def,pd);
end;
function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;
begin
result:=false;
{ var,out,constref always require address }
if varspez in [vs_var,vs_out,vs_constref] then
begin
result:=true;
exit;
end;
{ Only vs_const, vs_value here }
case def.typ of
variantdef :
begin
{ variants are small enough to be passed by value except if
required by the windows api
variants are somethings very delphi/windows specific so do it like
windows/delphi (FK)
}
if ((target_info.system=system_i386_win32) and
(calloption in [pocall_stdcall,pocall_safecall]) and
(varspez=vs_const)) or
(calloption=pocall_register) then
result:=true
else
result:=false;
end;
formaldef :
result:=true;
recorddef :
begin
{ Delphi stdcall passes records on the stack for call by value }
if (target_info.system=system_i386_win32) and
(calloption=pocall_stdcall) and
(varspez=vs_value) then
result:=false
else
result:=
(not(calloption in (cdecl_pocalls)) and
(def.size>sizeof(aint))) or
(((calloption = pocall_mwpascal) or (target_info.system=system_i386_wince)) and
(varspez=vs_const));
end;
arraydef :
begin
{ array of const values are pushed on the stack as
well as dyn. arrays }
if (calloption in cdecl_pocalls) then
result:=not(is_array_of_const(def) or
is_dynamic_array(def))
else
begin
result:=(
(tarraydef(def).highrange>=tarraydef(def).lowrange) and
(def.size>sizeof(aint))
) or
is_open_array(def) or
is_array_of_const(def) or
is_array_constructor(def);
end;
end;
objectdef :
result:=is_object(def);
stringdef :
result:= (tstringdef(def).stringtype in [st_shortstring,st_longstring]);
procvardef :
result:=not(calloption in cdecl_pocalls) and not tprocvardef(def).is_addressonly;
setdef :
result:=not(calloption in cdecl_pocalls) and (not is_smallset(def));
end;
end;
function ti386paramanager.get_para_align(calloption : tproccalloption):byte;
begin
if calloption=pocall_oldfpccall then
begin
if target_info.system in [system_i386_go32v2,system_i386_watcom] then
result:=2
else
result:=4;
end
else
result:=std_param_align;
end;
function ti386paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;
begin
case calloption of
pocall_internproc :
result:=[];
pocall_register,
pocall_safecall,
pocall_stdcall,
pocall_cdecl,
pocall_cppdecl,
pocall_mwpascal :
result:=[RS_EAX,RS_EDX,RS_ECX];
pocall_far16,
pocall_pascal,
pocall_oldfpccall :
result:=[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI,RS_EBX];
else
internalerror(200309071);
end;
end;
function ti386paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;
begin
result:=[0..first_fpu_imreg-1];
end;
function ti386paramanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;
begin
result:=[0..first_mm_imreg-1];
end;
procedure ti386paramanager.getintparaloc(pd : tabstractprocdef; nr : longint; var cgpara : tcgpara);
var
paraloc : pcgparalocation;
def : tdef;
begin
def:=tparavarsym(pd.paras[nr-1]).vardef;
cgpara.reset;
cgpara.size:=def_cgsize(def);
cgpara.intsize:=tcgsize2size[cgpara.size];
cgpara.alignment:=get_para_align(pd.proccalloption);
cgpara.def:=def;
paraloc:=cgpara.add_location;
with paraloc^ do
begin
size:=OS_INT;
if pd.proccalloption=pocall_register then
begin
if (nr<=length(parasupregs)) then
begin
if nr=0 then
internalerror(200309271);
loc:=LOC_REGISTER;
register:=newreg(R_INTREGISTER,parasupregs[nr-1],R_SUBWHOLE);
end
else
begin
loc:=LOC_REFERENCE;
reference.index:=NR_STACK_POINTER_REG;
{ the previous parameters didn't take up room in memory }
reference.offset:=sizeof(aint)*(nr-length(parasupregs)-1)
end;
end
else
begin
loc:=LOC_REFERENCE;
reference.index:=NR_STACK_POINTER_REG;
reference.offset:=sizeof(aint)*nr;
end;
end;
end;
function ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): TCGPara;
var
retcgsize : tcgsize;
paraloc : pcgparalocation;
sym: tfieldvarsym;
usedef: tdef;
handled: boolean;
begin
if not assigned(forcetempdef) then
usedef:=p.returndef
else
usedef:=forcetempdef;
{ on darwin/i386, if a record has only one field and that field is a
single or double, it has to be returned like a single/double }
if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
((usedef.typ=recorddef) or
is_object(usedef)) and
tabstractrecordsymtable(tabstractrecorddef(usedef).symtable).has_single_field(sym) and
(sym.vardef.typ=floatdef) and
(tfloatdef(sym.vardef).floattype in [s32real,s64real]) then
usedef:=sym.vardef;
handled:=set_common_funcretloc_info(p,usedef,retcgsize,result);
{ normally forcetempdef is passed straight through to
set_common_funcretloc_info and that one will correctly determine whether
the location is a temporary one, but that doesn't work here because we
sometimes have to change the type }
result.temporary:=assigned(forcetempdef);
if handled then
exit;
{ darwin/x86 requires that results < sizeof(aint) are sign/zero
extended to sizeof(aint) }
if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
(side=calleeside) and
(result.intsize>0) and
(result.intsize<sizeof(aint)) then
begin
result.def:=sinttype;
result.intsize:=sizeof(aint);
retcgsize:=OS_SINT;
result.size:=retcgsize;
end;
{ Return in FPU register? }
if result.def.typ=floatdef then
begin
paraloc:=result.add_location;
paraloc^.loc:=LOC_FPUREGISTER;
paraloc^.register:=NR_FPU_RESULT_REG;
paraloc^.size:=retcgsize;
end
else
{ Return in register }
begin
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
if retcgsize in [OS_64,OS_S64] then
begin
{ low 32bits }
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG
else
paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG;
paraloc^.size:=OS_32;
{ high 32bits }
paraloc:=result.add_location;
paraloc^.loc:=LOC_REGISTER;
if side=callerside then
paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG
else
paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG;
paraloc^.size:=OS_32;
end
else
begin
paraloc^.size:=retcgsize;
if side=callerside then
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize))
else
paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize));
end;
end;
end;
procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint);
var
i : integer;
hp : tparavarsym;
paradef : tdef;
paraloc : pcgparalocation;
l,
paralen,
varalign : longint;
paraalign : shortint;
pushaddr : boolean;
paracgsize : tcgsize;
begin
paraalign:=get_para_align(p.proccalloption);
{ we push Flags and CS as long
to cope with the IRETD
and we save 6 register + 4 selectors }
if po_interrupt in p.procoptions then
inc(parasize,8+6*4+4*2);
{ Offset is calculated like:
sub esp,12
mov [esp+8],para3
mov [esp+4],para2
mov [esp],para1
call function
That means for pushes the para with the
highest offset (see para3) needs to be pushed first
}
if p.proccalloption in pushleftright_pocalls then
i:=paras.count-1
else
i:=0;
while ((p.proccalloption in pushleftright_pocalls) and (i>=0)) or
(not(p.proccalloption in pushleftright_pocalls) and (i<=paras.count-1)) do
begin
hp:=tparavarsym(paras[i]);
paradef:=hp.vardef;
pushaddr:=push_addr_param(hp.varspez,paradef,p.proccalloption);
if pushaddr then
begin
paralen:=sizeof(aint);
paracgsize:=OS_ADDR;
paradef:=getpointerdef(paradef);
end
else
begin
paralen:=push_size(hp.varspez,paradef,p.proccalloption);
{ darwin/x86 requires that parameters < sizeof(aint) are sign/ }
{ zero extended to sizeof(aint) }
if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
(side = callerside) and
(paralen > 0) and
(paralen < sizeof(aint)) then
begin
paralen:=sizeof(aint);
paracgsize:=OS_SINT;
paradef:=sinttype;
end
else
paracgsize:=def_cgsize(paradef);
end;
hp.paraloc[side].reset;
hp.paraloc[side].size:=paracgsize;
hp.paraloc[side].intsize:=paralen;
hp.paraloc[side].def:=paradef;
hp.paraloc[side].Alignment:=paraalign;
{ Copy to stack? }
if (paracgsize=OS_NO) or
(use_fixed_stack) then
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
varalign:=used_align(size_2_align(paralen),paraalign,paraalign);
{ don't let push_size return 16, because then we can }
{ read past the end of the heap since the value is only }
{ 10 bytes long (JM) }
if (paracgsize = OS_F80) and
(target_info.system in [system_i386_darwin,system_i386_iphonesim]) then
paralen:=16;
paraloc^.reference.offset:=parasize;
if side=calleeside then
inc(paraloc^.reference.offset,target_info.first_parm_offset);
parasize:=align(parasize+paralen,varalign);
end
else
begin
if paralen=0 then
internalerror(200501163);
while (paralen>0) do
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
{ single and double need a single location }
if (paracgsize in [OS_F64,OS_F32]) then
begin
paraloc^.size:=paracgsize;
l:=paralen;
end
else
begin
{ We can allocate at maximum 32 bits per location }
if paralen>sizeof(aint) then
l:=sizeof(aint)
else
l:=paralen;
paraloc^.size:=int_cgsize(l);
end;
if (side=callerside) or
(po_nostackframe in p.procoptions) then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
varalign:=used_align(size_2_align(l),paraalign,paraalign);
paraloc^.reference.offset:=parasize;
if side=calleeside then
if not(po_nostackframe in p.procoptions) then
inc(paraloc^.reference.offset,target_info.first_parm_offset)
else
{ return addres }
inc(paraloc^.reference.offset,4);
parasize:=align(parasize+l,varalign);
dec(paralen,l);
end;
end;
if p.proccalloption in pushleftright_pocalls then
dec(i)
else
inc(i);
end;
end;
procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;
var parareg,parasize:longint);
var
hp : tparavarsym;
paradef : tdef;
paraloc : pcgparalocation;
paracgsize : tcgsize;
i : integer;
l,
paralen,
varalign : longint;
pushaddr : boolean;
paraalign : shortint;
pass : byte;
begin
if paras.count=0 then
exit;
paraalign:=get_para_align(p.proccalloption);
{ clean up here so we can later detect properly if a parameter has been
assigned or not
}
for i:=0 to paras.count-1 do
tparavarsym(paras[i]).paraloc[side].reset;
{ Register parameters are assigned from left to right,
stack parameters from right to left so assign first the
register parameters in a first pass, in the second
pass all unhandled parameters are done }
for pass:=1 to 2 do
begin
if pass=1 then
i:=0
else
i:=paras.count-1;
while true do
begin
hp:=tparavarsym(paras[i]);
paradef:=hp.vardef;
if not(assigned(hp.paraloc[side].location)) then
begin
pushaddr:=push_addr_param(hp.varspez,hp.vardef,p.proccalloption);
if pushaddr then
begin
paralen:=sizeof(aint);
paracgsize:=OS_ADDR;
paradef:=getpointerdef(paradef);
end
else
begin
paralen:=push_size(hp.varspez,hp.vardef,p.proccalloption);
paracgsize:=def_cgsize(hp.vardef);
end;
hp.paraloc[side].size:=paracgsize;
hp.paraloc[side].intsize:=paralen;
hp.paraloc[side].Alignment:=paraalign;
hp.paraloc[side].def:=paradef;
{
EAX
EDX
ECX
Stack
Stack
64bit values,floats,arrays and records are always
on the stack.
In case of po_delphi_nested_cc, the parent frame pointer
is also always passed on the stack.
}
if (parareg<=high(parasupregs)) and
(paralen<=sizeof(aint)) and
(not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or
pushaddr) and
(not(vo_is_parentfp in hp.varoptions) or
not(po_delphi_nested_cc in p.procoptions)) then
begin
if pass=1 then
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.size:=paracgsize;
paraloc^.loc:=LOC_REGISTER;
paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(R_INTREGISTER,paracgsize));
inc(parareg);
end;
end
else
if pass=2 then
begin
{ Copy to stack? }
if (use_fixed_stack) or
(paracgsize=OS_NO) then
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
paraloc^.size:=paracgsize;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
varalign:=used_align(size_2_align(paralen),paraalign,paraalign);
paraloc^.reference.offset:=parasize;
if side=calleeside then
inc(paraloc^.reference.offset,target_info.first_parm_offset);
parasize:=align(parasize+paralen,varalign);
end
else
begin
if paralen=0 then
internalerror(200501163);
while (paralen>0) do
begin
paraloc:=hp.paraloc[side].add_location;
paraloc^.loc:=LOC_REFERENCE;
{ Extended and double need a single location }
if (paracgsize in [OS_F64,OS_F32]) then
begin
paraloc^.size:=paracgsize;
l:=paralen;
end
else
begin
{ We can allocate at maximum 32 bits per location }
if paralen>sizeof(aint) then
l:=sizeof(aint)
else
l:=paralen;
paraloc^.size:=int_cgsize(l);
end;
if side=callerside then
paraloc^.reference.index:=NR_STACK_POINTER_REG
else
paraloc^.reference.index:=NR_FRAME_POINTER_REG;
varalign:=used_align(size_2_align(l),paraalign,paraalign);
paraloc^.reference.offset:=parasize;
if side=calleeside then
inc(paraloc^.reference.offset,target_info.first_parm_offset);
parasize:=align(parasize+l,varalign);
dec(paralen,l);
end;
end;
end;
end;
case pass of
1:
begin
if i=paras.count-1 then
break;
inc(i);
end;
2:
begin
if i=0 then
break;
dec(i);
end;
end;
end;
end;
end;
function ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
var
parasize,
parareg : longint;
begin
parasize:=0;
parareg:=0;
case p.proccalloption of
pocall_register :
create_register_paraloc_info(p,side,p.paras,parareg,parasize);
pocall_internproc :
begin
{ Use default calling }
{$warnings off}
if (pocall_default=pocall_register) then
create_register_paraloc_info(p,side,p.paras,parareg,parasize)
else
create_stdcall_paraloc_info(p,side,p.paras,parasize);
{$warnings on}
end;
else
create_stdcall_paraloc_info(p,side,p.paras,parasize);
end;
create_funcretloc_info(p,side);
result:=parasize;
end;
function ti386paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;
var
parasize : longint;
begin
parasize:=0;
{ calculate the registers for the normal parameters }
create_stdcall_paraloc_info(p,callerside,p.paras,parasize);
{ append the varargs }
create_stdcall_paraloc_info(p,callerside,varargspara,parasize);
result:=parasize;
end;
procedure ti386paramanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);
begin
{ Never a need for temps when value is pushed (calls inside parameters
will simply allocate even more stack space for their parameters) }
if not(use_fixed_stack) then
can_use_final_stack_loc:=true;
inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara);
end;
begin
paramanager:=ti386paramanager.create;
end.

109
compiler/i8086/cpupi.pas Normal file
View File

@ -0,0 +1,109 @@
{
Copyright (c) 2002 by Florian Klaempfl
This unit contains the CPU specific part of tprocinfo
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.
****************************************************************************
}
{ This unit contains the CPU specific part of tprocinfo. }
unit cpupi;
{$i fpcdefs.inc}
interface
uses
psub,procinfo,aasmdata;
type
ti386procinfo = class(tcgprocinfo)
constructor create(aparent:tprocinfo);override;
procedure set_first_temp_offset;override;
function calc_stackframe_size:longint;override;
procedure generate_parameter_info;override;
procedure allocate_got_register(list: tasmlist);override;
end;
implementation
uses
cutils,
systems,globals,globtype,
cgobj,tgobj,paramgr,
cpubase,
cgutils,
symconst;
constructor ti386procinfo.create(aparent:tprocinfo);
begin
inherited create(aparent);
got:=NR_EBX;
end;
procedure ti386procinfo.set_first_temp_offset;
begin
if paramanager.use_fixed_stack then
begin
if not(po_assembler in procdef.procoptions) and
(tg.direction > 0) then
tg.setfirsttemp(tg.direction*maxpushedparasize);
if (tg.direction < 0) and
not(po_nostackframe in procdef.procoptions) then
{ compensate for the return address and the "pushl %ebp" }
tg.setalignmentmismatch(sizeof(pint)*2);
end;
end;
function ti386procinfo.calc_stackframe_size:longint;
begin
{ align to 4 bytes at least
otherwise all those subl $2,%esp are meaningless PM }
if target_info.stackalign<=4 then
result:=Align(tg.direction*tg.lasttemp,min(current_settings.alignment.localalignmax,4))
else
{ aligned during stack frame allocation, because also depends number
of saved registers }
result:=tg.direction*tg.lasttemp+maxpushedparasize;
end;
procedure ti386procinfo.generate_parameter_info;
begin
inherited generate_parameter_info;
{ Para_stack_size is only used to determine how many bytes to remove }
{ from the stack at the end of the procedure (in the "ret $xx"). }
{ If the stack is fixed, nothing has to be removed by the callee }
if paramanager.use_fixed_stack then
para_stack_size := 0;
end;
procedure ti386procinfo.allocate_got_register(list: tasmlist);
begin
if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and
(cs_create_pic in current_settings.moduleswitches) then
begin
got := cg.getaddressregister(list);
end;
end;
begin
cprocinfo:=ti386procinfo;
end.

88
compiler/i8086/cputarg.pas Normal file
View File

@ -0,0 +1,88 @@
{
Copyright (c) 2001-2002 by Peter Vreman
Includes the i8086 dependent target units
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 cputarg;
{$i fpcdefs.inc}
interface
implementation
uses
systems { prevent a syntax error when nothing is included }
{**************************************
Targets
**************************************}
{$ifndef NOTARGETMSDOS}
,t_msdos
{$endif}
{**************************************
Assemblers
**************************************}
{$ifndef NOAG386ATT}
// ,agx86att
{$endif}
{$ifndef NOAG386NSM}
,agx86nsm
{$endif}
{$ifndef NOAG386INT}
// ,agx86int
{$endif}
// ,ogcoff
// ,ogelf
// ,ogmacho
// ,cpuelf
{**************************************
Assembler Readers
**************************************}
{$ifndef NoRa8086Int}
,ra8086int
{$endif NoRa8086Int}
{$ifndef NoRa8086Att}
,ra8086att
{$endif NoRa8086Att}
{**************************************
Debuginfo
**************************************}
{$ifndef NoCFIDwarf}
,cfidwarf
{$endif NoCFIDwarf}
{$ifndef NoDbgStabs}
,dbgstabs
{$endif NoDbgStabs}
{$ifndef NoDbgDwarf}
,dbgdwarf
{$endif NoDbgDwarf}
;
end.

203
compiler/i8086/hlcgcpu.pas Normal file
View File

@ -0,0 +1,203 @@
{
Copyright (c) 1998-2010 by Florian Klaempfl and Jonas Maebe
Member of the Free Pascal development team
This unit contains routines to create a pass-through high-level code
generator. This is used by most regular code generators.
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 hlcgcpu;
{$i fpcdefs.inc}
interface
uses
aasmdata,
symtype,symdef,parabase,
cgbase,cgutils,
hlcgobj, hlcgx86;
type
thlcgcpu = class(thlcgx86)
protected
procedure gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint); override;
public
procedure g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister); override;
procedure g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation); override;
end;
procedure create_hlcodegen;
implementation
uses
globtype,verbose,
paramgr,
cpubase,tgobj,cgobj,cgcpu;
{ thlcgcpu }
procedure thlcgcpu.gen_loadfpu_loc_cgpara(list: TAsmList; size: tdef; const l: tlocation; const cgpara: tcgpara; locintsize: longint);
var
locsize : tcgsize;
tmploc : tlocation;
href : treference;
stacksize : longint;
begin
if not(l.size in [OS_32,OS_S32,OS_64,OS_S64,OS_128,OS_S128]) then
locsize:=l.size
else
locsize:=int_float_cgsize(tcgsize2size[l.size]);
case l.loc of
LOC_FPUREGISTER,
LOC_CFPUREGISTER:
begin
case cgpara.location^.loc of
LOC_REFERENCE:
begin
stacksize:=align(locintsize,cgpara.alignment);
if (not paramanager.use_fixed_stack) and
(cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
begin
cg.g_stackpointer_alloc(list,stacksize);
reference_reset_base(href,NR_STACK_POINTER_REG,0,sizeof(pint));
end
else
reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
cg.a_loadfpu_reg_ref(list,locsize,locsize,l.register,href);
end;
LOC_FPUREGISTER:
begin
cg.a_loadfpu_reg_reg(list,locsize,cgpara.location^.size,l.register,cgpara.location^.register);
end;
{ can happen if a record with only 1 "single field" is
returned in a floating point register and then is directly
passed to a regcall parameter }
LOC_REGISTER:
begin
tmploc:=l;
location_force_mem(list,tmploc,size);
case locsize of
OS_F32:
tmploc.size:=OS_32;
OS_F64:
tmploc.size:=OS_64;
else
internalerror(2010053116);
end;
cg.a_load_loc_cgpara(list,tmploc,cgpara);
location_freetemp(list,tmploc);
end
else
internalerror(2010053003);
end;
end;
LOC_MMREGISTER,
LOC_CMMREGISTER:
begin
case cgpara.location^.loc of
LOC_REFERENCE:
begin
{ can't use TCGSize2Size[l.size], because the size of an
80 bit extended parameter can be either 10 or 12 bytes }
stacksize:=align(locintsize,cgpara.alignment);
if (not paramanager.use_fixed_stack) and
(cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
begin
cg.g_stackpointer_alloc(list,stacksize);
reference_reset_base(href,NR_STACK_POINTER_REG,0,sizeof(pint));
end
else
reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
cg.a_loadmm_reg_ref(list,locsize,locsize,l.register,href,mms_movescalar);
end;
LOC_FPUREGISTER:
begin
tmploc:=l;
location_force_mem(list,tmploc,size);
cg.a_loadfpu_ref_cgpara(list,tmploc.size,tmploc.reference,cgpara);
location_freetemp(list,tmploc);
end;
else
internalerror(2010053004);
end;
end;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
case cgpara.location^.loc of
LOC_REFERENCE:
begin
stacksize:=align(locintsize,cgpara.alignment);
if (not paramanager.use_fixed_stack) and
(cgpara.location^.reference.index=NR_STACK_POINTER_REG) then
cg.a_load_ref_cgpara(list,locsize,l.reference,cgpara)
else
begin
reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment);
cg.g_concatcopy(list,l.reference,href,stacksize);
end;
end;
LOC_FPUREGISTER:
begin
cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara);
end;
else
internalerror(2010053005);
end;
end;
else
internalerror(2002042430);
end;
end;
procedure thlcgcpu.g_copyvaluepara_openarray(list: TAsmList; const ref: treference; const lenloc: tlocation; arrdef: tarraydef; destreg: tregister);
begin
if paramanager.use_fixed_stack then
begin
inherited;
exit;
end;
tcg8086(cg).g_copyvaluepara_openarray(list,ref,lenloc,arrdef.elesize,destreg);
end;
procedure thlcgcpu.g_releasevaluepara_openarray(list: TAsmList; arrdef: tarraydef; const l: tlocation);
begin
if paramanager.use_fixed_stack then
begin
inherited;
exit;
end;
tcg8086(cg).g_releasevaluepara_openarray(list,l);
end;
procedure create_hlcodegen;
begin
hlcg:=thlcgcpu.create;
create_codegen;
end;
end.

59
compiler/i8086/ra8086att.pas Normal file
View File

@ -0,0 +1,59 @@
{
Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman
Does the parsing for the i8086 GNU AS styled inline assembler.
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 ra8086att;
{$i fpcdefs.inc}
interface
uses
rax86att;
type
ti8086attreader = class(tx86attreader)
end;
implementation
uses
rabase,systems;
const
asmmode_i8086_att_info : tasmmodeinfo =
(
id : asmmode_i8086_att;
idtxt : 'ATT';
casmreader : ti8086attreader;
);
asmmode_i8086_standard_info : tasmmodeinfo =
(
id : asmmode_standard;
idtxt : 'STANDARD';
casmreader : ti8086attreader;
);
initialization
RegisterAsmMode(asmmode_i8086_att_info);
RegisterAsmMode(asmmode_i8086_standard_info);
end.

74
compiler/i8086/ra8086int.pas Normal file
View File

@ -0,0 +1,74 @@
{
Copyright (c) 1998-2006 by Carl Eric Codere and Peter Vreman
Does the parsing for the i8086 intel styled inline assembler.
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 ra8086int;
{$i fpcdefs.inc}
interface
uses
rax86int;
type
ti8086intreader = class(tx86intreader)
// procedure handleopcode;override;
end;
implementation
uses
rabase,systems,rax86,aasmcpu;
(*
procedure ti386intreader.handleopcode;
var
instr : Tx86Instruction;
begin
instr:=Tx86Instruction.Create(Tx86Operand);
instr.OpOrder:=op_att;
BuildOpcode(instr);
instr.AddReferenceSizes;
instr.SetInstructionOpsize;
{
instr.CheckOperandSizes;
}
instr.ConcatInstruction(curlist);
instr.Free;
end;
*)
{*****************************************************************************
Initialize
*****************************************************************************}
const
asmmode_i8086_intel_info : tasmmodeinfo =
(
id : asmmode_i8086_intel;
idtxt : 'INTEL';
casmreader : ti8086intreader;
);
begin
RegisterAsmMode(asmmode_i8086_intel_info);
end.

71
compiler/i8086/rgcpu.pas Normal file
View File

@ -0,0 +1,71 @@
{
Copyright (c) 1998-2002 by Florian Klaempfl
This unit implements the i386 specific class for the register
allocator
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 rgcpu;
{$i fpcdefs.inc}
interface
uses
cpubase,
cpuinfo,
aasmbase,aasmtai,aasmdata,
cclasses,globtype,cgbase,rgobj,rgx86;
type
trgcpu = class(trgx86)
procedure add_constraints(reg:Tregister);override;
end;
implementation
uses
systems,
verbose;
const
{ This value is used in tsaved. If the array value is equal
to this, then this means that this register is not used.}
reg_not_saved = $7fffffff;
{************************************************************************
trgcpu
*************************************************************************}
procedure trgcpu.add_constraints(reg:Tregister);
var
supreg : tsuperregister;
begin
if getsubreg(reg) in [R_SUBL,R_SUBH] then
begin
{ Some registers have no 8-bit subregister }
supreg:=getsupreg(reg);
add_edge(supreg,RS_SI);
add_edge(supreg,RS_DI);
add_edge(supreg,RS_BP);
end;
end;
end.

2
compiler/systems.inc
View File

@ -66,6 +66,8 @@
,asmmode_x86_64_intel
,asmmode_x86_64_att
,asmmode_avr_gas
,asmmode_i8086_intel
,asmmode_i8086_att
);
(* IMPORTANT NOTE:

13
compiler/x86/cpubase.pas
View File

@ -276,6 +276,11 @@ uses
function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE}
function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE}
{$ifdef i8086}
{ returns the next virtual register }
function GetNextReg(const r : TRegister) : TRegister;
{$endif i8086}
implementation
uses
@ -526,4 +531,12 @@ implementation
end;
{$ifdef i8086}
function GetNextReg(const r: TRegister): TRegister;
begin
result:=TRegister(longint(r)+1);
end;
{$endif i8086}
end.

3
compiler/x86/rax86att.pas
View File

@ -352,6 +352,9 @@ Implementation
{$ifdef i386}
if actasmpattern='GOT' then
{$endif i386}
{$ifdef i8086}
if actasmpattern='GOT' then
{$endif i8086}
begin
oper.opr.ref.refaddr:=addr_pic;
consume(AS_ID);