paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-14 19:39:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ moved target_cpu_string to cpuinfo

Browse Source 
* renamed asmmode enum.
  * assembler reader has now less ifdef's
  * move from nppcmem.pas -> ncgmem.pas vec. node.
This commit is contained in:
carl 2002-08-10 14:46:29 +00:00
parent 3c59d6dfb9
commit 18b102ce95
22 changed files with 1348 additions and 141 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/globals.pas
View File

@ -51,7 +51,7 @@ interface
dos,
{$endif}
cutils,cclasses,
globtype,version,systems;
globtype,version,systems,cpuinfo;
const
{$ifdef Splitheap}
@ -1450,7 +1450,7 @@ implementation
{$IFDEF testvarsets}
initsetalloc:=0;
{$ENDIF}
initasmmode:=asmmode_ppc_direct;
initasmmode:=asmmode_direct;
{$endif powerpc}
initinterfacetype:=it_interfacecom;
initdefproccall:=pocall_none;
@ -1480,7 +1480,13 @@ begin
end.
{
$Log$
Revision 1.62 2002-07-28 20:45:22 florian
Revision 1.63 2002-08-10 14:46:29 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.62 2002/07/28 20:45:22 florian
+ added direct assembler reader for PowerPC
Revision 1.61 2002/07/20 17:12:42 florian

12
compiler/i386/cpuinfo.pas
View File

@ -46,12 +46,22 @@ Const
{# Size of a multimedia register }
mmreg_size = 8;
{ target cpu string (used by compiler options) }
target_cpu_string = 'i386';
Implementation
end.
{
$Log$
Revision 1.10 2002-05-18 13:34:22 peter
Revision 1.11 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.10 2002/05/18 13:34:22 peter
* readded missing revisions
Revision 1.9 2002/05/16 19:46:50 carl

10
compiler/i386/cpuswtch.pas
View File

@ -114,7 +114,7 @@ begin
initasmmode:=asmmode_i386_intel
else
if More='DIRECT' then
initasmmode:=asmmode_i386_direct
initasmmode:=asmmode_direct
else
IllegalPara(opt);
end;
@ -129,7 +129,13 @@ initialization
end.
{
$Log$
Revision 1.7 2002-05-18 13:34:22 peter
Revision 1.8 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.7 2002/05/18 13:34:22 peter
* readded missing revisions
Revision 1.6 2002/05/16 19:46:50 carl

12
compiler/i386/ra386dir.pas → compiler/i386/radirect.pas
View File

@ -20,7 +20,7 @@
****************************************************************************
}
unit Ra386dir;
unit radirect;
{$i fpcdefs.inc}
@ -294,7 +294,7 @@ interface
const
asmmode_i386_direct_info : tasmmodeinfo =
(
id : asmmode_i386_direct;
id : asmmode_direct;
idtxt : 'DIRECT'
);
@ -304,7 +304,13 @@ initialization
end.
{
$Log$
Revision 1.21 2002-07-20 11:58:05 florian
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

11
compiler/ia64/cpuinfo.pas
View File

@ -43,13 +43,22 @@ Const
c_countusableregsfpu = 95;
c_countusableregsmm = 0;
c_countusableregsqp = 48;
{ target cpu string (used by compiler options) }
target_cpu_string = 'ia64';
Implementation
end.
{
$Log$
Revision 1.4 2002-05-16 19:46:52 carl
Revision 1.5 2002-08-10 14:48:09 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.4 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

411
compiler/ncgmem.pas
View File

@ -79,25 +79,27 @@ interface
implementation
uses
{$ifdef delphi}
sysutils,
{$endif}
globtype,systems,
cutils,verbose,globals,
symconst,symdef,symsym,paramgr,
symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
aasmbase,aasmtai,aasmcpu,
cgbase,pass_2,
nld,ncon,nadd,
cpubase,cpupara,
cgobj,cgcpu,
tgobj,rgobj
cginfo,cgbase,pass_2,
pass_1,nld,ncon,nadd,
cpubase,
cgobj,tgobj,rgobj,ncgutil,symbase,
{$ifdef GDB}
{$ifdef delphi}
,sysutils
sysutils,
{$else}
,strings
strings,
{$endif}
,symbase
,gdb
gdb
{$endif GDB}
;
{*****************************************************************************
TCGLOADNODE
@ -486,11 +488,382 @@ implementation
begin
end;
procedure tcgvecnode.pass_2;
begin
{!!!!}
writeln('FIX ME: tcgvecnode.pass_2');
end;
procedure tcgvecnode.pass_2;
var
extraoffset : longint;
{ rl stores the resulttype.def of the left node, this is necessary }
{ to detect if it is an ansistring }
{ because in constant nodes which constant index }
{ the left tree is removed }
t : tnode;
href : treference;
srsym : tsym;
pushed : tpushedsaved;
hightree : tnode;
isjump : boolean;
otl,ofl : tasmlabel;
newsize : tcgsize;
pushedregs : tmaybesave;
begin
newsize:=def_cgsize(resulttype.def);
location_reset(location,LOC_REFERENCE,newsize);
secondpass(left);
{ we load the array reference to location }
{ an ansistring needs to be dereferenced }
if is_ansistring(left.resulttype.def) or
is_widestring(left.resulttype.def) then
begin
if nf_callunique in flags then
begin
if left.location.loc<>LOC_REFERENCE then
begin
CGMessage(cg_e_illegal_expression);
exit;
end;
rg.saveusedregisters(exprasmlist,pushed,all_registers);
cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
rg.saveregvars(exprasmlist,all_registers);
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
cg.g_maybe_loadself(exprasmlist);
rg.restoreusedregisters(exprasmlist,pushed);
end;
case left.location.loc of
LOC_REGISTER,
LOC_CREGISTER :
location.reference.base:=left.location.register;
LOC_CREFERENCE,
LOC_REFERENCE :
begin
location_release(exprasmlist,left.location);
location.reference.base:=rg.getregisterint(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,location.reference.base);
end;
else
internalerror(2002032218);
end;
{ check for a zero length string,
we can use the ansistring routine here }
if (cs_check_range in aktlocalswitches) then
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
rg.saveregvars(exprasmlist,all_registers);
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
cg.g_maybe_loadself(exprasmlist);
rg.restoreusedregisters(exprasmlist,pushed);
end;
{ in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
if is_ansistring(left.resulttype.def) then
dec(location.reference.offset)
else
dec(location.reference.offset,2);
{ we've also to keep left up-to-date, because it is used }
{ if a constant array index occurs, subject to change (FK) }
location_copy(left.location,location);
end
else if is_dynamic_array(left.resulttype.def) then
{ ... also a dynamic string }
begin
case left.location.loc of
LOC_REGISTER,
LOC_CREGISTER :
location.reference.base:=left.location.register;
LOC_REFERENCE,
LOC_CREFERENCE :
begin
location_release(exprasmlist,left.location);
location.reference.base:=rg.getaddressregister(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,
left.location.reference,location.reference.base);
end;
else
internalerror(2002032219);
end;
{$warning FIXME}
{ check for a zero length string,
we can use the ansistring routine here }
if (cs_check_range in aktlocalswitches) then
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
rg.saveregvars(exprasmlist,all_registers);
cg.a_call_name(exprasmlist,'FPC_ANSISTR_CHECKZERO');
cg.g_maybe_loadself(exprasmlist);
rg.restoreusedregisters(exprasmlist,pushed);
end;
{ we've also to keep left up-to-date, because it is used }
{ if a constant array index occurs, subject to change (FK) }
location_copy(left.location,location);
end
else
location_copy(location,left.location);
{ offset can only differ from 0 if arraydef }
if (left.resulttype.def.deftype=arraydef) and
not(is_dynamic_array(left.resulttype.def)) then
dec(location.reference.offset,
get_mul_size*tarraydef(left.resulttype.def).lowrange);
if right.nodetype=ordconstn then
begin
{ offset can only differ from 0 if arraydef }
if (left.resulttype.def.deftype=arraydef) then
begin
if not(is_open_array(left.resulttype.def)) and
not(is_array_of_const(left.resulttype.def)) and
not(is_dynamic_array(left.resulttype.def)) then
begin
if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or
(tordconstnode(right).value<tarraydef(left.resulttype.def).lowrange) then
begin
{ this should be caught in the resulttypepass! (JM) }
if (cs_check_range in aktlocalswitches) then
CGMessage(parser_e_range_check_error)
else
CGMessage(parser_w_range_check_error);
end;
dec(left.location.reference.offset,
get_mul_size*tarraydef(left.resulttype.def).lowrange);
end
else
begin
{ range checking for open and dynamic arrays !!!! }
{$warning FIXME}
{!!!!!!!!!!!!!!!!!}
end;
end
else if (left.resulttype.def.deftype=stringdef) then
begin
if (tordconstnode(right).value=0) and
not(is_shortstring(left.resulttype.def)) then
{ this should be caught in the resulttypepass! (JM) }
CGMessage(cg_e_can_access_element_zero);
if (cs_check_range in aktlocalswitches) then
begin
case tstringdef(left.resulttype.def).string_typ of
{ it's the same for ansi- and wide strings }
st_widestring,
st_ansistring:
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
rg.saveregvars(exprasmlist,all_registers);
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
rg.restoreusedregisters(exprasmlist,pushed);
cg.g_maybe_loadself(exprasmlist);
end;
st_shortstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
st_longstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
end;
end;
end;
inc(left.location.reference.offset,
get_mul_size*tordconstnode(right).value);
location_copy(location,left.location);
end
else
{ not nodetype=ordconstn }
begin
if (cs_regalloc in aktglobalswitches) and
{ if we do range checking, we don't }
{ need that fancy code (it would be }
{ buggy) }
not(cs_check_range in aktlocalswitches) and
(left.resulttype.def.deftype=arraydef) then
begin
extraoffset:=0;
if (right.nodetype=addn) then
begin
if taddnode(right).right.nodetype=ordconstn then
begin
extraoffset:=tordconstnode(taddnode(right).right).value;
t:=taddnode(right).left;
{ First pass processed this with the assumption }
{ that there was an add node which may require an }
{ extra register. Fake it or die with IE10 (JM) }
t.registers32 := taddnode(right).registers32;
taddnode(right).left:=nil;
right.free;
right:=t;
end
else if taddnode(right).left.nodetype=ordconstn then
begin
extraoffset:=tordconstnode(taddnode(right).left).value;
t:=taddnode(right).right;
t.registers32 := right.registers32;
taddnode(right).right:=nil;
right.free;
right:=t;
end;
end
else if (right.nodetype=subn) then
begin
if taddnode(right).right.nodetype=ordconstn then
begin
{ this was "extraoffset:=right.right.value;" Looks a bit like
copy-paste bug :) (JM) }
extraoffset:=-tordconstnode(taddnode(right).right).value;
t:=taddnode(right).left;
t.registers32 := right.registers32;
taddnode(right).left:=nil;
right.free;
right:=t;
end
{ You also have to negate right.right in this case! I can't add an
unaryminusn without causing a crash, so I've disabled it (JM)
else if right.left.nodetype=ordconstn then
begin
extraoffset:=right.left.value;
t:=right.right;
t^.registers32 := right.registers32;
putnode(right);
putnode(right.left);
right:=t;
end;}
end;
inc(location.reference.offset,
get_mul_size*extraoffset);
end;
{ calculate from left to right }
if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
{ should be internalerror! (JM) }
CGMessage(cg_e_illegal_expression);
isjump:=(right.location.loc=LOC_JUMP);
if isjump then
begin
otl:=truelabel;
getlabel(truelabel);
ofl:=falselabel;
getlabel(falselabel);
end;
maybe_save(exprasmlist,right.registers32,location,pushedregs);
secondpass(right);
maybe_restore(exprasmlist,location,pushedregs);
{ here we change the location of right
and the update was forgotten so it
led to wrong code in emitrangecheck later PM
so make range check before }
if cs_check_range in aktlocalswitches then
begin
if left.resulttype.def.deftype=arraydef then
begin
if is_open_array(left.resulttype.def) or
is_array_of_const(left.resulttype.def) then
begin
tarraydef(left.resulttype.def).genrangecheck;
srsym:=searchsymonlyin(tloadnode(left).symtable,
'high'+tvarsym(tloadnode(left).symtableentry).name);
hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
firstpass(hightree);
secondpass(hightree);
location_release(exprasmlist,hightree.location);
reference_reset_symbol(href,newasmsymbol(tarraydef(left.resulttype.def).getrangecheckstring),4);
cg.a_load_loc_ref(exprasmlist,hightree.location,href);
hightree.free;
hightree:=nil;
end;
cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
end;
end;
location_force_reg(exprasmlist,right.location,OS_32,false);
if isjump then
begin
truelabel:=otl;
falselabel:=ofl;
end;
{ produce possible range check code: }
if cs_check_range in aktlocalswitches then
begin
if left.resulttype.def.deftype=arraydef then
begin
{ done defore (PM) }
end
else if (left.resulttype.def.deftype=stringdef) then
begin
case tstringdef(left.resulttype.def).string_typ of
{ it's the same for ansi- and wide strings }
st_widestring,
st_ansistring:
begin
rg.saveusedregisters(exprasmlist,pushed,all_registers);
cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(1));
href:=location.reference;
dec(href.offset,7);
cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
rg.saveregvars(exprasmlist,all_registers);
cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
rg.restoreusedregisters(exprasmlist,pushed);
cg.g_maybe_loadself(exprasmlist);
end;
st_shortstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
st_longstring:
begin
{!!!!!!!!!!!!!!!!!}
end;
end;
end;
end;
if location.reference.index=R_NO then
begin
location.reference.index:=right.location.register;
cg.a_op_const_reg(exprasmlist,OP_IMUL,get_mul_size,
right.location.register);
end
else
begin
if location.reference.base=R_NO then
{ this wouldn't make sense for the ppc since there are }
{ no scalefactors (JM) }
internalerror(2002072901)
else
begin
cg.a_loadaddr_ref_reg(exprasmlist,location.reference,
location.reference.base);
rg.ungetregisterint(exprasmlist,location.reference.index);
{ the symbol offset is loaded, }
{ so release the symbol name and set symbol }
{ to nil }
location.reference.symbol:=nil;
location.reference.offset:=0;
cg.a_op_const_reg(exprasmlist,OP_IMUL,
get_mul_size,right.location.register);
location.reference.index:=right.location.register;
end;
end;
end;
location.size:=newsize;
end;
begin
@ -507,7 +880,13 @@ begin
end.
{
$Log$
Revision 1.18 2002-07-28 21:34:31 florian
Revision 1.19 2002-08-10 14:46:29 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.18 2002/07/28 21:34:31 florian
* more powerpc fixes
+ dummy tcgvecnode

10
compiler/options.pas
View File

@ -27,7 +27,7 @@ unit options;
interface
uses
globtype,globals,verbose,systems;
globtype,globals,verbose,systems,cpuinfo;
type
TOption=class
@ -1677,7 +1677,13 @@ finalization
end.
{
$Log$
Revision 1.80 2002-08-09 19:15:41 carl
Revision 1.81 2002-08-10 14:46:29 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.80 2002/08/09 19:15:41 carl
- removed newcg define
Revision 1.79 2002/07/26 22:22:10 florian

10
compiler/pmodules.pas
View File

@ -40,7 +40,7 @@ implementation
globals,verbose,fmodule,finput,fppu,
symconst,symbase,symtype,symdef,symsym,symtable,
aasmbase,aasmtai,aasmcpu,
cgbase,
cgbase,cpuinfo,
ncgutil,
link,assemble,import,export,gendef,ppu,comprsrc,
cresstr,cpubase,
@ -1388,7 +1388,13 @@ implementation
end.
{
$Log$
Revision 1.69 2002-07-26 21:15:41 florian
Revision 1.70 2002-08-10 14:46:29 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.69 2002/07/26 21:15:41 florian
* rewrote the system handling
Revision 1.68 2002/07/04 20:43:01 florian

10
compiler/powerpc/cpuinfo.pas
View File

@ -38,13 +38,21 @@ Const
pointer_size = 4;
{# Size of a multimedia register }
mmreg_size = 16;
{ target cpu string (used by compiler options) }
target_cpu_string = 'powerpc';
Implementation
end.
{
$Log$
Revision 1.7 2002-05-18 13:34:26 peter
Revision 1.8 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.
Revision 1.7 2002/05/18 13:34:26 peter
* readded missing revisions
Revision 1.6 2002/05/16 19:46:53 carl

10
compiler/powerpc/cpunode.pas
View File

@ -39,7 +39,7 @@ unit cpunode;
// nppccal,
// nppccon,
// nppcflw,
nppcmem,
// nppcmem,
// nppcset,
// nppcinl,
// nppcopt,
@ -52,7 +52,13 @@ unit cpunode;
end.
{
$Log$
Revision 1.11 2002-07-29 09:22:20 jonas
Revision 1.12 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.
Revision 1.11 2002/07/29 09:22:20 jonas
+ nppcmem
Revision 1.10 2002/07/28 20:45:22 florian

10
compiler/powerpc/cpuswtch.pas
View File

@ -112,7 +112,7 @@ begin
initasmmode:=asmmode_ppc_motorola
else
if More='DIRECT' then
initasmmode:=asmmode_ppc_direct
initasmmode:=asmmode_direct
else
IllegalPara(opt);
end;
@ -128,7 +128,13 @@ initialization
end.
{
$Log$
Revision 1.5 2002-07-28 20:45:23 florian
Revision 1.6 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.
Revision 1.5 2002/07/28 20:45:23 florian
+ added direct assembler reader for PowerPC
Revision 1.4 2002/05/18 13:34:26 peter

331
compiler/powerpc/radirect.pas Normal file
View File

@ -0,0 +1,331 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Reads inline Powerpc 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.
****************************************************************************
}
{
This unit reads PowerPC inline assembler and writes the lines direct to the output file.
}
unit radirect;
{$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,
{ pass 1 }
nbas,
{ parser }
scanner,
{ codegen }
cgbase,
{ constants }
agppcgas
;
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)+'('+gas_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;
{$ifdef dummy}
else
{ access to local variables }
if assigned(aktprocdef) then
begin
{ I don't know yet, what the ppc port requires }
{ we'll see how things settle down }
{ is the last written character an special }
{ char ? }
if (s[length(s)]='%') and
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)+
'('+gas_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)+'('+gas_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)+
'('+gas_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
{ implement old stack/frame pointer access for nested procedures }
{!!!!
else if upper(hs)='__OLDSP' then
begin
{ complicate to check there }
{ we do it: }
if lexlevel>normal_function_level then
hs:=tostr(procinfo^.framepointer_offset)+
'('+gas_reg2str[procinfo^.framepointer]+')'
else
Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
end;
}
end;
end;
end;
end;
{$endif dummy}
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_ppc_direct_info : tasmmodeinfo =
(
id : asmmode_direct;
idtxt : 'DIRECT'
);
initialization
RegisterAsmMode(asmmode_ppc_direct_info);
end.
{
$Log$
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.
Revision 1.2 2002/07/28 20:45:23 florian
+ added direct assembler reader for PowerPC
Revision 1.1 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
}

10
compiler/powerpc/rappc.pas
View File

@ -20,7 +20,7 @@
****************************************************************************
}
unit Ra386;
unit Rasm;
{$i fpcdefs.inc}
@ -669,7 +669,13 @@ end;
end.
{
$Log$
Revision 1.1 2002-07-28 20:45:23 florian
Revision 1.2 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.
Revision 1.1 2002/07/28 20:45:23 florian
+ added direct assembler reader for PowerPC
}

73
compiler/powerpc/rasm.pas Normal file
View File

@ -0,0 +1,73 @@
{
$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-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.
}

81
compiler/pstatmnt.pas
View File

@ -55,6 +55,7 @@ implementation
pbase,pexpr,
{ codegen }
rgobj,cgbase
,radirect
{$ifdef i386}
{$ifndef NoRa386Int}
,ra386int
@ -62,25 +63,9 @@ implementation
{$ifndef NoRa386Att}
,ra386att
{$endif NoRa386Att}
{$ifndef NoRa386Dir}
,ra386dir
{$endif NoRa386Dir}
{$else}
,rasm
{$endif i386}
{$ifdef powerpc}
{$ifndef NoRaPPCDir}
,rappcdir
{$endif NoRaPPCDir}
{$endif powerpc}
{$ifdef x86_64}
{$ifndef NoRax86Dir}
,rax86dir
{$endif NoRax86Dir}
{$endif i386}
{$ifdef m68k}
{$ifndef NoRa68kMot}
,ra68kmot
{$endif NoRa68kMot}
{$endif m68k}
;
@ -740,8 +725,8 @@ implementation
asmmode_i386_intel:
asmstat:=tasmnode(ra386int.assemble);
{$endif NoRA386Int}
{$ifndef NoRA386Dir}
asmmode_i386_direct:
{$else}
asmmode_direct:
begin
if not target_asm.allowdirect then
Message(parser_f_direct_assembler_not_allowed);
@ -751,51 +736,13 @@ implementation
Message(parser_w_inlining_disabled);
aktprocdef.proccalloption:=pocall_fpccall;
End;
asmstat:=tasmnode(ra386dir.assemble);
asmstat:=tasmnode(radirect.assemble);
end;
{$endif NoRA386Dir}
{$endif}
{$ifdef x86_64}
{$ifndef NoRA386Dir}
asmmode_i386_direct:
begin
if not target_asm.allowdirect then
Message(parser_f_direct_assembler_not_allowed);
if (aktprocdef.proccalloption=pocall_inline) then
Begin
Message1(parser_w_not_supported_for_inline,'direct asm');
Message(parser_w_inlining_disabled);
aktprocdef.proccalloption:=pocall_fpccall;
End;
asmstat:=tasmnode(rax86dir.assemble);
end;
{$endif NoRA386Dir}
{$endif x86_64}
{$ifdef powerpc}
{$ifndef NoRAPPCDir}
asmmode_ppc_direct:
begin
if not target_asm.allowdirect then
Message(parser_f_direct_assembler_not_allowed);
if (aktprocdef.proccalloption=pocall_inline) then
Begin
Message1(parser_w_not_supported_for_inline,'direct asm');
Message(parser_w_inlining_disabled);
aktprocdef.proccalloption:=pocall_fpccall;
End;
asmstat:=tasmnode(rappcdir.assemble);
end;
{$endif NoRAPPCDir}
{$endif powerpc}
{$ifdef m68k}
{$ifndef NoRA68kMot}
asmmode_m68k_mot:
asmstat:=tasmnode(ra68kmot.assemble);
{$endif NoRA68kMot}
{$endif}
asmmode_standard:
asmstat:=tasmnode(rasm.assemble);
{$endif}
else
Message(parser_f_assembler_reader_not_supported);
end;
@ -1195,7 +1142,13 @@ implementation
end.
{
$Log$
Revision 1.67 2002-08-09 19:11:44 carl
Revision 1.68 2002-08-10 14:46:30 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.67 2002/08/09 19:11:44 carl
+ reading of used registers in assembler routines is now
cpu-independent

10
compiler/scanner.pas
View File

@ -31,7 +31,7 @@ interface
globtype,globals,version,tokens,
verbose,comphook,
finput,
widestr;
widestr,cpuinfo;
const
maxmacrolen=16*1024;
@ -2783,7 +2783,13 @@ exit_label:
end.
{
$Log$
Revision 1.41 2002-08-06 21:12:16 florian
Revision 1.42 2002-08-10 14:46:31 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.41 2002/08/06 21:12:16 florian
+ support for octal constants, they are specified by a leading &
Revision 1.40 2002/07/20 17:35:52 florian

18
compiler/systems.pas
View File

@ -66,10 +66,12 @@ interface
);
tasmmode= (asmmode_none
,asmmode_i386_direct,asmmode_i386_att,asmmode_i386_intel
,asmmode_m68k_mot
,asmmode_alpha_direct
,asmmode_ppc_direct,asmmode_ppc_gas,asmmode_ppc_motorola
{ direct output with minimal parsing }
,asmmode_direct
{ standard assembler (cpu dependant) with full parsing }
,asmmode_standard
,asmmode_i386_att
,asmmode_i386_intel
);
{ IMPORTANT NOTE:
@ -636,7 +638,13 @@ finalization
end.
{
$Log$
Revision 1.49 2002-07-28 20:45:22 florian
Revision 1.50 2002-08-10 14:46:31 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.49 2002/07/28 20:45:22 florian
+ added direct assembler reader for PowerPC
Revision 1.48 2002/07/26 21:15:42 florian

37
compiler/version.pas
View File

@ -43,35 +43,6 @@ interface
date_string = 'N/A';
{$endif}
{ target cpu string }
{$ifdef i386}
target_cpu_string = 'i386';
{$endif}
{$ifdef x86_64}
target_cpu_string = 'x86_64';
{$endif}
{$ifdef sparc}
target_cpu_string = 'sparc';
{$endif}
{$ifdef m68k}
target_cpu_string = 'm68k';
{$endif}
{$ifdef alpha}
target_cpu_string = 'alpha';
{$endif}
{$ifdef powerpc}
target_cpu_string = 'powerpc';
{$endif}
{$ifdef ia64}
target_cpu_string = 'ia64';
{$endif}
{$ifdef mips}
target_cpu_string = 'mips';
{$endif}
{$ifdef arm}
target_cpu_string = 'arm';
{$endif}
{ source cpu string }
{$ifdef cpu86}
@ -113,7 +84,13 @@ end;
end.
{
$Log$
Revision 1.14 2002-08-09 19:15:41 carl
Revision 1.15 2002-08-10 14:46:31 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.14 2002/08/09 19:15:41 carl
- removed newcg define
Revision 1.13 2002/07/04 20:43:02 florian

10
compiler/x86_64/cpuinfo.pas
View File

@ -49,6 +49,8 @@ Const
pointer_size = 8;
{ Size of a multimedia register }
mmreg_size = 16;
{ target cpu string (used by compiler options) }
target_cpu_string = 'x86_64';
Implementation
@ -56,7 +58,13 @@ Implementation
end.
{
$Log$
Revision 1.2 2002-07-25 22:55:34 florian
Revision 1.3 2002-08-10 14:53:38 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.2 2002/07/25 22:55:34 florian
* several fixes, small test units can be compiled
Revision 1.1 2002/07/24 22:38:15 florian

10
compiler/x86_64/cpuswtch.pas
View File

@ -86,7 +86,7 @@ begin
initasmmode:=asmmode_i386_intel
else
if More='DIRECT' then
initasmmode:=asmmode_i386_direct
initasmmode:=asmmode_direct
else
IllegalPara(opt);
end;
@ -101,7 +101,13 @@ initialization
end.
{
$Log$
Revision 1.1 2002-07-24 22:38:15 florian
Revision 1.2 2002-08-10 14:53:38 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.1 2002/07/24 22:38:15 florian
+ initial release of x86-64 target code
Revision 1.7 2002/05/18 13:34:22 peter

318
compiler/x86_64/radirect.pas Normal file
View File

@ -0,0 +1,318 @@
{
$Id$
Copyright (c) 1998-2001 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;
{$i fpcdefs.inc}
interface
uses
node;
function assemble : tnode;
implementation
uses
{ common }
cutils,
{ global }
globals,verbose,
systems,
{ aasm }
cpubase,aasmtai,
{ symtable }
symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
{ pass 1 }
nbas,
{ parser }
scanner,
rax86_64,
agx64att,
{ codegen }
cgbase
;
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)+'('+att_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)+
'('+att_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)+'('+att_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)+
'('+att_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)+
'('+att_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-10 14:53:38 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.2 2002/07/25 22:55:34 florian
* several fixes, small test units can be compiled
Revision 1.1 2002/07/24 22:38:15 florian
+ initial release of x86-64 target code
}

73
compiler/x86_64/rasm.pas Normal file
View File

@ -0,0 +1,73 @@
{
$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-10 14:53:38 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.
}