paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-18 04:29:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* first things tai,tnode storing in ppu

Browse Source
This commit is contained in:
peter 2002-08-15 19:10:35 +00:00
parent 588abc6631
commit 8082f79ea6
8 changed files with 1233 additions and 465 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

484
compiler/aasmtai.pas
View File

@ -36,6 +36,7 @@ interface
cutils,cclasses,
globtype,globals,systems,
cpuinfo,cpubase,
symppu,
aasmbase;
type
@ -119,6 +120,8 @@ interface
fileinfo : tfileposinfo;
typ : tait;
constructor Create;
procedure write(ppufile:tcompilerppufile);virtual;abstract;
procedure derefobjectdata;virtual;
end;
{# Generates an assembler string }
@ -130,6 +133,8 @@ interface
constructor Create_pchar(_str : pchar);
constructor Create_length_pchar(_str : pchar;length : longint);
destructor Destroy;override;
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Generates a common label }
@ -142,12 +147,18 @@ interface
constructor Createname_global(const _name : string;siz:longint);
constructor Createdataname(const _name : string;siz:longint);
constructor Createdataname_global(const _name : string;siz:longint);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
procedure derefobjectdata;override;
end;
tai_symbol_end = class(tai)
sym : tasmsymbol;
constructor Create(_sym:tasmsymbol);
constructor Createname(const _name : string);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
procedure derefobjectdata;override;
end;
{# Generates an assembler label }
@ -155,6 +166,9 @@ interface
is_global : boolean;
l : tasmlabel;
constructor Create(_l : tasmlabel);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
procedure derefobjectdata;override;
end;
{# Directly output data to final assembler file }
@ -162,6 +176,8 @@ interface
str : pchar;
constructor Create(_str : pchar);
destructor Destroy; override;
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Generates an assembler comment }
@ -169,6 +185,8 @@ interface
str : pchar;
constructor Create(_str : pchar);
destructor Destroy; override;
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
@ -176,6 +194,8 @@ interface
tai_section = class(tai)
sec : TSection;
constructor Create(s : TSection);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
@ -186,6 +206,9 @@ interface
size : longint;
constructor Create(const _name : string;_size : longint);
constructor Create_global(const _name : string;_size : longint);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
procedure derefobjectdata;override;
end;
@ -195,6 +218,8 @@ interface
constructor Create_32bit(_value : longint);
constructor Create_16bit(_value : word);
constructor Create_8bit(_value : byte);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
tai_const_symbol = class(tai)
@ -206,24 +231,33 @@ interface
constructor Createname(const name:string);
constructor Createname_offset(const name:string;ofs:longint);
constructor Createname_rva(const name:string);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
procedure derefobjectdata;override;
end;
{# Generates a single float (32 bit real) }
tai_real_32bit = class(tai)
value : ts32real;
constructor Create(_value : ts32real);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Generates a double float (64 bit real) }
tai_real_64bit = class(tai)
value : ts64real;
constructor Create(_value : ts64real);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Generates an extended float (80 bit real) }
tai_real_80bit = class(tai)
value : ts80real;
constructor Create(_value : ts80real);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Generates a comp int (integer over 64 bits)
@ -234,6 +268,8 @@ interface
tai_comp_64bit = class(tai)
value : ts64comp;
constructor Create(_value : ts64comp);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Insert a cut to split assembler into several smaller files }
@ -242,12 +278,16 @@ interface
constructor Create;
constructor Create_begin;
constructor Create_end;
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Insert a marker for assembler and inline blocks }
tai_marker = class(tai)
Kind: TMarker;
Constructor Create(_Kind: TMarker);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
tai_tempalloc = class(tai)
@ -256,6 +296,8 @@ interface
tempsize : longint;
constructor alloc(pos,size:longint);
constructor dealloc(pos,size:longint);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
tai_regalloc = class(tai)
@ -263,15 +305,22 @@ interface
reg : tregister;
constructor alloc(r : tregister);
constructor dealloc(r : tregister);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
end;
{# Class template for assembler instructions
}
taicpu_abstract = class(tai)
protected
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
procedure ppuderefoper(var o:toper);virtual;abstract;
public
{# Condition flags for instruction }
condition : TAsmCond;
{# Number of operands to instruction }
ops : longint;
ops : byte;
{# Operands of instruction }
oper : array[0..max_operands-1] of toper;
{# Actual opcode of instruction }
@ -284,12 +333,15 @@ interface
Constructor Create(op : tasmop);
Destructor Destroy;override;
function getcopy:TLinkedListItem;override;
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
procedure derefobjectdata;override;
procedure SetCondition(const c:TAsmCond);
procedure loadconst(opidx:longint;l:aword);
procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
procedure loadref(opidx:longint;const r:treference);
procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper);
procedure SetCondition(const c:TAsmCond);
end;
{# alignment for operator }
@ -301,6 +353,8 @@ interface
use_op : boolean;
constructor Create(b:byte);
constructor Create_op(b: byte; _op: byte);
constructor load(ppufile:tcompilerppufile);
procedure write(ppufile:tcompilerppufile);override;
function getfillbuf:pchar;virtual;
end;
@ -328,7 +382,8 @@ uses
{$else}
strings,
{$endif}
verbose;
verbose,
ppu;
{****************************************************************************
TAI
@ -340,6 +395,11 @@ uses
fileinfo:=aktfilepos;
end;
procedure tai.derefobjectdata;
begin
end;
{****************************************************************************
TAI_SECTION
****************************************************************************}
@ -352,6 +412,20 @@ uses
end;
constructor tai_section.load(ppufile:tcompilerppufile);
begin
inherited Create;
sec:=tsection(ppufile.getbyte);
end;
procedure tai_section.write(ppufile:tcompilerppufile);
begin
ppufile.putbyte(byte(sec));
ppufile.writeentry(ibtaisection);
end;
{****************************************************************************
TAI_DATABLOCK
****************************************************************************}
@ -383,6 +457,30 @@ uses
end;
constructor tai_datablock.load(ppufile:tcompilerppufile);
begin
inherited Create;
sym:=ppufile.getasmsymbol;
size:=ppufile.getlongint;
is_global:=boolean(ppufile.getbyte);
end;
procedure tai_datablock.write(ppufile:tcompilerppufile);
begin
ppufile.putasmsymbol(sym);
ppufile.putlongint(size);
ppufile.putbyte(byte(is_global));
ppufile.writeentry(ibtaidatablock);
end;
procedure tai_datablock.derefobjectdata;
begin
objectlibrary.DerefAsmsymbol(sym);
end;
{****************************************************************************
TAI_SYMBOL
****************************************************************************}
@ -433,6 +531,30 @@ uses
end;
constructor tai_symbol.load(ppufile:tcompilerppufile);
begin
inherited Create;
sym:=ppufile.getasmsymbol;
size:=ppufile.getlongint;
is_global:=boolean(ppufile.getbyte);
end;
procedure tai_symbol.write(ppufile:tcompilerppufile);
begin
ppufile.putasmsymbol(sym);
ppufile.putlongint(size);
ppufile.putbyte(byte(is_global));
ppufile.writeentry(ibtaisymbol);
end;
procedure tai_symbol.derefobjectdata;
begin
objectlibrary.DerefAsmsymbol(sym);
end;
{****************************************************************************
TAI_SYMBOL
****************************************************************************}
@ -451,6 +573,25 @@ uses
sym:=objectlibrary.newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
end;
constructor tai_symbol_end.load(ppufile:tcompilerppufile);
begin
inherited Create;
sym:=ppufile.getasmsymbol;
end;
procedure tai_symbol_end.write(ppufile:tcompilerppufile);
begin
ppufile.putasmsymbol(sym);
ppufile.writeentry(ibtaisymbol);
end;
procedure tai_symbol_end.derefobjectdata;
begin
objectlibrary.DerefAsmsymbol(sym);
end;
{****************************************************************************
TAI_CONST
@ -481,6 +622,27 @@ uses
end;
constructor tai_const.load(ppufile:tcompilerppufile);
begin
inherited Create;
value:=ppufile.getlongint;
end;
procedure tai_const.write(ppufile:tcompilerppufile);
begin
ppufile.putlongint(value);
case typ of
ait_const_8bit :
ppufile.writeentry(ibtaiconst_8bit);
ait_const_16bit :
ppufile.writeentry(ibtaiconst_16bit);
ait_const_32bit :
ppufile.writeentry(ibtaiconst_32bit);
end;
end;
{****************************************************************************
TAI_CONST_SYMBOL_OFFSET
****************************************************************************}
@ -546,6 +708,34 @@ uses
end;
constructor tai_const_symbol.load(ppufile:tcompilerppufile);
begin
inherited Create;
sym:=ppufile.getasmsymbol;
offset:=ppufile.getlongint;
end;
procedure tai_const_symbol.write(ppufile:tcompilerppufile);
begin
ppufile.putasmsymbol(sym);
ppufile.putlongint(offset);
case typ of
ait_const_symbol :
ppufile.writeentry(ibtaiconst_symbol);
ait_const_rva :
ppufile.writeentry(ibtaiconst_rva);
end;
end;
procedure tai_const_symbol.derefobjectdata;
begin
objectlibrary.DerefAsmsymbol(sym);
end;
{****************************************************************************
TAI_real_32bit
****************************************************************************}
@ -558,6 +748,20 @@ uses
value:=_value;
end;
constructor tai_real_32bit.load(ppufile:tcompilerppufile);
begin
inherited Create;
value:=ppufile.getreal;
end;
procedure tai_real_32bit.write(ppufile:tcompilerppufile);
begin
ppufile.putreal(value);
ppufile.writeentry(ibtaireal_32bit);
end;
{****************************************************************************
TAI_real_64bit
****************************************************************************}
@ -570,6 +774,21 @@ uses
value:=_value;
end;
constructor tai_real_64bit.load(ppufile:tcompilerppufile);
begin
inherited Create;
value:=ppufile.getreal;
end;
procedure tai_real_64bit.write(ppufile:tcompilerppufile);
begin
ppufile.putreal(value);
ppufile.writeentry(ibtaireal_64bit);
end;
{****************************************************************************
TAI_real_80bit
****************************************************************************}
@ -582,6 +801,21 @@ uses
value:=_value;
end;
constructor tai_real_80bit.load(ppufile:tcompilerppufile);
begin
inherited Create;
value:=ppufile.getreal;
end;
procedure tai_real_80bit.write(ppufile:tcompilerppufile);
begin
ppufile.putreal(value);
ppufile.writeentry(ibtaireal_80bit);
end;
{****************************************************************************
Tai_comp_64bit
****************************************************************************}
@ -595,6 +829,20 @@ uses
end;
constructor tai_comp_64bit.load(ppufile:tcompilerppufile);
begin
inherited Create;
value:=ppufile.getreal;
end;
procedure tai_comp_64bit.write(ppufile:tcompilerppufile);
begin
ppufile.putreal(value);
ppufile.writeentry(ibtaicomp_64bit);
end;
{****************************************************************************
TAI_STRING
****************************************************************************}
@ -604,9 +852,9 @@ uses
begin
inherited Create;
typ:=ait_string;
getmem(str,length(_str)+1);
strpcopy(str,_str);
len:=length(_str);
getmem(str,len+1);
strpcopy(str,_str);
end;
constructor tai_string.Create_pchar(_str : pchar);
@ -637,6 +885,24 @@ uses
end;
constructor tai_string.load(ppufile:tcompilerppufile);
begin
inherited Create;
len:=ppufile.getlongint;
getmem(str,len+1);
ppufile.getdata(str^,len);
str[len]:=#0;
end;
procedure tai_string.write(ppufile:tcompilerppufile);
begin
ppufile.putlongint(len);
ppufile.putdata(str^,len);
ppufile.writeentry(ibtaistring);
end;
{****************************************************************************
TAI_LABEL
****************************************************************************}
@ -651,6 +917,30 @@ uses
end;
constructor tai_label.load(ppufile:tcompilerppufile);
begin
inherited Create;
l:=tasmlabel(ppufile.getasmsymbol);
l.is_set:=true;
is_global:=boolean(ppufile.getbyte);
end;
procedure tai_label.write(ppufile:tcompilerppufile);
begin
ppufile.putasmsymbol(l);
ppufile.putbyte(byte(is_global));
ppufile.writeentry(ibtailabel);
end;
procedure tai_label.derefobjectdata;
begin
objectlibrary.DerefAsmsymbol(l);
end;
{****************************************************************************
TAI_DIRECT
****************************************************************************}
@ -670,6 +960,28 @@ uses
inherited Destroy;
end;
constructor tai_direct.load(ppufile:tcompilerppufile);
var
len : longint;
begin
inherited Create;
len:=ppufile.getlongint;
getmem(str,len+1);
ppufile.getdata(str^,len);
str[len]:=#0;
end;
procedure tai_direct.write(ppufile:tcompilerppufile);
var
len : longint;
begin
len:=strlen(str);
ppufile.putlongint(len);
ppufile.putdata(str^,len);
ppufile.writeentry(ibtaidirect);
end;
{****************************************************************************
TAI_ASM_COMMENT comment to be inserted in the assembler file
****************************************************************************}
@ -689,6 +1001,29 @@ uses
inherited Destroy;
end;
constructor tai_asm_comment.load(ppufile:tcompilerppufile);
var
len : longint;
begin
inherited Create;
len:=ppufile.getlongint;
getmem(str,len+1);
ppufile.getdata(str^,len);
str[len]:=#0;
end;
procedure tai_asm_comment.write(ppufile:tcompilerppufile);
var
len : longint;
begin
len:=strlen(str);
ppufile.putlongint(len);
ppufile.putdata(str^,len);
ppufile.writeentry(ibtaicomment);
end;
{****************************************************************************
TAI_CUT
****************************************************************************}
@ -717,6 +1052,20 @@ uses
end;
constructor tai_cut.load(ppufile:tcompilerppufile);
begin
inherited Create;
place:=TCutPlace(ppufile.getbyte);
end;
procedure tai_cut.write(ppufile:tcompilerppufile);
begin
ppufile.putbyte(byte(place));
ppufile.writeentry(ibtaicut);
end;
{****************************************************************************
Tai_Marker
****************************************************************************}
@ -728,6 +1077,21 @@ uses
Kind := _Kind;
End;
constructor Tai_Marker.load(ppufile:tcompilerppufile);
begin
inherited Create;
kind:=TMarker(ppufile.getbyte);
end;
procedure Tai_Marker.write(ppufile:tcompilerppufile);
begin
ppufile.putbyte(byte(kind));
ppufile.writeentry(ibtaimarker);
end;
{*****************************************************************************
tai_tempalloc
*****************************************************************************}
@ -751,6 +1115,25 @@ uses
tempsize:=size;
end;
constructor tai_tempalloc.load(ppufile:tcompilerppufile);
begin
inherited Create;
temppos:=ppufile.getlongint;
tempsize:=ppufile.getlongint;
allocation:=boolean(ppufile.getbyte);
end;
procedure tai_tempalloc.write(ppufile:tcompilerppufile);
begin
ppufile.putlongint(temppos);
ppufile.putlongint(tempsize);
ppufile.putbyte(byte(allocation));
ppufile.writeentry(ibtaitempalloc);
end;
{*****************************************************************************
tai_regalloc
*****************************************************************************}
@ -773,6 +1156,22 @@ uses
end;
constructor tai_regalloc.load(ppufile:tcompilerppufile);
begin
inherited Create;
reg:=tregister(ppufile.getbyte);
allocation:=boolean(ppufile.getbyte);
end;
procedure tai_regalloc.write(ppufile:tcompilerppufile);
begin
ppufile.putbyte(byte(reg));
ppufile.putbyte(byte(allocation));
ppufile.writeentry(ibtairegalloc);
end;
{*****************************************************************************
TaiInstruction
*****************************************************************************}
@ -790,7 +1189,6 @@ uses
end;
destructor taicpu_abstract.Destroy;
var
@ -807,13 +1205,10 @@ uses
end;
{ ---------------------------------------------------------------------
Loading of operands.
---------------------------------------------------------------------}
procedure taicpu_abstract.loadconst(opidx:longint;l:aword);
begin
if opidx>=ops then
@ -828,7 +1223,6 @@ uses
end;
procedure taicpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
begin
if not assigned(s) then
@ -847,7 +1241,6 @@ uses
end;
procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
begin
if opidx>=ops then
@ -871,7 +1264,6 @@ uses
end;
procedure taicpu_abstract.loadreg(opidx:longint;r:tregister);
begin
if opidx>=ops then
@ -886,7 +1278,6 @@ uses
end;
procedure taicpu_abstract.loadoper(opidx:longint;o:toper);
begin
if opidx>=ops then
@ -929,6 +1320,49 @@ uses
getcopy:=p;
end;
constructor taicpu_abstract.load(ppufile:tcompilerppufile);
var
i : integer;
begin
inherited Create;
condition:=tasmcond(ppufile.getbyte);
ops:=ppufile.getbyte;
for i:=1 to ops do
ppuloadoper(ppufile,oper[i-1]);
opcode:=tasmop(ppufile.getword);
{$ifdef i386}
segprefix:=tregister(ppufile.getbyte);
{$endif i386}
is_jmp:=boolean(ppufile.getbyte);
end;
procedure taicpu_abstract.write(ppufile:tcompilerppufile);
var
i : integer;
begin
ppufile.putbyte(byte(condition));
ppufile.putbyte(ops);
for i:=1 to ops do
ppuwriteoper(ppufile,oper[i-1]);
ppufile.putword(word(opcode));
{$ifdef i386}
ppufile.putbyte(byte(segprefix));
{$endif i386}
ppufile.writeentry(ibtaiinstruction);
end;
procedure taicpu_abstract.derefobjectdata;
var
i : integer;
begin
for i:=1 to ops do
ppuderefoper(oper[i-1]);
end;
{****************************************************************************
tai_align_abstract
****************************************************************************}
@ -968,6 +1402,25 @@ uses
end;
constructor tai_align_abstract.load(ppufile:tcompilerppufile);
begin
inherited Create;
aligntype:=ppufile.getbyte;
fillsize:=0;
fillop:=ppufile.getbyte;
use_op:=boolean(ppufile.getbyte);
end;
procedure tai_align_abstract.write(ppufile:tcompilerppufile);
begin
ppufile.putbyte(aligntype);
ppufile.putbyte(fillop);
ppufile.putbyte(byte(use_op));
ppufile.writeentry(ibtaialign);
end;
{*****************************************************************************
TAAsmOutput
*****************************************************************************}
@ -983,7 +1436,10 @@ uses
end.
{
$Log$
Revision 1.4 2002-08-11 14:32:25 peter
Revision 1.5 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.4 2002/08/11 14:32:25 peter
* renamed current_library to objectlibrary
Revision 1.3 2002/08/11 13:24:10 peter

83
compiler/i386/aasmcpu.pas
View File

@ -33,6 +33,7 @@ interface
uses
cclasses,globals,verbose,
cpuinfo,cpubase,
symppu,
aasmbase,aasmtai;
const
@ -180,6 +181,10 @@ interface
function Pass1(offset:longint):longint;virtual;
procedure Pass2(sec:TAsmObjectdata);virtual;
procedure SetOperandOrder(order:TOperandOrder);
protected
procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);override;
procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);override;
procedure ppuderefoper(var o:toper);override;
private
{ next fields are filled in pass1, so pass2 is faster }
insentry : PInsEntry;
@ -681,6 +686,79 @@ implementation
end;
procedure taicpu.ppuloadoper(ppufile:tcompilerppufile;var o:toper);
begin
o.typ:=toptype(ppufile.getbyte);
o.ot:=ppufile.getlongint;
case o.typ of
top_reg :
o.reg:=tregister(ppufile.getbyte);
top_ref :
begin
new(o.ref);
o.ref^.segment:=tregister(ppufile.getbyte);
o.ref^.base:=tregister(ppufile.getbyte);
o.ref^.index:=tregister(ppufile.getbyte);
o.ref^.scalefactor:=ppufile.getbyte;
o.ref^.offset:=ppufile.getlongint;
o.ref^.symbol:=ppufile.getasmsymbol;
o.ref^.offsetfixup:=ppufile.getlongint;
o.ref^.options:=trefoptions(ppufile.getbyte);
end;
top_const :
o.val:=aword(ppufile.getlongint);
top_symbol :
begin
o.sym:=ppufile.getasmsymbol;
o.symofs:=ppufile.getlongint;
end;
end;
end;
procedure taicpu.ppuwriteoper(ppufile:tcompilerppufile;const o:toper);
begin
ppufile.putbyte(byte(o.typ));
ppufile.putlongint(o.ot);
case o.typ of
top_reg :
ppufile.putbyte(byte(o.reg));
top_ref :
begin
ppufile.putbyte(byte(o.ref^.segment));
ppufile.putbyte(byte(o.ref^.base));
ppufile.putbyte(byte(o.ref^.index));
ppufile.putbyte(o.ref^.scalefactor);
ppufile.putlongint(o.ref^.offset);
ppufile.putasmsymbol(o.ref^.symbol);
ppufile.putlongint(o.ref^.offsetfixup);
ppufile.putbyte(byte(o.ref^.options));
end;
top_const :
ppufile.putlongint(longint(o.val));
top_symbol :
begin
ppufile.putasmsymbol(o.sym);
ppufile.putlongint(longint(o.symofs));
end;
end;
end;
procedure taicpu.ppuderefoper(var o:toper);
begin
case o.typ of
top_ref :
begin
if assigned(o.ref^.symbol) then
objectlibrary.derefasmsymbol(o.ref^.symbol);
end;
top_symbol :
objectlibrary.derefasmsymbol(o.sym);
end;
end;
{ This check must be done with the operand in ATT order
i.e.after swapping in the intel reader
but before swapping in the NASM and TASM writers PM }
@ -1796,7 +1874,10 @@ implementation
end.
{
$Log$
Revision 1.3 2002-08-13 18:01:52 carl
Revision 1.4 2002-08-15 19:10:36 peter
* first things tai,tnode storing in ppu
Revision 1.3 2002/08/13 18:01:52 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline

9
compiler/nbas.pas
View File

@ -509,7 +509,7 @@ implementation
constructor ttempcreatenode.create(const _restype: ttype; _size: longint; _persistent: boolean);
begin
inherited create(tempn);
inherited create(tempcreaten);
size := _size;
new(tempinfo);
fillchar(tempinfo^,sizeof(tempinfo^),0);
@ -633,7 +633,7 @@ implementation
constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode);
begin
inherited create(temprefn);
inherited create(tempdeleten);
tempinfo := temp.tempinfo;
release_to_normal := true;
end;
@ -694,7 +694,10 @@ begin
end.
{
$Log$
Revision 1.30 2002-07-20 11:57:53 florian
Revision 1.31 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.30 2002/07/20 11:57:53 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

331
compiler/node.pas
View File

@ -31,7 +31,7 @@ interface
globtype,globals,
cpubase,
aasmbase,
symtype;
symtype,symppu;
type
pconstset = ^tconstset;
@ -44,89 +44,86 @@ interface
{$endif}
tnodetype = (
addn, {Represents the + operator.}
muln, {Represents the * operator.}
subn, {Represents the - operator.}
divn, {Represents the div operator.}
symdifn, {Represents the >< operator.}
modn, {Represents the mod operator.}
assignn, {Represents an assignment.}
loadn, {Represents the use of a variabele.}
rangen, {Represents a range (i.e. 0..9).}
ltn, {Represents the < operator.}
lten, {Represents the <= operator.}
gtn, {Represents the > operator.}
gten, {Represents the >= operator.}
equaln, {Represents the = operator.}
unequaln, {Represents the <> operator.}
inn, {Represents the in operator.}
orn, {Represents the or operator.}
xorn, {Represents the xor operator.}
shrn, {Represents the shr operator.}
shln, {Represents the shl operator.}
slashn, {Represents the / operator.}
andn, {Represents the and operator.}
subscriptn, {??? Field in a record/object?}
derefn, {Dereferences a pointer.}
addrn, {Represents the @ operator.}
doubleaddrn, {Represents the @@ operator.}
ordconstn, {Represents an ordinal value.}
typeconvn, {Represents type-conversion/typecast.}
calln, {Represents a call node.}
callparan, {Represents a parameter.}
realconstn, {Represents a real value.}
unaryminusn, {Represents a sign change (i.e. -2).}
addn, {Represents the + operator}
muln, {Represents the * operator}
subn, {Represents the - operator}
divn, {Represents the div operator}
symdifn, {Represents the >< operator}
modn, {Represents the mod operator}
assignn, {Represents an assignment}
loadn, {Represents the use of a variabele}
rangen, {Represents a range (i.e. 0..9)}
ltn, {Represents the < operator}
lten, {Represents the <= operator}
gtn, {Represents the > operator}
gten, {Represents the >= operator}
equaln, {Represents the = operator}
unequaln, {Represents the <> operator}
inn, {Represents the in operator}
orn, {Represents the or operator}
xorn, {Represents the xor operator}
shrn, {Represents the shr operator}
shln, {Represents the shl operator}
slashn, {Represents the / operator}
andn, {Represents the and operator}
subscriptn, {Field in a record/object}
derefn, {Dereferences a pointer}
addrn, {Represents the @ operator}
doubleaddrn, {Represents the @@ operator}
ordconstn, {Represents an ordinal value}
typeconvn, {Represents type-conversion/typecast}
calln, {Represents a call node}
callparan, {Represents a parameter}
realconstn, {Represents a real value}
unaryminusn, {Represents a sign change (i.e. -2)}
asmn, {Represents an assembler node }
vecn, {Represents array indexing.}
pointerconstn,
stringconstn, {Represents a string constant.}
funcretn, {Represents the function result var.}
selfn, {Represents the self parameter.}
notn, {Represents the not operator.}
inlinen, {Internal procedures (i.e. writeln).}
niln, {Represents the nil pointer.}
vecn, {Represents array indexing}
pointerconstn, {Represents a pointer constant}
stringconstn, {Represents a string constant}
funcretn, {Represents the function result var}
selfn, {Represents the self parameter}
notn, {Represents the not operator}
inlinen, {Internal procedures (i.e. writeln)}
niln, {Represents the nil pointer}
errorn, {This part of the tree could not be
parsed because of a compiler error.}
typen, {A type name. Used for i.e. typeof(obj).}
hnewn, {The new operation, constructor call.}
hdisposen, {The dispose operation with destructor call.}
setelementn, {A set element(s) (i.e. [a,b] and also [a..b]).}
setconstn, {A set constant (i.e. [1,2]).}
blockn, {A block of statements.}
statementn, {One statement in a block of nodes.}
loopn, { used in genloopnode, must be converted }
ifn, {An if statement.}
breakn, {A break statement.}
continuen, {A continue statement.}
(* repeatn, {A repeat until block.}
whilen, {A while do statement.}*)
whilerepeatn, {A while or repeat statement.}
forn, {A for loop.}
exitn, {An exit statement.}
withn, {A with statement.}
casen, {A case statement.}
labeln, {A label.}
goton, {A goto statement.}
tryexceptn, {A try except block.}
raisen, {A raise statement.}
tryfinallyn, {A try finally statement.}
onn, {For an on statement in exception code.}
isn, {Represents the is operator.}
asn, {Represents the as typecast.}
caretn, {Represents the ^ operator.}
failn, {Represents the fail statement.}
parsed because of a compiler error}
typen, {A type name. Used for i.e. typeof(obj)}
hnewn, {The new operation, constructor call}
hdisposen, {The dispose operation with destructor call}
setelementn, {A set element(s) (i.e. [a,b] and also [a..b])}
setconstn, {A set constant (i.e. [1,2])}
blockn, {A block of statements}
statementn, {One statement in a block of nodes}
ifn, {An if statement}
breakn, {A break statement}
continuen, {A continue statement}
whilerepeatn, {A while or repeat statement}
forn, {A for loop}
exitn, {An exit statement}
withn, {A with statement}
casen, {A case statement}
labeln, {A label}
goton, {A goto statement}
tryexceptn, {A try except block}
raisen, {A raise statement}
tryfinallyn, {A try finally statement}
onn, {For an on statement in exception code}
isn, {Represents the is operator}
asn, {Represents the as typecast}
caretn, {Represents the ^ operator}
failn, {Represents the fail statement}
starstarn, {Represents the ** operator exponentiation }
procinlinen, {Procedures that can be inlined }
arrayconstructorn, {Construction node for [...] parsing}
arrayconstructorrangen, {Range element to allow sets in array construction tree}
tempn, { for temps in the result/firstpass }
tempcreaten, { for temps in the result/firstpass }
temprefn, { references to temps }
{ added for optimizations where we cannot suppress }
addoptn,
nothingn,
loadvmtn,
guidconstn,
rttin {Rtti information so they can be accessed in result/firstpass.}
tempdeleten, { for temps in the result/firstpass }
addoptn, { added for optimizations where we cannot suppress }
nothingn, {NOP, Do nothing}
loadvmtn, {Load the address of the VMT of a class/object}
guidconstn, {A GUID COM Interface constant }
rttin {Rtti information so they can be accessed in result/firstpass}
);
const
@ -162,7 +159,7 @@ interface
'calln',
'callparan',
'realconstn',
'umminusn',
'unaryminusn',
'asmn',
'vecn',
'pointerconstn',
@ -180,12 +177,9 @@ interface
'setconstn',
'blockn',
'statementn',
'loopn',
'ifn',
'breakn',
'continuen',
(* 'repeatn',
'whilen',*)
'whilerepeatn',
'forn',
'exitn',
@ -205,8 +199,9 @@ interface
'procinlinen',
'arrayconstructn',
'arrayconstructrangen',
'tempn',
'tempcreaten',
'temprefn',
'tempdeleten',
'addoptn',
'nothingn',
'loadvmtn',
@ -315,15 +310,13 @@ interface
maxfirstpasscount,
firstpasscount : longint;
{$endif extdebug}
{$ifdef TEMPS_NOT_PUSH}
temp_offset: longint;
{$endif TEMPS_NOT_PUSH}
{ list : taasmoutput; }
constructor create(tt : tnodetype);
{ this constructor is only for creating copies of class }
{ the fields are copied by getcopy }
constructor createforcopy;
constructor load(tt : tnodetype;ppufile:tcompilerppufile);
destructor destroy;override;
procedure write(ppufile:tcompilerppufile);virtual;
{ toggles the flag }
procedure toggleflag(f : tnodeflags);
@ -367,19 +360,20 @@ interface
procedure set_tree_filepos(const filepos : tfileposinfo);
end;
tnodeclass = class of tnode;
tnodeclassarray = array[tnodetype] of tnodeclass;
{ this node is the anchestor for all nodes with at least }
{ one child, you have to use it if you want to use }
{ true- and falselabel }
tparentnode = class(tnode)
end;
tnodeclass = class of tnode;
punarynode = ^tunarynode;
tunarynode = class(tparentnode)
tunarynode = class(tnode)
left : tnode;
constructor create(tt : tnodetype;l : tnode);
constructor load(tt:tnodetype;ppufile:tcompilerppufile);
destructor destroy;override;
procedure write(ppufile:tcompilerppufile);override;
procedure concattolist(l : tlinkedlist);override;
function ischild(p : tnode) : boolean;override;
function docompare(p : tnode) : boolean;override;
@ -395,7 +389,9 @@ interface
tbinarynode = class(tunarynode)
right : tnode;
constructor create(tt : tnodetype;l,r : tnode);
constructor load(tt:tnodetype;ppufile:tcompilerppufile);
destructor destroy;override;
procedure write(ppufile:tcompilerppufile);override;
procedure concattolist(l : tlinkedlist);override;
function ischild(p : tnode) : boolean;override;
function docompare(p : tnode) : boolean;override;
@ -408,19 +404,11 @@ interface
{$endif extdebug}
end;
pbinopnode = ^tbinopnode;
tbinopnode = class(tbinarynode)
constructor create(tt : tnodetype;l,r : tnode);virtual;
function docompare(p : tnode) : boolean;override;
end;
{$ifdef EXTDEBUG}
var
writenodeindention : string;
procedure writenode(t:tnode);
{$endif EXTDEBUG}
{$ifdef tempregdebug}
type
pptree = ^tnode;
@ -428,10 +416,59 @@ interface
curptree: pptree;
{$endif tempregdebug}
var
nodeclass : tnodeclassarray;
{$ifdef EXTDEBUG}
writenodeindention : string;
{$endif EXTDEBUG}
function ppuloadnode(ppufile:tcompilerppufile):tnode;
{$ifdef EXTDEBUG}
procedure writenode(t:tnode);
{$endif EXTDEBUG}
implementation
uses
cutils;
cutils,verbose;
{****************************************************************************
Helpers
****************************************************************************}
function ppuloadnode(ppufile:tcompilerppufile):tnode;
var
b : byte;
t : tnodetype;
begin
{ marker }
b:=ppufile.getbyte;
if b<>255 then
internalerror(200208151);
{ load nodetype }
t:=tnodetype(ppufile.getbyte);
if t>high(tnodetype) then
internalerror(200208152);
if not assigned(nodeclass[t]) then
internalerror(200208153);
{ generate node of the correct class }
ppuloadnode:=nodeclass[t].load(t,ppufile);
end;
{$ifdef EXTDEBUG}
procedure writenode(t:tnode);
begin
if assigned(t) then
t.dowrite
else
write(writenodeindention,'nil');
if writenodeindention='' then
writeln;
end;
{$endif EXTDEBUG}
{****************************************************************************
TNODE
@ -466,6 +503,44 @@ implementation
begin
end;
constructor tnode.load(tt : tnodetype;ppufile:tcompilerppufile);
begin
{ tnode fields }
blocktype:=tblock_type(ppufile.getbyte);
ppufile.getposinfo(fileinfo);
ppufile.getsmallset(localswitches);
ppufile.gettype(resulttype);
ppufile.getsmallset(flags);
{ updated by firstpass }
location.loc:=LOC_INVALID;
registers32:=0;
registersfpu:=0;
{$ifdef SUPPORT_MMX}
registersmmx:=0;
{$endif SUPPORT_MMX}
{$ifdef EXTDEBUG}
maxfirstpasscount:=0;
firstpasscount:=0;
{$endif EXTDEBUG}
end;
procedure tnode.write(ppufile:tcompilerppufile);
begin
{ marker, read by ppuloadnode }
ppufile.putbyte($ff);
{ type, read by ppuloadnode }
ppufile.putbyte(byte(nodetype));
{ tnode fields }
ppufile.putbyte(byte(block_type));
ppufile.putposinfo(aktfilepos);
ppufile.putsmallset(localswitches);
ppufile.puttype(resulttype);
ppufile.putsmallset(flags);
end;
procedure tnode.toggleflag(f : tnodeflags);
begin
@ -596,12 +671,28 @@ implementation
left:=l;
end;
constructor tunarynode.load(tt : tnodetype;ppufile:tcompilerppufile);
begin
inherited load(tt,ppufile);
left:=ppuloadnode(ppufile);
end;
destructor tunarynode.destroy;
begin
left.free;
inherited destroy;
end;
procedure tunarynode.write(ppufile:tcompilerppufile);
begin
inherited write(ppufile);
left.write(ppufile);
end;
function tunarynode.docompare(p : tnode) : boolean;
begin
@ -677,12 +768,28 @@ implementation
right:=r
end;
constructor tbinarynode.load(tt : tnodetype;ppufile:tcompilerppufile);
begin
inherited load(tt,ppufile);
right:=ppuloadnode(ppufile);
end;
destructor tbinarynode.destroy;
begin
right.free;
inherited destroy;
end;
procedure tbinarynode.write(ppufile:tcompilerppufile);
begin
inherited write(ppufile);
right.write(ppufile);
end;
procedure tbinarynode.concattolist(l : tlinkedlist);
begin
@ -800,27 +907,13 @@ implementation
end;
{****************************************************************************
WRITENODE
****************************************************************************}
{$ifdef EXTDEBUG}
procedure writenode(t:tnode);
begin
if assigned(t) then
t.dowrite
else
write(writenodeindention,'nil');
if writenodeindention='' then
writeln;
end;
{$endif EXTDEBUG}
end.
{
$Log$
Revision 1.34 2002-08-09 19:15:41 carl
Revision 1.35 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.34 2002/08/09 19:15:41 carl
- removed newcg define
Revision 1.33 2002/07/23 12:34:30 daniel

10
compiler/parser.pas
View File

@ -54,7 +54,7 @@ implementation
{$endif GDB}
comphook,
scanner,scandir,
pbase,ptype,pmodules,cresstr,cpuinfo;
pbase,ptype,psystem,pmodules,cresstr,cpuinfo;
procedure initparser;
@ -95,6 +95,9 @@ implementation
orgpattern:='';
current_scanner:=nil;
{ register all nodes }
registernodes;
{ memory sizes }
if heapsize=0 then
heapsize:=target_info.heapsize;
@ -589,7 +592,10 @@ implementation
end.
{
$Log$
Revision 1.40 2002-08-12 16:46:04 peter
Revision 1.41 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.40 2002/08/12 16:46:04 peter
* tscannerfile is now destroyed in tmodule.reset and current_scanner
is updated accordingly. This removes all the loading and saving of
the old scanner and the invalid flag marking

11
compiler/pass_2.pas
View File

@ -113,12 +113,9 @@ implementation
'setconst', {setconstn}
'blockn', {blockn}
'statement', {statementn}
'nothing-loopn', {loopn}
'ifn', {ifn}
'breakn', {breakn}
'continuen', {continuen}
(* '_while_REPEAT', {repeatn}
'_WHILE_repeat', {whilen}*)
'while_repeat', {whilerepeatn}
'for', {forn}
'exitn', {exitn}
@ -138,8 +135,9 @@ implementation
'procinline', {procinlinen}
'arrayconstruc', {arrayconstructn}
'noth-arrcnstr', {arrayconstructrangen}
'tempn',
'tempcreaten',
'temprefn',
'tempdeleten',
'addoptn',
'nothing-nothg', {nothingn}
'loadvmt', {loadvmtn}
@ -328,7 +326,10 @@ implementation
end.
{
$Log$
Revision 1.33 2002-07-30 20:50:44 florian
Revision 1.34 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.33 2002/07/30 20:50:44 florian
* the code generator knows now if parameters are in registers
Revision 1.32 2002/07/19 11:41:36 daniel

40
compiler/ppu.pas
View File

@ -77,8 +77,6 @@ const
ibendsymtablebrowser = 14;
ibbeginsymtablebrowser = 15;
ibusedmacros = 16;
{implementation/objectdata}
ibasmsymbols = 100;
{syms}
ibtypesym = 20;
ibprocsym = 21;
@ -113,6 +111,39 @@ const
ibansistringdef = 55;
ibwidestringdef = 56;
ibvariantdef = 57;
{implementation/objectdata}
ibasmsymbols = 80;
{tais}
ibtaidirect = 100;
ibtaistring = 101;
ibtailabel = 102;
ibtaicomment = 103;
ibtaiinstruction = 104;
ibtaidatablock = 105;
ibtaisymbol = 106;
ibtaisymbol_end = 107;
ibtaiconst_32bit = 108;
ibtaiconst_16bit = 109;
ibtaiconst_8bit = 110;
ibtaiconst_symbol = 111;
ibtaireal_80bit = 112;
ibtaireal_64bit = 113;
ibtaireal_32bit = 114;
ibtaicomp_64bit = 115;
ibtaialign = 116;
ibtaisection = 117;
ibtaiconst_rva = 118;
ibtaistabn = 119;
ibtaistabs = 120;
ibtaiforce_line = 121;
ibtaifunction_name = 122;
ibtaicut = 123;
ibtairegalloc = 124;
ibtaitempalloc = 125;
ibtaimarker = 126;
{tnodes}
ibnode = 150;
{ unit flags }
uf_init = $1;
uf_finalize = $2;
@ -983,7 +1014,10 @@ end;
end.
{
$Log$
Revision 1.24 2002-08-15 15:09:42 carl
Revision 1.25 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.24 2002/08/15 15:09:42 carl
+ fpu emulation helpers (ppu checking also)
Revision 1.23 2002/08/13 21:40:56 florian

100
compiler/psystem.pas
View File

@ -25,6 +25,7 @@ unit psystem;
{$i fpcdefs.inc}
interface
uses
symbase;
@ -34,13 +35,16 @@ procedure insert_intern_types(p : tsymtable);
procedure readconstdefs;
procedure createconstdefs;
procedure registernodes;
implementation
uses
globals,
globals,globtype,
symconst,symtype,symsym,symdef,symtable,
ninl,globtype;
node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt;
procedure insertinternsyms(p : tsymtable);
{
@ -315,10 +319,100 @@ begin
end;
procedure registernodes;
{
Register all possible nodes in the nodeclass array that
will be used for loading the nodes from a ppu
}
begin
nodeclass[addn]:=caddnode;
nodeclass[muln]:=caddnode;
nodeclass[subn]:=caddnode;
nodeclass[divn]:=cmoddivnode;
nodeclass[symdifn]:=caddnode;
nodeclass[modn]:=cmoddivnode;
nodeclass[assignn]:=cassignmentnode;
nodeclass[loadn]:=cloadnode;
nodeclass[rangen]:=crangenode;
nodeclass[ltn]:=caddnode;
nodeclass[lten]:=caddnode;
nodeclass[gtn]:=caddnode;
nodeclass[gten]:=caddnode;
nodeclass[equaln]:=caddnode;
nodeclass[unequaln]:=caddnode;
nodeclass[inn]:=cinnode;
nodeclass[orn]:=caddnode;
nodeclass[xorn]:=caddnode;
nodeclass[shrn]:=cshlshrnode;
nodeclass[shln]:=cshlshrnode;
nodeclass[slashn]:=caddnode;
nodeclass[andn]:=caddnode;
nodeclass[subscriptn]:=csubscriptnode;
nodeclass[derefn]:=cderefnode;
nodeclass[addrn]:=caddrnode;
nodeclass[doubleaddrn]:=cdoubleaddrnode;
nodeclass[ordconstn]:=cordconstnode;
nodeclass[typeconvn]:=ctypeconvnode;
nodeclass[calln]:=ccallnode;
nodeclass[callparan]:=ccallparanode;
nodeclass[realconstn]:=crealconstnode;
nodeclass[unaryminusn]:=cunaryminusnode;
nodeclass[asmn]:=casmnode;
nodeclass[vecn]:=cvecnode;
nodeclass[pointerconstn]:=cpointerconstnode;
nodeclass[stringconstn]:=cstringconstnode;
nodeclass[funcretn]:=cfuncretnode;
nodeclass[selfn]:=cselfnode;
nodeclass[notn]:=cnotnode;
nodeclass[inlinen]:=cinlinenode;
nodeclass[niln]:=cnilnode;
nodeclass[errorn]:=cerrornode;
nodeclass[typen]:=ctypenode;
nodeclass[hnewn]:=chnewnode;
nodeclass[hdisposen]:=chdisposenode;
nodeclass[setelementn]:=csetelementnode;
nodeclass[setconstn]:=csetconstnode;
nodeclass[blockn]:=cblocknode;
nodeclass[statementn]:=cstatementnode;
nodeclass[ifn]:=cifnode;
nodeclass[breakn]:=cbreaknode;
nodeclass[continuen]:=ccontinuenode;
nodeclass[whilerepeatn]:=cwhilerepeatnode;
nodeclass[forn]:=cfornode;
nodeclass[exitn]:=cexitnode;
nodeclass[withn]:=cwithnode;
nodeclass[casen]:=ccasenode;
nodeclass[labeln]:=clabelnode;
nodeclass[goton]:=cgotonode;
nodeclass[tryexceptn]:=ctryexceptnode;
nodeclass[raisen]:=craisenode;
nodeclass[tryfinallyn]:=ctryfinallynode;
nodeclass[onn]:=connode;
nodeclass[isn]:=cisnode;
nodeclass[asn]:=casnode;
nodeclass[caretn]:=caddnode;
nodeclass[failn]:=cfailnode;
nodeclass[starstarn]:=caddnode;
nodeclass[procinlinen]:=cprocinlinenode;
nodeclass[arrayconstructorn]:=carrayconstructornode;
nodeclass[arrayconstructorrangen]:=carrayconstructorrangenode;
nodeclass[tempcreaten]:=ctempcreatenode;
nodeclass[temprefn]:=ctemprefnode;
nodeclass[tempdeleten]:=ctempdeletenode;
nodeclass[addoptn]:=caddnode;
nodeclass[nothingn]:=cnothingnode;
nodeclass[loadvmtn]:=cloadvmtnode;
nodeclass[guidconstn]:=cguidconstnode;
nodeclass[rttin]:=crttinode;
end;
end.
{
$Log$
Revision 1.35 2002-08-14 19:14:39 carl
Revision 1.36 2002-08-15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.35 2002/08/14 19:14:39 carl
+ fpu emulation support (generic and untested)
Revision 1.34 2002/08/13 18:01:52 carl