*** empty log message ***

This commit is contained in:
mazen 2002-08-23 10:08:28 +00:00
parent af7d17d28c
commit c52839c2d6
5 changed files with 580 additions and 16 deletions

105
compiler/sparc/cpupi.pas Normal file
View File

@ -0,0 +1,105 @@
{
$Id$
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
cutils,
cgbase,cpuinfo;
type
Tppcprocinfo = class(tprocinfo)
{ overall size of allocated stack space, currently this is used for the PowerPC only }
localsize : aword;
{ max. of space need for parameters, currently used by the PowerPC port only }
maxpushedparasize : aword;
constructor create;override;
procedure after_header;override;
procedure after_pass1;override;
end;
implementation
uses
globtype,globals,
aasmtai,
tgobj;
constructor Tppcprocinfo.create;
begin
inherited create;
maxpushedparasize:=0;
localsize:=0;
end;
procedure Tppcprocinfo.after_header;
begin
{ this value is necessary for nested procedures }
procdef.localst.address_fixup:=align(procdef.parast.datasize,16);
end;
procedure Tppcprocinfo.after_pass1;
begin
procdef.parast.address_fixup:=align(maxpushedparasize,16);
if cs_asm_source in aktglobalswitches then
aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup))));
procdef.localst.address_fixup:=align(procdef.parast.address_fixup+procdef.parast.datasize,16);
if cs_asm_source in aktglobalswitches then
aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup))));
procinfo.firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
if cs_asm_source in aktglobalswitches then
aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: r1+'+tostr(procinfo.firsttemp_offset))));
//!!!! tg.setfirsttemp(procinfo.firsttemp_offset);
tg.firsttemp:=procinfo.firsttemp_offset;
tg.lasttemp:=procinfo.firsttemp_offset;
end;
begin
cprocinfo:=Tppcprocinfo;
end.
{
$Log$
Revision 1.1 2002-08-23 10:08:28 mazen
*** empty log message ***
Revision 1.2 2002/08/18 20:06:30 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu
* nld,ncon,nbas are already updated for storing in ppu
Revision 1.1 2002/08/17 09:23:49 florian
* first part of procinfo rewrite
}

View File

@ -2,7 +2,7 @@
$Id$ $Id$
Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller Copyright (c) 1998-2000 by Florian Klaempfl, Pierre Muller
interprets the commandline options which are i386 specific interprets the commandline options which are iSPARC specific
This program is free software; you can redistribute it and/or modify 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 it under the terms of the GNU General Public License as published by
@ -30,16 +30,16 @@ uses
options; options;
type type
toption386=class(toption) toptionSPARC=class(toption)
procedure interpret_proc_specific_options(const opt:string);override; procedure interpret_proc_specific_options(const opt:string);override;
end; end;
implementation implementation
uses uses
cutils,globtype,systems,globals; cutils,globtype,systems,globals,cpuinfo;
procedure toption386.interpret_proc_specific_options(const opt:string); procedure toptionSPARC.interpret_proc_specific_options(const opt:string);
var var
j : longint; j : longint;
More : string; More : string;
@ -78,9 +78,9 @@ begin
If j < Length(Opt) Then If j < Length(Opt) Then
Begin Begin
Case opt[j+1] Of Case opt[j+1] Of
'1': initoptprocessor := Class386; '1': initoptprocessor := SPARC_V8;
'2': initoptprocessor := ClassP5; '2': initoptprocessor := SPARC_V9;
'3': initoptprocessor := ClassP6 '3': initoptprocessor := SPARC_V9;
Else IllegalPara(Opt) Else IllegalPara(Opt)
End; End;
Inc(j); Inc(j);
@ -114,7 +114,7 @@ begin
initasmmode:=asmmode_i386_intel initasmmode:=asmmode_i386_intel
else else
if More='DIRECT' then if More='DIRECT' then
initasmmode:=asmmode_i386_direct initasmmode:=asmmode_direct
else else
IllegalPara(opt); IllegalPara(opt);
end; end;
@ -125,11 +125,14 @@ end;
initialization initialization
coption:=toption386; coption:=toptionSPARC;
end. end.
{ {
$Log$ $Log$
Revision 1.1 2002-08-22 08:30:50 mazen Revision 1.2 2002-08-23 10:08:28 mazen
*** empty log message ***
Revision 1.1 2002/08/22 08:30:50 mazen
first insertion 2002\08\22 first insertion 2002\08\22
Revision 1.4 2001/07/01 20:16:20 peter Revision 1.4 2001/07/01 20:16:20 peter
@ -156,7 +159,7 @@ end.
* renamed * renamed
Revision 1.1 2000/11/30 22:21:56 florian Revision 1.1 2000/11/30 22:21:56 florian
* moved to i386 * moved to iSPARC
Revision 1.6 2000/10/24 10:40:53 jonas Revision 1.6 2000/10/24 10:40:53 jonas
+ register renaming ("fixes" bug1088) + register renaming ("fixes" bug1088)
@ -164,10 +167,10 @@ end.
O2 now means peepholopts, CSE and register renaming in 1 pass O2 now means peepholopts, CSE and register renaming in 1 pass
O3 is the same, but repeated until no further optimizations are O3 is the same, but repeated until no further optimizations are
possible or until 5 passes have been done (to avoid endless loops) possible or until 5 passes have been done (to avoid endless loops)
* changed aopt386 so it does this looping * changed aoptSPARC so it does this looping
* added some procedures from csopt386 to the interface because they're * added some procedures from csoptSPARC to the interface because they're
used by rropt386 as well used by rroptSPARC as well
* some changes to csopt386 and daopt386 so that newly added instructions * some changes to csoptSPARC and daoptSPARC so that newly added instructions
by the CSE get optimizer info (they were simply skipped previously), by the CSE get optimizer info (they were simply skipped previously),
this fixes some bugs this fixes some bugs

View File

@ -233,7 +233,7 @@ PROCEDURE TSparcAddNode.emit_generic_code(op:TAsmOp;OpSize:TOpSize;unsigned,extr
IF cs_check_overflow IN aktlocalswitches IF cs_check_overflow IN aktlocalswitches
THEN THEN
BEGIN BEGIN
getlabel(hl4); // getlabel(hl4);
IF unsigned IF unsigned
THEN THEN
emitjmp(C_NB,hl4) emitjmp(C_NB,hl4)

378
compiler/sparc/radirect.pas Normal file
View File

@ -0,0 +1,378 @@
{*****************************************************************************}
{ File : radirect.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\08\22 }
{ Last modification date : 2002\08\22 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Reads inline assembler and writes the lines direct to the output
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 radirect;
{$MACRO ON}{$i fpcdefs.inc}
interface
uses
node;
function assemble : tnode;
implementation
uses
{ common }
cutils,
{ global }
globals,verbose,
systems,
{ aasm }
aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
{ pass 1 }
nbas,
{ parser }
scanner,
rautils,
{ codegen }
cgbase,
{ constants }
aggas,cpubase,globtype
;
Procedure FWaitWarning;
begin
if (target_info.system=system_i386_GO32V2) and (cs_fp_emulation in aktmoduleswitches) then
Message(asmr_w_fwait_emu_prob);
end;
function assemble : tnode;
var
retstr,s,hs : string;
c : char;
ende : boolean;
srsym,sym : tsym;
srsymtable : tsymtable;
code : TAAsmoutput;
i,l : longint;
procedure writeasmline;
var
i : longint;
begin
i:=length(s);
while (i>0) and (s[i] in [' ',#9]) do
dec(i);
s[0]:=chr(i);
if s<>'' then
code.concat(Tai_direct.Create(strpnew(s)));
{ consider it set function set if the offset was loaded }
if assigned(aktprocdef.funcretsym) and
(pos(retstr,upper(s))>0) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
s:='';
end;
begin
ende:=false;
s:='';
if assigned(aktprocdef.funcretsym) and
is_fpu(aktprocdef.rettype.def) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
if (not is_void(aktprocdef.rettype.def)) then
retstr:=upper(tostr(procinfo.return_offset)+'('+std_reg2str[procinfo.framepointer]+')')
else
retstr:='';
c:=current_scanner.asmgetchar;
code:=TAAsmoutput.Create;
while not(ende) do
begin
{ wrong placement
current_scanner.gettokenpos; }
case c of
'A'..'Z','a'..'z','_' : begin
current_scanner.gettokenpos;
i:=0;
hs:='';
while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
or (c='_') do
begin
inc(i);
hs[i]:=c;
c:=current_scanner.asmgetchar;
end;
hs[0]:=chr(i);
if upper(hs)='END' then
ende:=true
else
begin
if c=':' then
begin
searchsym(upper(hs),srsym,srsymtable);
if srsym<>nil then
if (srsym.typ = labelsym) then
Begin
hs:=tlabelsym(srsym).lab.name;
tlabelsym(srsym).lab.is_set:=true;
end
else
Message(asmr_w_using_defined_as_local);
end
else if upper(hs)='FWAIT' then
FwaitWarning
else
{ access to local variables }
if assigned(aktprocdef) then
begin
{ is the last written character an special }
{ char ? }
if (s[length(s)]='%') and
paramanager.ret_in_acc(aktprocdef.rettype.def) and
((pos('AX',upper(hs))>0) or
(pos('AL',upper(hs))>0)) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
if (s[length(s)]<>'%') and
(s[length(s)]<>'$') and
((s[length(s)]<>'0') or (hs[1]<>'x')) then
begin
if assigned(aktprocdef.localst) and
(lexlevel >= normal_function_level) then
sym:=tsym(aktprocdef.localst.search(upper(hs)))
else
sym:=nil;
if assigned(sym) then
begin
if (sym.typ = labelsym) then
Begin
hs:=tlabelsym(sym).lab.name;
end
else if sym.typ=varsym then
begin
{variables set are after a comma }
{like in movl %eax,I }
if pos(',',s) > 0 then
tvarsym(sym).varstate:=vs_used
else
if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
Message1(sym_n_uninitialized_local_variable,hs);
if (vo_is_external in tvarsym(sym).varoptions) then
hs:=tvarsym(sym).mangledname
else
hs:='-'+tostr(tvarsym(sym).address)+
'('+std_reg2str[procinfo.framepointer]+')';
end
else
{ call to local function }
if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
(pos('LEA',upper(s))>0)) then
begin
hs:=tprocsym(sym).defs^.def.mangledname;
end;
end
else
begin
if assigned(aktprocdef.parast) then
sym:=tsym(aktprocdef.parast.search(upper(hs)))
else
sym:=nil;
if assigned(sym) then
begin
if sym.typ=varsym then
begin
l:=tvarsym(sym).address;
{ set offset }
inc(l,aktprocdef.parast.address_fixup);
hs:=tostr(l)+'('+std_reg2str[procinfo.framepointer]+')';
if pos(',',s) > 0 then
tvarsym(sym).varstate:=vs_used;
end;
end
{ I added that but it creates a problem in line.ppi
because there is a local label wbuffer and
a static variable WBUFFER ...
what would you decide, florian ?}
else
begin
searchsym(upper(hs),sym,srsymtable);
if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
begin
case sym.typ of
varsym :
begin
Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
hs:=tvarsym(sym).mangledname;
inc(tvarsym(sym).refs);
end;
typedconstsym :
begin
Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
hs:=ttypedconstsym(sym).mangledname;
end;
procsym :
begin
{ procs can be called or the address can be loaded }
if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
begin
if assigned(tprocsym(sym).defs^.def) then
Message1(asmr_w_direct_global_is_overloaded_func,hs);
Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
hs:=tprocsym(sym).defs^.def.mangledname;
end;
end;
else
Message(asmr_e_wrong_sym_type);
end;
end
else if upper(hs)='__SELF' then
begin
if assigned(procinfo._class) then
hs:=tostr(procinfo.selfpointer_offset)+
'('+std_reg2str[procinfo.framepointer]+')'
else
Message(asmr_e_cannot_use_SELF_outside_a_method);
end
else if upper(hs)='__RESULT' then
begin
if (not is_void(aktprocdef.rettype.def)) then
hs:=retstr
else
Message(asmr_e_void_function);
end
else if upper(hs)='__OLDEBP' then
begin
{ complicate to check there }
{ we do it: }
if lexlevel>normal_function_level then
hs:=tostr(procinfo.framepointer_offset)+
'('+std_reg2str[procinfo.framepointer]+')'
else
Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
end;
end;
end;
end;
end;
s:=s+hs;
end;
end;
'{',';',#10,#13 : begin
if pos(retstr,s) > 0 then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
writeasmline;
c:=current_scanner.asmgetchar;
end;
#26 : Message(scan_f_end_of_file);
else
begin
current_scanner.gettokenpos;
inc(byte(s[0]));
s[length(s)]:=c;
c:=current_scanner.asmgetchar;
end;
end;
end;
writeasmline;
assemble:=casmnode.create(code);
end;
{*****************************************************************************
Initialize
*****************************************************************************}
const
asmmode_i386_direct_info : tasmmodeinfo =
(
id : asmmode_direct;
idtxt : 'DIRECT'
);
initialization
RegisterAsmMode(asmmode_i386_direct_info);
end.
{
$Log$
Revision 1.1 2002-08-23 10:08:28 mazen
*** empty log message ***
Revision 1.2 2002/08/17 09:23:47 florian
* first part of procinfo rewrite
Revision 1.1 2002/08/10 14:47:50 carl
+ moved target_cpu_string to cpuinfo
* renamed asmmode enum.
* assembler reader has now less ifdef's
* move from nppcmem.pas -> ncgmem.pas vec. node.
Revision 1.21 2002/07/20 11:58:05 florian
* types.pas renamed to defbase.pas because D6 contains a types
unit so this would conflicts if D6 programms are compiled
+ Willamette/SSE2 instructions to assembler added
Revision 1.20 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
Revision 1.19 2002/07/01 18:46:34 peter
* internal linker
* reorganized aasm layer
Revision 1.18 2002/05/18 13:34:26 peter
* readded missing revisions
Revision 1.17 2002/05/16 19:46:52 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.15 2002/05/12 16:53:18 peter
* moved entry and exitcode to ncgutil and cgobj
* foreach gets extra argument for passing local data to the
iterator function
* -CR checks also class typecasts at runtime by changing them
into as
* fixed compiler to cycle with the -CR option
* fixed stabs with elf writer, finally the global variables can
be watched
* removed a lot of routines from cga unit and replaced them by
calls to cgobj
* u32bit-s32bit updates for and,or,xor nodes. When one element is
u32bit then the other is typecasted also to u32bit without giving
a rangecheck warning/error.
* fixed pascal calling method with reversing also the high tree in
the parast, detected by tcalcst3 test
Revision 1.14 2002/04/15 19:12:09 carl
+ target_info.size_of_pointer -> pointer_size
+ some cleanup of unused types/variables
* move several constants from cpubase to their specific units
(where they are used)
+ att_Reg2str -> std_reg2str
+ int_reg2str -> std_reg2str
Revision 1.13 2002/04/14 17:01:52 carl
+ att_reg2str -> std_reg2str
}

78
compiler/sparc/rasm.pas Normal file
View File

@ -0,0 +1,78 @@
{
$Id$
Copyright (c) 1998-2002 by The Free Pascal Team
This unit does the parsing process for the 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 Rasm;
{$i fpcdefs.inc}
Interface
uses
node;
{
This routine is called to parse the instructions in assembler
blocks. It returns a complete list of directive and instructions
}
function assemble: tnode;
Implementation
uses
{ common }
cutils,cclasses,
{ global }
globtype,globals,verbose,
systems,
{ aasm }
cpubase,aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,
{ pass 1 }
nbas,
{ parser }
scanner
// ,rautils
;
function assemble : tnode;
begin
end;
Begin
end.
{
$Log$
Revision 1.1 2002-08-23 10:08:28 mazen
*** empty log message ***
Revision 1.2 2002/08/11 06:14:41 florian
* fixed powerpc compilation problems
Revision 1.1 2002/08/10 14:52:52 carl
+ moved target_cpu_string to cpuinfo
* renamed asmmode enum.
* assembler reader has now less ifdef's
* move from nppcmem.pas -> ncgmem.pas vec. node.
}