* ag386bin updates

+ coff writer
This commit is contained in:
peter 1999-02-25 21:02:16 +00:00
parent d230df984e
commit c8f444b65f
29 changed files with 594 additions and 582 deletions

View File

@ -49,7 +49,6 @@ unit aasm;
ait_const_16bit,
ait_const_8bit,
ait_const_symbol,
ait_const_symbol_offset,
ait_real_64bit,
ait_real_32bit,
ait_real_extended,
@ -71,7 +70,30 @@ unit aasm;
{ never used, makes insertation of new ait_ easier to type }
ait_dummy);
type
tsection=(sec_none,
sec_code,sec_data,sec_bss,
sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata
);
{ asm symbol functions }
type
TAsmsymtype=(AS_NONE,AS_LOCAL,AS_GLOBAL,AS_EXTERNAL);
pasmsymbol = ^tasmsymbol;
tasmsymbol = object(tnamed_object)
idx : longint;
section : tsection;
address,
size : longint;
typ : TAsmsymtype;
constructor init(const s:string);
end;
pasmsymbollist = ^tasmsymbollist;
tasmsymbollist = object(tdictionary)
end;
{ the short name makes typing easier }
pai = ^tai;
tai = object(tlinkedlist_item)
@ -94,11 +116,10 @@ unit aasm;
{ generates a common label }
pai_symbol = ^tai_symbol;
tai_symbol = object(tai)
name : pchar;
sym : pasmsymbol;
is_global : boolean;
constructor init(const _name : string);
constructor init_global(const _name : string);
destructor done;virtual;
end;
{ external types defined for TASM }
@ -110,22 +131,22 @@ unit aasm;
{ generates an symbol which is marked as external }
pai_external = ^tai_external;
tai_external = object(tai)
name : pchar;
sym : pasmsymbol;
exttyp : texternal_typ;
constructor init(const _name : string;exttype : texternal_typ);
destructor done; virtual;
constructor init(_sym:pasmsymbol;exttype : texternal_typ);
end;
{ type for a temporary label test if used for dispose of
unnecessary labels }
plabel = ^tlabel;
tlabel = record
nb : longint;
address : longint;
is_data : boolean;
is_used : boolean;
is_set : boolean;
refcount : word;
nb : longint;
address : longint;
is_data : boolean;
is_used : boolean;
is_set : boolean;
is_symbol : boolean; { if its used as symbol lab2str() }
refcount : word;
end;
pai_label = ^tai_label;
@ -163,32 +184,24 @@ unit aasm;
use_op : boolean;
constructor init(b:byte);
constructor init_op(b: byte; _op: byte);
destructor done;virtual;
end;
tsection=(sec_none,sec_code,sec_data,sec_bss,sec_idata,sec_edata);
{ Insert a section/segment directive }
pai_section = ^tai_section;
tai_section = object(tai)
sec : tsection;
idataidx : longint;
sec : tsection;
constructor init(s : tsection);
constructor init_idata(i:longint);
destructor done;virtual;
end;
{ generates an uninitializised data block }
pai_datablock = ^tai_datablock;
tai_datablock = object(tai)
sym : pasmsymbol;
size : longint;
name : pchar;
is_global : boolean;
constructor init(const _name : string;_size : longint);
constructor init_global(const _name : string;_size : longint);
destructor done; virtual;
end;
@ -199,17 +212,16 @@ unit aasm;
constructor init_32bit(_value : longint);
constructor init_16bit(_value : word);
constructor init_8bit(_value : byte);
constructor init_symbol(p : pchar);
constructor init_rva(p : pchar);
destructor done;virtual;
end;
pai_const_symbol_offset = ^tai_const_symbol_offset;
tai_const_symbol_offset= object(tai)
name : pchar;
pai_const_symbol = ^tai_const_symbol;
tai_const_symbol = object(tai)
sym : pasmsymbol;
address,
offset : longint;
constructor init(p : pchar; l : longint);
destructor done;virtual;
constructor init(const name:string);
constructor init_offset(const name:string;ofs:longint);
constructor init_rva(const name:string);
end;
{ generates a double (64 bit real) }
@ -285,14 +297,13 @@ type
paasmoutput = ^taasmoutput;
taasmoutput = object(tlinkedlist)
function getlasttaifilepos : pfileposinfo;
end;
function getlasttaifilepos : pfileposinfo;
end;
var
{ temporary lists }
exprasmlist,
{ default lists }
datasegment,codesegment,bsssegment,
internals,externals,debuglist,consts,
importssection,exportssection,
@ -303,6 +314,12 @@ type
procedure concat_external(const _name : string;exttype : texternal_typ);
procedure concat_internal(const _name : string;exttype : texternal_typ);
{ asm symbol list }
var
asmsymbollist : pasmsymbollist;
function newasmsymbol(const s : string) : pasmsymbol;
{ label functions }
const
nextlabelnr : longint = 1;
@ -342,28 +359,12 @@ uses
****************************************************************************}
constructor tai_section.init(s : tsection);
begin
inherited init;
typ:=ait_section;
sec:=s;
idataidx:=0;
end;
constructor tai_section.init_idata(i:longint);
begin
inherited init;
typ:=ait_section;
sec:=sec_idata;
idataidx:=i;
end;
destructor tai_section.done;
begin
inherited done;
end;
{****************************************************************************
TAI_DATABLOCK
@ -374,29 +375,23 @@ uses
begin
inherited init;
typ:=ait_datablock;
name:=strpnew(_name);
sym:=newasmsymbol(_name);
concat_internal(_name,EXT_ANY);
size:=_size;
is_global:=false;
end;
constructor tai_datablock.init_global(const _name : string;_size : longint);
constructor tai_datablock.init_global(const _name : string;_size : longint);
begin
inherited init;
typ:=ait_datablock;
name:=strpnew(_name);
sym:=newasmsymbol(_name);
concat_internal(_name,EXT_ANY);
size:=_size;
is_global:=true;
end;
destructor tai_datablock.done;
begin
strdispose(name);
inherited done;
end;
{****************************************************************************
TAI_SYMBOL
@ -407,7 +402,7 @@ uses
begin
inherited init;
typ:=ait_symbol;
name:=strpnew(_name);
sym:=newasmsymbol(_name);
concat_internal(_name,EXT_ANY);
is_global:=false;
end;
@ -417,37 +412,25 @@ uses
begin
inherited init;
typ:=ait_symbol;
name:=strpnew(_name);
sym:=newasmsymbol(_name);
concat_internal(_name,EXT_ANY);
is_global:=true;
end;
destructor tai_symbol.done;
begin
strdispose(name);
inherited done;
end;
{****************************************************************************
TAI_EXTERNAL
****************************************************************************}
constructor tai_external.init(const _name : string;exttype : texternal_typ);
constructor tai_external.init(_sym:pasmsymbol;exttype : texternal_typ);
begin
inherited init;
typ:=ait_external;
exttyp:=exttype;
name:=strpnew(_name);
sym:=_sym;
end;
destructor tai_external.done;
begin
strdispose(name);
inherited done;
end;
{****************************************************************************
TAI_CONST
@ -477,51 +460,36 @@ uses
value:=_value;
end;
constructor tai_const.init_symbol(p : pchar);
begin
inherited init;
typ:=ait_const_symbol;
value:=longint(p);
end;
constructor tai_const.init_rva(p : pchar);
begin
inherited init;
typ:=ait_const_rva;
value:=longint(p);
end;
destructor tai_const.done;
begin
if typ=ait_const_symbol then
strdispose(pchar(value));
inherited done;
end;
{****************************************************************************
TAI_CONST_SYMBOL_OFFSET
****************************************************************************}
constructor tai_const_symbol_offset.init(p : pchar; l : longint);
constructor tai_const_symbol.init(const name:string);
begin
inherited init;
typ:=ait_const_symbol_offset;
name:=p;
offset:=l;
typ:=ait_const_symbol;
sym:=newasmsymbol(name);
offset:=0;
end;
destructor tai_const_symbol_offset.done;
constructor tai_const_symbol.init_offset(const name:string;ofs:longint);
begin
strdispose(name);
inherited done;
inherited init;
typ:=ait_const_symbol;
sym:=newasmsymbol(name);
offset:=ofs;
end;
constructor tai_const_symbol.init_rva(const name:string);
begin
inherited init;
typ:=ait_const_rva;
sym:=newasmsymbol(name);
offset:=0;
end;
{****************************************************************************
TAI_DOUBLE
****************************************************************************}
@ -722,11 +690,6 @@ uses
use_op:=true;
end;
destructor tai_align.done;
begin
inherited done;
end;
{****************************************************************************
TAI_CUT
@ -780,7 +743,7 @@ uses
{ there is probably an error }
if (p^.typ=ait_external) and
((exttype=EXT_ANY) or (pai_external(p)^.exttyp=exttype)) and
(strpas(pai_external(p)^.name)=_name) then
(pai_external(p)^.sym^.name=_name) then
begin
search_assembler_symbol:=pai_external(p);
exit;
@ -790,7 +753,7 @@ uses
if (p<>nil) and
(p^.typ=ait_external) and
(pai_external(p)^.exttyp=exttype) and
(strpas(pai_external(p)^.name)=_name) then
(pai_external(p)^.sym^.name=_name) then
begin
search_assembler_symbol:=pai_external(p);
exit;
@ -801,21 +764,63 @@ uses
{ insert each need external only once }
procedure concat_external(const _name : string;exttype : texternal_typ);
var
hp : pasmsymbol;
begin
if not target_asm.externals then
exit;
{ insert in symbollist }
hp:=newasmsymbol(_name);
{ insert in externals }
if search_assembler_symbol(externals,_name,exttype)=nil then
externals^.concat(new(pai_external,init(_name,exttype)));
externals^.concat(new(pai_external,init(hp,exttype)));
end;
{ insert each need internal only once }
procedure concat_internal(const _name : string;exttype : texternal_typ);
var
hp : pasmsymbol;
begin
if not target_asm.externals then
exit;
{ insert in symbollist }
hp:=newasmsymbol(_name);
{ insert in externals }
if search_assembler_symbol(internals,_name,exttype)=nil then
internals^.concat(new(pai_external,init(_name,exttype)));
internals^.concat(new(pai_external,init(hp,exttype)));
end;
{*****************************************************************************
AsmSymbol
*****************************************************************************}
constructor tasmsymbol.init(const s:string);
begin;
inherited init(s);
idx:=0;
section:=sec_none;
address:=0;
size:=0;
typ:=AS_NONE;
end;
{ generates an help record for constants }
function newasmsymbol(const s : string) : pasmsymbol;
var
hp : pasmsymbol;
begin
hp:=pasmsymbol(asmsymbollist^.search(s));
if assigned(hp) then
begin
newasmsymbol:=hp;
exit;
end;
hp:=new(pasmsymbol,init(s));
asmsymbollist^.insert(hp);
newasmsymbol:=hp;
end;
@ -845,6 +850,7 @@ uses
if countlabelref then
inc(l^.refcount);
{$endif HEAPTRC}
l^.is_symbol:=true;
l^.is_used:=true;
end;
@ -856,6 +862,8 @@ uses
l^.is_used:=false;
l^.is_set:=false;
l^.is_data:=false;
l^.is_symbol:=false;
l^.address:=-1;
l^.refcount:=0;
inc(nextlabelnr);
end;
@ -868,6 +876,8 @@ uses
l^.is_used:=false;
l^.is_set:=false;
l^.is_data:=true;
l^.is_symbol:=false;
l^.address:=-1;
l^.refcount:=0;
inc(nextlabelnr);
end;
@ -889,6 +899,8 @@ uses
is_used:=false;
is_set:=false;
is_data:=false;
is_symbol:=false;
address:=-1;
refcount:=0;
end;
end;
@ -901,6 +913,8 @@ uses
l^.is_used:=false;
l^.is_set:=false;
l^.is_data:=false;
l^.is_symbol:=false;
l^.address:=-1;
l^.refcount:=0;
end;
@ -923,7 +937,11 @@ uses
end.
{
$Log$
Revision 1.30 1999-02-17 10:16:24 peter
Revision 1.31 1999-02-25 21:02:16 peter
* ag386bin updates
+ coff writer
Revision 1.30 1999/02/17 10:16:24 peter
* small fixes for the binary writer
Revision 1.29 1998/12/29 18:48:24 jonas

View File

@ -108,7 +108,7 @@ unit ag386int;
s : string;
first : boolean;
begin
if ref.isintvalue then
if ref.is_immediate then
s:= tostr(ref.offset)
else
with ref do
@ -120,7 +120,7 @@ unit ag386int;
s:='[';
if assigned(symbol) then
begin
s:=s+symbol^;
s:=s+symbol^.name;
first:=false;
end;
if (base<>R_NO) then
@ -150,7 +150,7 @@ unit ag386int;
getreferencestring:=s;
end;
function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
function getopstr(t : byte;o : pointer;opofs:longint;s : topsize; _operator: tasmop;dest : boolean) : string;
var
hs : string;
begin
@ -195,12 +195,12 @@ unit ag386int;
getopstr:=hs;
end;
top_symbol : begin
hs:='offset '+strpas(pchar(pcsymbol(o)^.symbol));
if pcsymbol(o)^.offset>0 then
hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
hs:='offset '+pasmsymbol(o)^.name;
if opofs>0 then
hs:=hs+'+'+tostr(opofs)
else
if pcsymbol(o)^.offset<0 then
hs:=hs+tostr(pcsymbol(o)^.offset);
if opofs<0 then
hs:=hs+tostr(opofs);
getopstr:=hs;
end;
else
@ -208,7 +208,7 @@ unit ag386int;
end;
end;
function getopstr_jmp(t : byte;o : pointer) : string;
function getopstr_jmp(t : byte;o : pointer;opofs:longint) : string;
var
hs : string;
begin
@ -217,12 +217,12 @@ unit ag386int;
top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
top_const : getopstr_jmp:=tostr(longint(o));
top_symbol : begin
hs:=strpas(pchar(pcsymbol(o)^.symbol));
if pcsymbol(o)^.offset>0 then
hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
hs:=pasmsymbol(o)^.name;
if opofs>0 then
hs:=hs+'+'+tostr(opofs)
else
if pcsymbol(o)^.offset<0 then
hs:=hs+tostr(pcsymbol(o)^.offset);
if opofs<0 then
hs:=hs+tostr(opofs);
getopstr_jmp:=hs;
end;
else
@ -243,22 +243,21 @@ unit ag386int;
(#9'DD'#9,#9'DW'#9,#9'DB'#9);
ait_section2masmstr : array[tsection] of string[6]=
('','CODE','DATA','BSS','','');
('','CODE','DATA','BSS','','','','','','');
Function PadTabs(p:pchar;addch:char):string;
Function PadTabs(const p:string;addch:char):string;
var
s : string;
i : longint;
begin
i:=strlen(p);
i:=length(p);
if addch<>#0 then
begin
inc(i);
s:=StrPas(p)+addch;
s:=p+addch;
end
else
s:=StrPas(p);
s:=p;
if i<8 then
PadTabs:=s+#9#9
else
@ -313,12 +312,12 @@ unit ag386int;
{ HERE UNDER TASM! }
AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
end;
ait_external : AsmWriteLn(#9'EXTRN'#9+StrPas(pai_external(hp)^.name)+
ait_external : AsmWriteLn(#9'EXTRN'#9+pai_external(hp)^.sym^.name+
' :'+extstr[pai_external(hp)^.exttyp]);
ait_datablock : begin
if pai_datablock(hp)^.is_global then
AsmWriteLn(#9'PUBLIC'#9+StrPas(pai_datablock(hp)^.name));
AsmWriteLn(PadTabs(pai_datablock(hp)^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
AsmWriteLn(#9'PUBLIC'#9+pai_datablock(hp)^.sym^.name);
AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
end;
ait_const_32bit,
ait_const_8bit,
@ -339,18 +338,15 @@ unit ag386int;
AsmLn;
end;
ait_const_symbol : begin
AsmWrite(#9#9+'DD '#9'offset ');
AsmWritePChar(pchar(pai_const(hp)^.value));
AsmWriteLn(#9#9'DD'#9'offset '+pai_const_symbol(hp)^.sym^.name);
if pai_const_symbol(hp)^.offset>0 then
AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
else if pai_const_symbol(hp)^.offset<0 then
AsmWrite(tostr(pai_const_symbol(hp)^.offset));
AsmLn;
end;
ait_const_symbol_offset : begin
AsmWrite(#9#9+'DD '#9'offset ');
AsmWritePChar(pai_const_symbol_offset(hp)^.name);
if pai_const_symbol_offset(hp)^.offset>0 then
AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
else if pai_const_symbol_offset(hp)^.offset<0 then
AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
AsmLn;
ait_const_rva : begin
AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
end;
ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
@ -436,7 +432,7 @@ unit ag386int;
AsmWrite(lab2str(pai_label(hp)^.l));
if (assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit,
ait_const_symbol,ait_const_symbol_offset,
ait_const_symbol,ait_const_rva,
ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then
AsmWriteLn(':');
end;
@ -448,11 +444,11 @@ unit ag386int;
ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^._operator]+#9+lab2str(pai386_labeled(hp)^.lab));
ait_symbol : begin
if pai_symbol(hp)^.is_global then
AsmWriteLn(#9'PUBLIC'#9+StrPas(pai_symbol(hp)^.name));
AsmWritePChar(pai_symbol(hp)^.name);
AsmWriteLn(#9'PUBLIC'#9+pai_symbol(hp)^.sym^.name);
AsmWrite(pai_symbol(hp)^.sym^.name);
if assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit,
ait_const_symbol,ait_const_symbol_offset,
ait_const_symbol,ait_const_rva,
ait_real_64bit,ait_real_extended,ait_string]) then
AsmWriteLn(':')
end;
@ -492,22 +488,23 @@ ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^._operat
s:='near '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
else
s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);}
s:='dword ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);
s:='dword ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs);
end
else
begin
s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs,pai386(hp)^.size,
pai386(hp)^._operator,false);
if pai386(hp)^.op3t<>top_none then
begin
if pai386(hp)^.op2t<>top_none then
s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),0,
pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),0,
pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
end
else
if pai386(hp)^.op2t<>top_none then
s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,pai386(hp)^.size,
pai386(hp)^._operator,true)+','+s;
end;
s:=#9+s;
@ -624,7 +621,11 @@ ait_stab_function_name : ;
end.
{
$Log$
Revision 1.25 1999-02-22 02:14:59 peter
Revision 1.26 1999-02-25 21:02:18 peter
* ag386bin updates
+ coff writer
Revision 1.25 1999/02/22 02:14:59 peter
* updates for ag386bin
Revision 1.24 1998/12/20 16:21:22 peter

View File

@ -109,7 +109,7 @@ unit ag386nsm;
s : string;
first : boolean;
begin
if ref.isintvalue then
if ref.is_immediate then
s:= tostr(ref.offset)
else
with ref do
@ -121,7 +121,7 @@ unit ag386nsm;
s:='[';
if assigned(symbol) then
begin
s:=s+symbol^;
s:=s+symbol^.name;
first:=false;
end;
if (base<>R_NO) then
@ -151,7 +151,7 @@ unit ag386nsm;
getreferencestring:=s;
end;
function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
function getopstr(t : byte;o : pointer;opofs:longint;s : topsize; _operator: tasmop;dest : boolean) : string;
var
hs : string;
begin
@ -197,13 +197,12 @@ unit ag386nsm;
getopstr:=hs;
end;
top_symbol : begin
hs:=strpas(pchar(pcsymbol(o)^.symbol));
hs:='dword '+hs;
if pcsymbol(o)^.offset>0 then
hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
hs:='dword '+pasmsymbol(o)^.name;
if opofs>0 then
hs:=hs+'+'+tostr(opofs)
else
if pcsymbol(o)^.offset<0 then
hs:=hs+tostr(pcsymbol(o)^.offset);
if opofs<0 then
hs:=hs+tostr(opofs);
getopstr:=hs;
end;
else
@ -211,7 +210,7 @@ unit ag386nsm;
end;
end;
function getopstr_jmp(t : byte;o : pointer) : string;
function getopstr_jmp(t : byte;o : pointer;opofs:longint) : string;
var
hs : string;
begin
@ -220,12 +219,12 @@ unit ag386nsm;
top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
top_const : getopstr_jmp:=tostr(longint(o));
top_symbol : begin
hs:=strpas(pchar(pcsymbol(o)^.symbol));
if pcsymbol(o)^.offset>0 then
hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
hs:=pasmsymbol(o)^.name;
if opofs>0 then
hs:=hs+'+'+tostr(opofs)
else
if pcsymbol(o)^.offset<0 then
hs:=hs+tostr(pcsymbol(o)^.offset);
if opofs<0 then
hs:=hs+tostr(opofs);
getopstr_jmp:=hs;
end;
else
@ -239,28 +238,27 @@ unit ag386nsm;
var
LastSec : tsection;
lastsecidx : longint;
const
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
(#9'DD'#9,#9'DW'#9,#9'DB'#9);
ait_section2nasmstr : array[tsection] of string[6]=
('','.text','.data','.bss','.idata','.edata');
('','.text','.data','.bss','.idata2','.idata4','.idata5','.idata6','.idata7','.edata');
Function PadTabs(p:pchar;addch:char):string;
Function PadTabs(const p:string;addch:char):string;
var
s : string;
i : longint;
begin
i:=strlen(p);
i:=length(p);
if addch<>#0 then
begin
inc(i);
s:=StrPas(p)+addch;
s:=p+addch;
end
else
s:=StrPas(p);
s:=p;
if i<8 then
PadTabs:=s+#9#9
else
@ -308,11 +306,11 @@ unit ag386nsm;
LastSec:=pai_section(hp)^.sec;
end;
ait_align : AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
ait_external : AsmWriteLn('EXTERN '+StrPas(pai_external(hp)^.name));
ait_external : AsmWriteLn('EXTERN '+pai_external(hp)^.sym^.name);
ait_datablock : begin
if pai_datablock(hp)^.is_global then
AsmWriteLn(#9'GLOBAL '+StrPas(pai_datablock(hp)^.name));
AsmWriteLn(PadTabs(pai_datablock(hp)^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
AsmWriteLn(#9'GLOBAL '+pai_datablock(hp)^.sym^.name);
AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
end;
ait_const_32bit,
ait_const_8bit,
@ -333,18 +331,15 @@ unit ag386nsm;
AsmLn;
end;
ait_const_symbol : begin
AsmWrite(#9#9+'DD '#9);
AsmWritePChar(pchar(pai_const(hp)^.value));
AsmWriteLn(#9#9'DD'#9+pai_const_symbol(hp)^.sym^.name);
if pai_const_symbol(hp)^.offset>0 then
AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
else if pai_const_symbol(hp)^.offset<0 then
AsmWrite(tostr(pai_const_symbol(hp)^.offset));
AsmLn;
end;
ait_const_symbol_offset : begin
AsmWrite(#9#9+'DD '#9);
AsmWritePChar(pai_const_symbol_offset(hp)^.name);
if pai_const_symbol_offset(hp)^.offset>0 then
AsmWrite('+'+tostr(pai_const_symbol_offset(hp)^.offset))
else if pai_const_symbol_offset(hp)^.offset<0 then
AsmWrite(tostr(pai_const_symbol_offset(hp)^.offset));
AsmLn;
ait_const_rva : begin
AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
end;
ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
@ -444,11 +439,11 @@ ait_labeled_instruction :
end;
ait_symbol : begin
if pai_symbol(hp)^.is_global then
AsmWriteLn(#9'GLOBAL '+StrPas(pai_symbol(hp)^.name));
AsmWritePChar(pai_symbol(hp)^.name);
AsmWriteLn(#9'GLOBAL '+pai_symbol(hp)^.sym^.name);
AsmWrite(pai_symbol(hp)^.sym^.name);
if assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit,
ait_const_symbol,ait_const_symbol_offset,
ait_const_symbol,ait_const_rva,
ait_real_64bit,ait_string]) then
AsmWriteLn(':')
end;
@ -486,21 +481,22 @@ ait_labeled_instruction :
if pai386(hp)^.op1t<>top_none then
begin
if pai386(hp)^._operator=A_CALL then
s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs)
else
begin
s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.op1ofs,
pai386(hp)^.size,pai386(hp)^._operator,false);
if pai386(hp)^.op3t<>top_none then
begin
if pai386(hp)^.op2t<>top_none then
s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),0,
pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),0,
pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
end
else
if pai386(hp)^.op2t<>top_none then
s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,0,pai386(hp)^.size,
pai386(hp)^._operator,true)+','+s;
end;
s:=#9+s;
@ -556,10 +552,7 @@ ait_stab_function_name : ;
while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
begin
if pai(hp^.next)^.typ=ait_section then
begin
lastsec:=pai_section(hp^.next)^.sec;
lastsecidx:=pai_section(hp^.next)^.idataidx;
end;
lastsec:=pai_section(hp^.next)^.sec;
hp:=pai(hp^.next);
end;
if lastsec<>sec_none then
@ -607,7 +600,11 @@ ait_stab_function_name : ;
end.
{
$Log$
Revision 1.18 1999-02-22 02:15:00 peter
Revision 1.19 1999-02-25 21:02:19 peter
* ag386bin updates
+ coff writer
Revision 1.18 1999/02/22 02:15:00 peter
* updates for ag386bin
Revision 1.17 1998/12/20 16:21:23 peter

View File

@ -468,7 +468,6 @@ implementation
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
p^.location.loc:=LOC_MEM;
stringdispose(p^.location.reference.symbol);
p^.location.reference:=href;
end;
subn,
@ -492,7 +491,6 @@ implementation
ungetiftemp(p^.left^.location.reference);
ungetiftemp(p^.right^.location.reference);
p^.location.loc:=LOC_MEM;
stringdispose(p^.location.reference.symbol);
p^.location.reference:=href;
end;
else
@ -1815,7 +1813,11 @@ implementation
end.
{
$Log$
Revision 1.44 1999-02-22 02:15:02 peter
Revision 1.45 1999-02-25 21:02:20 peter
* ag386bin updates
+ coff writer
Revision 1.44 1999/02/22 02:15:02 peter
* updates for ag386bin
Revision 1.43 1999/02/16 00:46:30 peter

View File

@ -502,8 +502,8 @@ implementation
if assigned(ptree(pwithsymtable(p^.symtable)^.withnode)^.pref) then
begin
r^:=ptree(pwithsymtable(p^.symtable)^.withnode)^.pref^;
if assigned(r^.symbol) then
r^.symbol:=stringdup(r^.symbol^);
{if assigned(r^.symbol) then
r^.symbol:=stringdup(r^.symbol^);}
end
else
{$endif def NODIRECTWITH}
@ -563,9 +563,9 @@ implementation
exprasmlist^.concat(new(pai386,op_const_reg(A_MOV,S_L,0,R_ESI)))
else
begin
exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,S_L,
newcsymbol(pobjectdef(
p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_ESI)));
exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,S_L,
newasmsymbol(pobjectdef(
p^.methodpointer^.resulttype)^.vmt_mangledname),0,R_ESI)));
maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
end;
@ -620,8 +620,8 @@ implementation
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_ESI,R_ESI)));
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
{ insert the vmt }
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
extended_new:=true;
@ -636,8 +636,8 @@ implementation
newreference(p^.methodpointer^.location.reference),R_ESI)));
del_reference(p^.methodpointer^.location.reference);
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_ESI)));
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
newasmsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
end;
@ -705,9 +705,8 @@ implementation
if ((p^.procdefinition^.options and poconstructor)<>0) then
begin
{ it's no bad idea, to insert the VMT }
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,
0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(
pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname))));
maybe_concat_external(pobjectdef(p^.methodpointer^.resulttype)^.owner,
pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname);
end
@ -866,8 +865,8 @@ implementation
{$else TESTOBJEXT}
if (cs_check_range in aktlocalswitches) then
begin
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
newcsymbol(p^.procdefinition^._class^.vmt_mangledname,0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
newasmsymbol(p^.procdefinition^._class^.vmt_mangledname,0))));
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,r^.base)));
emitcall('FPC_CHECK_OBJECT_EXT',true);
end;
@ -978,7 +977,7 @@ implementation
if (p^.resulttype<>pdef(voiddef)) and ret_in_param(p^.resulttype) then
begin
p^.location.loc:=LOC_MEM;
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=nil;
p^.location.reference:=funcretref;
end;
{ we have only to handle the result if it is used, but }
@ -1122,14 +1121,14 @@ implementation
if is_ansistring(p^.resulttype) then
begin
exprasmlist^.concat(new(pai386,
op_csymbol(A_CALL,S_NO,newcsymbol('FPC_ANSISTR_DECR_REF',0))));
op_sym(A_CALL,S_NO,newasmsymbol('FPC_ANSISTR_DECR_REF'))));
if not (cs_compilesystem in aktmoduleswitches) then
concat_external('FPC_ANSISTR_DECR_REF',EXT_NEAR);
end
else
begin
exprasmlist^.concat(new(pai386,
op_csymbol(A_CALL,S_NO,newcsymbol('FPC_WIDESTR_DECR_REF',0))));
op_sym(A_CALL,S_NO,newasmsymbol('FPC_WIDESTR_DECR_REF'))));
if not (cs_compilesystem in aktmoduleswitches) then
concat_external('FPC_WIDESTR_DECR_REF',EXT_NEAR);
end;
@ -1147,7 +1146,7 @@ implementation
{ perhaps i/o check ? }
if iolabel<>nil then
begin
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(lab2str(iolabel)))));
emitcall('FPC_IOCHECK',true);
end;
if pop_size>0 then
@ -1309,7 +1308,11 @@ implementation
end.
{
$Log$
Revision 1.68 1999-02-22 02:15:04 peter
Revision 1.69 1999-02-25 21:02:21 peter
* ag386bin updates
+ coff writer
Revision 1.68 1999/02/22 02:15:04 peter
* updates for ag386bin
Revision 1.67 1999/02/11 09:46:21 pierre

View File

@ -200,7 +200,7 @@ implementation
{ get op and opsize, handle separate for constants, becuase
movz doesn't support constant values }
if (pfrom^.location.loc=LOC_MEM) and (pfrom^.location.reference.isintvalue) then
if (pfrom^.location.loc=LOC_MEM) and (pfrom^.location.reference.is_immediate) then
begin
opsize:=def_opsize(pto^.resulttype);
op:=A_MOV;
@ -314,7 +314,7 @@ implementation
end
else internalerror(6);
hp:=new_reference(R_NO,0);
hp^.symbol:=stringdup(porddef(p1)^.getrangecheckstring);
hp^.symbol:=newasmsymbol(porddef(p1)^.getrangecheckstring);
if porddef(p1)^.low>porddef(p1)^.high then
begin
getlabel(neglabel);
@ -326,7 +326,7 @@ implementation
if porddef(p1)^.low>porddef(p1)^.high then
begin
hp:=new_reference(R_NO,0);
hp^.symbol:=stringdup(porddef(p1)^.getrangecheckstring);
hp^.symbol:=newasmsymbol(porddef(p1)^.getrangecheckstring);
{ second part here !! }
hp^.offset:=8;
emitjmp(C_None,poslabel);
@ -376,13 +376,13 @@ implementation
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
newreference(pto^.location.reference),R_EDI)));
hpp:=new_reference(R_NO,0);
hpp^.symbol:=stringdup(porddef(pfrom^.resulttype)^.getrangecheckstring);
hpp^.symbol:=newasmsymbol(porddef(pfrom^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
{ then we do a normal range check }
porddef(pto^.resulttype)^.genrangecheck;
hpp:=new_reference(R_NO,0);
hpp^.symbol:=stringdup(porddef(pto^.resulttype)^.getrangecheckstring);
hpp^.symbol:=newasmsymbol(porddef(pto^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
end
else
@ -420,7 +420,7 @@ implementation
end
else internalerror(6);
hpp:=new_reference(R_NO,0);
hpp^.symbol:=stringdup(porddef(pto^.resulttype)^.getrangecheckstring);
hpp^.symbol:=newasmsymbol(porddef(pto^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,hregister,hpp)));
(*
if (p^.location.loc=LOC_REGISTER) or
@ -489,7 +489,7 @@ implementation
for the length(string !!!
use only for constant values }
{Constant cannot be loaded into registers using MOVZX!}
if (pfrom^.location.loc<>LOC_MEM) or (not pfrom^.location.reference.isintvalue) then
if (pfrom^.location.loc<>LOC_MEM) or (not pfrom^.location.reference.is_immediate) then
case convtyp of
tc_u8bit_2_s32bit,tc_u8bit_2_u32bit :
begin
@ -604,7 +604,6 @@ implementation
case pstringdef(pfrom^.resulttype)^.string_typ of
st_shortstring:
begin
stringdispose(pto^.location.reference.symbol);
gettempofsizereference(pto^.resulttype^.size,pto^.location.reference);
del_reference(pfrom^.location.reference);
copyshortstring(pto^.location.reference,pfrom^.location.reference,
@ -1344,7 +1343,7 @@ implementation
emitlab(l1);
new(hr);
reset_reference(hr^);
hr^.symbol:=stringdup('FPC_EMPTYCHAR');
hr^.symbol:=newasmsymbol('FPC_EMPTYCHAR');
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,hr,
pto^.location.register)));
emitlab(l2);
@ -1359,7 +1358,6 @@ implementation
st_shortstring:
begin
pushusedregisters(pushed,$ff);
stringdispose(pto^.location.reference.symbol);
gettempofsizereference(pto^.resulttype^.size,pto^.location.reference);
case pfrom^.location.loc of
LOC_REGISTER,LOC_CREGISTER:
@ -1380,7 +1378,6 @@ implementation
end;
st_ansistring:
begin
stringdispose(pto^.location.reference.symbol);
gettempofsizereference(pto^.resulttype^.size,pto^.location.reference);
ltemptoremove^.concat(new(ptemptodestroy,init(pto^.location.reference,pto^.resulttype)));
exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,S_L,0,newreference(pto^.location.reference))));
@ -1623,7 +1620,11 @@ implementation
end.
{
$Log$
Revision 1.57 1999-02-22 02:15:06 peter
Revision 1.58 1999-02-25 21:02:23 peter
* ag386bin updates
+ coff writer
Revision 1.57 1999/02/22 02:15:06 peter
* updates for ag386bin
Revision 1.56 1999/02/15 11:30:39 pierre

View File

@ -105,7 +105,7 @@ implementation
end;
end;
clear_reference(p^.location.reference);
p^.location.reference.symbol:=stringdup(lab2str(p^.lab_real));
p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_real));
p^.location.loc:=LOC_MEM;
end;
@ -118,7 +118,7 @@ implementation
begin
{ an fix comma const. behaves as a memory reference }
p^.location.loc:=LOC_MEM;
p^.location.reference.isintvalue:=true;
p^.location.reference.is_immediate:=true;
p^.location.reference.offset:=p^.value_fix;
end;
@ -131,7 +131,7 @@ implementation
begin
{ an integer const. behaves as a memory reference }
p^.location.loc:=LOC_MEM;
p^.location.reference.isintvalue:=true;
p^.location.reference.is_immediate:=true;
p^.location.reference.offset:=p^.value;
end;
@ -190,7 +190,7 @@ implementation
begin
getdatalabel(l2);
consts^.concat(new(pai_label,init(l2)));
consts^.concat(new(pai_const,init_symbol(strpnew(lab2str(p^.lab_str)))));
consts^.concat(new(pai_const_symbol,init(lab2str(p^.lab_str))));
{ return the offset of the real string }
p^.lab_str:=l2;
end;
@ -221,7 +221,7 @@ implementation
getdatalabel(l1);
getdatalabel(l2);
consts^.concat(new(pai_label,init(l2)));
consts^.concat(new(pai_const,init_symbol(strpnew(lab2str(l1)))));
consts^.concat(new(pai_const_symbol,init(lab2str(l1))));
consts^.concat(new(pai_const,init_32bit(p^.length)));
consts^.concat(new(pai_const,init_32bit(p^.length)));
consts^.concat(new(pai_const,init_32bit(-1)));
@ -262,7 +262,7 @@ implementation
end;
end;
clear_reference(p^.location.reference);
p^.location.reference.symbol:=stringdup(lab2str(p^.lab_str));
p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_str));
p^.location.loc:=LOC_MEM;
end;
@ -283,7 +283,7 @@ implementation
if psetdef(p^.resulttype)^.settype=smallset then
begin
p^.location.loc:=LOC_MEM;
p^.location.reference.isintvalue:=true;
p^.location.reference.is_immediate:=true;
p^.location.reference.offset:=plongint(p^.value_set)^;
exit;
end;
@ -364,7 +364,7 @@ implementation
end;
end;
clear_reference(p^.location.reference);
p^.location.reference.symbol:=stringdup(lab2str(p^.lab_set));
p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_set));
p^.location.loc:=LOC_MEM;
end;
@ -376,7 +376,7 @@ implementation
procedure secondniln(var p : ptree);
begin
p^.location.loc:=LOC_MEM;
p^.location.reference.isintvalue:=true;
p^.location.reference.is_immediate:=true;
p^.location.reference.offset:=0;
end;
@ -384,7 +384,11 @@ implementation
end.
{
$Log$
Revision 1.28 1999-02-22 02:15:08 peter
Revision 1.29 1999-02-25 21:02:25 peter
* ag386bin updates
+ coff writer
Revision 1.28 1999/02/22 02:15:08 peter
* updates for ag386bin
Revision 1.27 1999/01/19 14:21:59 peter

View File

@ -589,7 +589,7 @@ do_jmp:
getlabel(a);
emitlab(a);
exprasmlist^.concat(new(pai386,
op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(a),0))));
op_sym(A_PUSH,S_L,newasmsymbol(lab2str(a)))));
end;
secondpass(p^.left);
if codegenerror then
@ -695,8 +695,8 @@ do_jmp:
getlabel(nextonlabel);
{ push the vmt }
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
newcsymbol(p^.excepttype^.vmt_mangledname,0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,
newasmsymbol(p^.excepttype^.vmt_mangledname))));
maybe_concat_external(p^.excepttype^.owner,
p^.excepttype^.vmt_mangledname);
@ -797,7 +797,11 @@ do_jmp:
end.
{
$Log$
Revision 1.28 1999-02-22 02:15:09 peter
Revision 1.29 1999-02-25 21:02:26 peter
* ag386bin updates
+ coff writer
Revision 1.28 1999/02/22 02:15:09 peter
* updates for ag386bin
Revision 1.27 1999/01/26 11:26:21 pierre

View File

@ -106,8 +106,8 @@ implementation
begin
new(r);
reset_reference(r^);
r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
concat_external(r^.symbol^,EXT_NEAR);
r^.symbol:=newasmsymbol('U_'+upper(target_info.system_unit)+io[byte(doread)]);
concat_external(r^.symbol^.name,EXT_NEAR);
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
end;
@ -409,7 +409,7 @@ implementation
if assigned(iolabel) then
begin
{ registers are saved in the procedure }
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
exprasmlist^.concat(new(pai386,op_sym(A_PUSH,S_L,newasmsymbol(lab2str(iolabel)))));
emitcall('FPC_IOCHECK',true);
end;
{ Freeup all used temps }
@ -672,8 +672,8 @@ implementation
if p^.left^.treetype=typen then
begin
p^.location.register:=getregister32;
exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,
S_L,newasmsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname),0,
p^.location.register)));
end
else
@ -738,7 +738,7 @@ implementation
begin
clear_location(p^.location);
p^.location.loc:=LOC_MEM;
p^.location.reference.isintvalue:=true;
p^.location.reference.is_immediate:=true;
p^.location.reference.offset:=1;
end;
end;
@ -1027,7 +1027,11 @@ implementation
end.
{
$Log$
Revision 1.28 1999-02-22 02:15:11 peter
Revision 1.29 1999-02-25 21:02:27 peter
* ag386bin updates
+ coff writer
Revision 1.28 1999/02/22 02:15:11 peter
* updates for ag386bin
Revision 1.27 1999/02/17 14:21:40 pierre

View File

@ -56,7 +56,7 @@ implementation
symtabletype : tsymtabletype;
i : longint;
hp : preference;
s : pcsymbol;
s : pasmsymbol;
begin
simple_loadn:=true;
reset_reference(p^.location.reference);
@ -64,7 +64,7 @@ implementation
{ this is only for toasm and toaddr }
absolutesym :
begin
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=nil;
if (pabsolutesym(p^.symtableentry)^.abstyp=toaddr) then
begin
if pabsolutesym(p^.symtableentry)^.absseg then
@ -72,7 +72,7 @@ implementation
p^.location.reference.offset:=pabsolutesym(p^.symtableentry)^.address;
end
else
p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
end;
varsym :
@ -81,8 +81,7 @@ implementation
{ C variable }
if (pvarsym(p^.symtableentry)^.var_options and vo_is_C_var)<>0 then
begin
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
end
@ -90,10 +89,9 @@ implementation
else if (pvarsym(p^.symtableentry)^.var_options and vo_is_dll_var)<>0 then
begin
hregister:=getregister32;
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister)));
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=nil;
p^.location.reference.base:=hregister;
if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
@ -148,12 +146,12 @@ implementation
else
case symtabletype of
unitsymtable,globalsymtable,
staticsymtable : begin
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
if symtabletype=unitsymtable then
concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
end;
staticsymtable :
begin
p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
if symtabletype=unitsymtable then
concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
end;
stt_exceptsymtable:
begin
p^.location.reference.base:=procinfo.framepointer;
@ -163,9 +161,7 @@ implementation
begin
if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
begin
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=
stringdup(p^.symtableentry^.mangledname);
p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
end
@ -300,11 +296,9 @@ implementation
end
else
begin
new(s);
s^.symbol:=strpnew(pprocsym(p^.symtableentry)^.definition^.mangledname);
s^.offset:=0;
s:=newasmsymbol(pprocsym(p^.symtableentry)^.definition^.mangledname);
exprasmlist^.concat(new(pai386,op_csymbol_ref(A_MOV,S_L,s,
exprasmlist^.concat(new(pai386,op_sym_ofs_ref(A_MOV,S_L,s,0,
newreference(p^.location.reference))));
maybe_concat_external(p^.symtable,p^.symtableentry^.mangledname);
@ -313,15 +307,13 @@ implementation
else
begin
{!!!!! Be aware, work on virtual methods too }
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
p^.location.reference.symbol:=newasmsymbol(pprocsym(p^.symtableentry)^.definition^.mangledname);
maybe_concat_external(p^.symtable,p^.symtableentry^.mangledname);
end;
end;
typedconstsym :
begin
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
p^.location.reference.symbol:=newasmsymbol(p^.symtableentry^.mangledname);
maybe_concat_external(p^.symtable,p^.symtableentry^.mangledname);
end;
else internalerror(4);
@ -502,12 +494,12 @@ implementation
{ increment source reference counter }
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(p^.right^.resulttype^.get_inittable_label));
r^.symbol:=newasmsymbol(lab2str(p^.right^.resulttype^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
exprasmlist^.concat(new(pai386,
op_csymbol(A_CALL,S_NO,newcsymbol('FPC_ADDREF',0))));
op_sym(A_CALL,S_NO,newasmsymbol('FPC_ADDREF'))));
if not (cs_compilesystem in aktmoduleswitches) then
concat_external('FPC_ADDREF',EXT_NEAR);
@ -515,12 +507,12 @@ implementation
{ decrement destination reference counter }
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(p^.left^.resulttype^.get_inittable_label));
r^.symbol:=newasmsymbol(lab2str(p^.left^.resulttype^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
exprasmlist^.concat(new(pai386,
op_csymbol(A_CALL,S_NO,newcsymbol('FPC_DECREF',0))));
op_sym(A_CALL,S_NO,newasmsymbol('FPC_DECREF'))));
if not(cs_compilesystem in aktmoduleswitches) then
concat_external('FPC_DECREF',EXT_NEAR);
@ -805,7 +797,11 @@ implementation
end.
{
$Log$
Revision 1.44 1999-02-22 02:15:12 peter
Revision 1.45 1999-02-25 21:02:28 peter
* ag386bin updates
+ coff writer
Revision 1.44 1999/02/22 02:15:12 peter
* updates for ag386bin
Revision 1.43 1999/01/27 00:13:54 florian

View File

@ -61,9 +61,11 @@ implementation
procedure secondloadvmt(var p : ptree);
begin
p^.location.register:=getregister32;
exprasmlist^.concat(new(pai386,op_csymbol_reg(A_MOV,
S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
exprasmlist^.concat(new(pai386,op_sym_ofs_reg(A_MOV,
S_L,newasmsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname),0,
p^.location.register)));
maybe_concat_external(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.owner,
pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname);
end;
@ -106,11 +108,10 @@ implementation
begin
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
r^.symbol:=newasmsymbol(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
{ push pointer adress }
emitpushreferenceaddr(exprasmlist,p^.location.reference);
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_INITIALIZE',true);
end;
@ -188,7 +189,7 @@ implementation
begin
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
r^.symbol:=newasmsymbol(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
{ push pointer adress }
case p^.left^.location.loc of
@ -197,7 +198,6 @@ implementation
LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end;
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_FINALIZE',true);
end;
@ -210,7 +210,7 @@ implementation
begin
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
r^.symbol:=newasmsymbol(lab2str(ppointerdef(p^.left^.resulttype)^.definition^.get_inittable_label));
emitpushreferenceaddr(exprasmlist,r^);
{ push pointer adress }
case p^.left^.location.loc of
@ -219,7 +219,6 @@ implementation
LOC_REFERENCE:
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
end;
stringdispose(r^.symbol);
dispose(r);
emitcall('FPC_INITIALIZE',true);
end;
@ -669,7 +668,7 @@ implementation
begin
hp:=new_reference(R_NO,0);
parraydef(p^.left^.resulttype)^.genrangecheck;
hp^.symbol:=stringdup(parraydef(p^.left^.resulttype)^.getrangecheckstring);
hp^.symbol:=newasmsymbol(parraydef(p^.left^.resulttype)^.getrangecheckstring);
exprasmlist^.concat(new(pai386,op_reg_ref(A_BOUND,S_L,ind,hp)));
end
else if (p^.left^.resulttype^.deftype=stringdef) then
@ -729,7 +728,7 @@ implementation
{ the symbol offset is loaded, }
{ so release the symbol name and set symbol }
{ to nil }
stringdispose(p^.location.reference.symbol);
p^.location.reference.symbol:=nil;
p^.location.reference.offset:=0;
calc_emit_mul;
p^.location.reference.base:=p^.location.reference.index;
@ -860,7 +859,11 @@ implementation
end.
{
$Log$
Revision 1.30 1999-02-22 02:15:14 peter
Revision 1.31 1999-02-25 21:02:29 peter
* ag386bin updates
+ coff writer
Revision 1.30 1999/02/22 02:15:14 peter
* updates for ag386bin
Revision 1.29 1999/02/07 22:53:07 florian

View File

@ -225,7 +225,7 @@ implementation
{reset_reference(href);}
getlabel(l);
{href.symbol:=stringdup(lab2str(l));}
{href.symbol:=newasmsymbol(lab2str(l));}
for i:=1 to numparts do
if setparts[i].range then
@ -235,7 +235,7 @@ implementation
{reset_reference(href2);}
getlabel(l2);
{shouldn't it be href2 here ??
href.symbol:=stringdup(lab2str(l2));}
href.symbol:=newasmsymbol(lab2str(l2));}
if setparts[i].start=setparts[i].stop-1 then
begin
case p^.left^.location.loc of
@ -327,7 +327,7 @@ implementation
if ranges then
exprasmlist^.concat(new(pai386,op_none(A_CLC,S_NO)));
{ To compensate for not doing a second pass }
stringdispose(p^.right^.location.reference.symbol);
p^.right^.location.reference.symbol:=nil;
{ Now place the end label }
exprasmlist^.concat(new(pai_label,init(l)));
case p^.left^.location.loc of
@ -390,7 +390,7 @@ implementation
else
begin
del_reference(p^.right^.location.reference);
if p^.right^.location.reference.isintvalue then
if p^.right^.location.reference.is_immediate then
begin
{ We have to load the value into a register because
btl does not accept values only refs or regs (PFV) }
@ -605,11 +605,9 @@ implementation
genitem(t^.less);
{ fill possible hole }
for i:=last+1 to t^._low-1 do
jumpsegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
(elselabel)))));
jumpsegment^.concat(new(pai_const_symbol,init(lab2str(elselabel))));
for i:=t^._low to t^._high do
jumpsegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
(t^.statement)))));
jumpsegment^.concat(new(pai_const_symbol,init(lab2str(t^.statement))));
last:=t^._high;
if assigned(t^.greater) then
genitem(t^.greater);
@ -640,7 +638,7 @@ implementation
end;
new(hr);
reset_reference(hr^);
hr^.symbol:=stringdup(lab2str(table));
hr^.symbol:=newasmsymbol(lab2str(table));
hr^.offset:=(-min_)*4;
hr^.index:=hregister;
hr^.scalefactor:=4;
@ -798,7 +796,11 @@ implementation
end.
{
$Log$
Revision 1.22 1999-02-22 02:15:16 peter
Revision 1.23 1999-02-25 21:02:31 peter
* ag386bin updates
+ coff writer
Revision 1.22 1999/02/22 02:15:16 peter
* updates for ag386bin
Revision 1.21 1999/02/17 10:12:59 peter

View File

@ -1039,8 +1039,8 @@ End;
Function RefsEquivalent(Const R1, R2: TReference; var RegInfo: TRegInfo; OpAct: TOpAction): Boolean;
Begin
If R1.IsIntValue
Then RefsEquivalent := R2.IsIntValue and (R1.Offset = R2.Offset)
If R1.is_immediate
Then RefsEquivalent := R2.is_immediate and (R1.Offset = R2.Offset)
Else If (R1.Offset = R2.Offset) And
RegsEquivalent(R1.Base, R2.Base, RegInfo, OpAct) And
RegsEquivalent(R1.Index, R2.Index, RegInfo, OpAct) And
@ -1048,7 +1048,7 @@ Begin
Then
Begin
If Assigned(R1.Symbol)
Then RefsEquivalent := Assigned(R2.Symbol) And (R1.Symbol^=R2.Symbol^)
Then RefsEquivalent := Assigned(R2.Symbol) And (R1.Symbol=R2.Symbol)
Else RefsEquivalent := Not(Assigned(R2.Symbol));
End
Else RefsEquivalent := False;
@ -1057,15 +1057,15 @@ End;
Function RefsEqual(Const R1, R2: TReference): Boolean;
Begin
If R1.IsIntValue
Then RefsEqual := R2.IsIntValue and (R1.Offset = R2.Offset)
If R1.is_immediate
Then RefsEqual := R2.is_immediate and (R1.Offset = R2.Offset)
Else If (R1.Offset = R2.Offset) And (R1.Base = R2.Base) And
(R1.Index = R2.Index) And (R1.Segment = R2.Segment) And
(R1.ScaleFactor = R2.ScaleFactor)
Then
Begin
If Assigned(R1.Symbol)
Then RefsEqual := Assigned(R2.Symbol) And (R1.Symbol^=R2.Symbol^)
Then RefsEqual := Assigned(R2.Symbol) And (R1.Symbol=R2.Symbol)
Else RefsEqual := Not(Assigned(R2.Symbol));
End
Else RefsEqual := False;
@ -2227,7 +2227,11 @@ End.
{
$Log$
Revision 1.37 1999-02-22 02:15:20 peter
Revision 1.38 1999-02-25 21:02:34 peter
* ag386bin updates
+ coff writer
Revision 1.37 1999/02/22 02:15:20 peter
* updates for ag386bin
Revision 1.36 1999/01/20 17:41:26 jonas

View File

@ -279,6 +279,7 @@ implementation
importssection:=nil;
exportssection:=nil;
resourcesection:=nil;
asmsymbollist:=new(pasmsymbollist,init(true));
end;
@ -300,6 +301,7 @@ implementation
dispose(exportssection,done);
if assigned(resourcesection) then
dispose(resourcesection,done);
dispose(asmsymbollist,done);
end;
@ -364,7 +366,11 @@ end.
{
$Log$
Revision 1.26 1999-02-22 02:15:21 peter
Revision 1.27 1999-02-25 21:02:37 peter
* ag386bin updates
+ coff writer
Revision 1.26 1999/02/22 02:15:21 peter
* updates for ag386bin
Revision 1.25 1999/01/21 22:10:45 peter

View File

@ -262,10 +262,10 @@ unit i386;
treference = record
base,segment,index : tregister;
offset : longint;
symbol : pstring;
symbol : pasmsymbol;
{ a constant is also a treference, this makes the code generator }
{ easier }
isintvalue : boolean;
is_immediate : boolean;
scalefactor : byte;
end;
@ -289,13 +289,6 @@ unit i386;
);
end;
pcsymbol = ^tcsymbol;
tcsymbol = record
symbol : pchar;
offset : longint;
end;
type
{ Only here for easier adaption of the internal assembler }
TAsmCond=(C_None,
@ -405,8 +398,9 @@ unit i386;
tai386 = object(tai)
{ this isn't a proper style, but not very memory expensive }
op1,op2: pointer;
op1,op2 : pointer; { op3 is also used for the csymbol offset }
_operator : tasmop;
op1ofs : longint;
opxt:word;
size:topsize;
constructor op_none(op : tasmop;_size : topsize);
@ -429,7 +423,7 @@ unit i386;
constructor op_const_loc(op : tasmop;_size : topsize;_op1 : longint;_op2 : tlocation);
constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister);
{ this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
{ this is only allowed if _op1 is an int value (_op1^.is_immediate=true) }
constructor op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference);
{
constructor op_ref_loc(op : tasmop;_size : topsize;_op1 : preference;_op2 : tlcation);}
@ -441,10 +435,11 @@ unit i386;
{ so op_csymbol(A_PUSH,S_L,strnew('P')); generates }
{ an instruction which pushes the address of P }
{ to the stack }
constructor op_csymbol(op : tasmop;_size : topsize;_op1 : pcsymbol);
constructor op_csymbol_reg(op : tasmop;_size : topsize;_op1 : pcsymbol;_op2 : tregister);
constructor op_csymbol_ref(op : tasmop;_size : topsize;_op1 : pcsymbol;_op2 : preference);
constructor op_csymbol_loc(op : tasmop;_size : topsize;_op1 : pcsymbol;_op2 : tlocation);
constructor op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol);
constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint);
constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
constructor op_sym_ofs_loc(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tlocation);
{ OUT immediate8 }
constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint);
function op1t:byte;
@ -497,9 +492,6 @@ unit i386;
function reg2str(r : tregister) : string;
{ generates an help record for constants }
function newcsymbol(const s : string;l : longint) : pcsymbol;
const
{ this is for the code generator }
@ -1270,25 +1262,22 @@ unit i386;
procedure disposereference(var r : preference);
begin
if assigned(r^.symbol) then
stringdispose(r^.symbol);
dispose(r);
r:=nil;
end;
function newreference(const r : treference) : preference;
var
p : preference;
begin
new(p);
p^:=r;
if assigned(r.symbol) then
p^.symbol:=stringdup(r.symbol^);
newreference:=p;
end;
function reg8toreg16(reg : tregister) : tregister;
begin
@ -1372,7 +1361,7 @@ unit i386;
segment:=R_DEFAULT_SEG;
offset:=0;
scalefactor:=1;
isintvalue:=false;
is_immediate:=false;
symbol:=nil;
end;
end;
@ -1392,28 +1381,10 @@ unit i386;
procedure clear_reference(var ref : treference);
begin
stringdispose(ref.symbol);
reset_reference(ref);
end;
function newcsymbol(const s : string;l : longint) : pcsymbol;
var
p : pcsymbol;
begin
new(p);
p^.symbol:=strpnew(s);
p^.offset:=l;
newcsymbol:=p;
end;
procedure disposecsymbol(p : pcsymbol);
begin
strdispose(p^.symbol);
dispose(p);
end;
{****************************************************************************
objects for register de/allocation
****************************************************************************}
@ -1485,7 +1456,7 @@ unit i386;
typ:=ait_instruction;
_operator:=op;
size:=_size;
if _op1^.isintvalue then
if _op1^.is_immediate then
begin
opxt:=top_const;
op1:=pointer(_op1^.offset);
@ -1513,7 +1484,7 @@ unit i386;
op1:=pointer(_op1.register);
end
else
if _op1.reference.isintvalue then
if _op1.reference.is_immediate then
begin
opxt:=top_const;
op1:=pointer(_op1.reference.offset);
@ -1568,7 +1539,7 @@ unit i386;
size:=_size;
op1:=pointer(_op1);
if _op2^.isintvalue then
if _op2^.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
@ -1598,7 +1569,7 @@ unit i386;
op2:=pointer(_op2.register);
end
else
if _op2.reference.isintvalue then
if _op2.reference.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2.reference.offset);
@ -1627,7 +1598,7 @@ unit i386;
op1:=pointer(_op1.register);
end
else
if _op1.reference.isintvalue then
if _op1.reference.is_immediate then
begin
opxt:=opxt+top_const;
op1:=pointer(_op1.reference.offset);
@ -1703,7 +1674,7 @@ unit i386;
size:=_size;
op1:=pointer(_op1);
if _op2^.isintvalue then
if _op2^.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
@ -1733,7 +1704,7 @@ unit i386;
op2:=pointer(_op2.register);
end
else
if _op2.reference.isintvalue then
if _op2.reference.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2.reference.offset);
@ -1756,7 +1727,7 @@ unit i386;
size:=_size;
op2:=pointer(_op2);
if _op1^.isintvalue then
if _op1^.is_immediate then
begin
opxt:=opxt+top_const;
op1:=pointer(_op1^.offset);
@ -1778,7 +1749,7 @@ unit i386;
_operator:=op;
size:=_size;
if _op1^.isintvalue then
if _op1^.is_immediate then
begin
opxt:=top_const;
op1:=pointer(_op1^.offset);
@ -1790,7 +1761,7 @@ unit i386;
op1:=pointer(_op1);
end;
if _op2^.isintvalue then
if _op2^.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
@ -1804,7 +1775,7 @@ unit i386;
end;
constructor tai386.op_csymbol(op : tasmop;_size : topsize;_op1 : pcsymbol);
constructor tai386.op_sym(op : tasmop;_size : topsize;_op1 : pasmsymbol);
begin
inherited init;
@ -1815,10 +1786,27 @@ unit i386;
opxt:=top_symbol;
size:=_size;
op1:=pointer(_op1);
op1ofs:=0;
op2:=nil;
end;
constructor tai386.op_csymbol_reg(op : tasmop;_size : topsize;_op1 : pcsymbol;_op2 : tregister);
constructor tai386.op_sym_ofs(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint);
begin
inherited init;
typ:=ait_instruction;
_operator:=op;
if (op=A_CALL) and (use_esp_stackframe) then
Message(cg_e_stackframe_with_esp);
opxt:=top_symbol;
size:=_size;
op1:=pointer(_op1);
op1ofs:=_op1ofs;
op2:=nil;
end;
constructor tai386.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
begin
inherited init;
@ -1827,11 +1815,11 @@ unit i386;
opxt:=Top_symbol+Top_reg shl 4;
size:=_size;
op1:=pointer(_op1);
op1ofs:=_op1ofs;
op2:=pointer(_op2);
end;
constructor tai386.op_csymbol_ref(op : tasmop;_size : topsize;_op1 : pcsymbol;_op2 : preference);
constructor tai386.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
begin
inherited init;
@ -1840,8 +1828,9 @@ unit i386;
opxt:=top_symbol;
size:=_size;
op1:=pointer(_op1);
op1ofs:=_op1ofs;
if _op2^.isintvalue then
if _op2^.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2^.offset);
@ -1855,7 +1844,7 @@ unit i386;
end;
constructor tai386.op_csymbol_loc(op : tasmop;_size : topsize;_op1 : pcsymbol;_op2 : tlocation);
constructor tai386.op_sym_ofs_loc(op : tasmop;_size : topsize;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tlocation);
begin
inherited init;
@ -1864,14 +1853,14 @@ unit i386;
opxt:=top_symbol;
size:=_size;
op1:=pointer(_op1);
op1ofs:=_op1ofs;
if (_op2.loc=loc_register) or (_op2.loc=loc_cregister) then
begin
opxt:=top_reg shl 4;
op2:=pointer(_op2.register);
end
else
if _op2.reference.isintvalue then
if _op2.reference.is_immediate then
begin
opxt:=opxt+top_const shl 4;
op2:=pointer(_op2.reference.offset);
@ -1917,16 +1906,12 @@ unit i386;
destructor tai386.done;
begin
if op1t=top_symbol then
disposecsymbol(pcsymbol(op1))
else if op1t=top_ref then
if op1t=top_ref then
begin
clear_reference(preference(op1)^);
dispose(preference(op1));
end;
if op2t=top_symbol then
disposecsymbol(pcsymbol(op2))
else if op2t=top_ref then
if op2t=top_ref then
begin
clear_reference(preference(op2)^);
dispose(preference(op2));
@ -1992,7 +1977,11 @@ Begin
end.
{
$Log$
Revision 1.35 1999-02-22 02:15:23 peter
Revision 1.36 1999-02-25 21:02:38 peter
* ag386bin updates
+ coff writer
Revision 1.35 1999/02/22 02:15:23 peter
* updates for ag386bin
Revision 1.34 1999/01/26 11:32:14 pierre

View File

@ -164,6 +164,7 @@ unit parser;
oldinternals,
oldexternals,
oldconsts : paasmoutput;
oldasmsymbollist : pasmsymbollist;
{ akt.. things }
oldaktlocalswitches : tlocalswitches;
oldaktmoduleswitches : tmoduleswitches;
@ -217,6 +218,7 @@ unit parser;
oldimports:=importssection;
oldexports:=exportssection;
oldresource:=resourcesection;
oldasmsymbollist:=asmsymbollist;
{ save akt... state }
oldaktlocalswitches:=aktlocalswitches;
oldaktmoduleswitches:=aktmoduleswitches;
@ -383,6 +385,7 @@ unit parser;
exportssection:=oldexports;
resourcesection:=oldresource;
rttilist:=oldrttilist;
asmsymbollist:=oldasmsymbollist;
{ restore symtable state }
refsymtable:=oldrefsymtable;
symtablestack:=oldsymtablestack;
@ -449,7 +452,11 @@ unit parser;
end.
{
$Log$
Revision 1.68 1999-02-02 16:39:41 peter
Revision 1.69 1999-02-25 21:02:40 peter
* ag386bin updates
+ coff writer
Revision 1.68 1999/02/02 16:39:41 peter
* reset c,pattern,orgpattern also at startup
Revision 1.67 1999/01/27 13:05:44 pierre

View File

@ -1484,7 +1484,7 @@ unit pdecl;
intmessagetable:=genintmsgtab(aktclass);
{ table for string messages }
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(strmessagetable)))));
datasegment^.concat(new(pai_const_symbol,init(lab2str(strmessagetable))));
{ interface table }
datasegment^.concat(new(pai_const,init_32bit(0)));
@ -1494,13 +1494,13 @@ unit pdecl;
{ inittable for con-/destruction }
if aktclass^.needs_inittable then
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(aktclass^.get_inittable_label)))))
datasegment^.concat(new(pai_const_symbol,init(lab2str(aktclass^.get_inittable_label))))
else
datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to type info of published section }
if (aktclass^.options and oo_can_have_published)<>0 then
datasegment^.concat(new(pai_const,init_symbol(strpnew(aktclass^.rtti_name))))
datasegment^.concat(new(pai_const_symbol,init(aktclass^.rtti_name)))
else
datasegment^.concat(new(pai_const,init_32bit(0)));
@ -1510,10 +1510,10 @@ unit pdecl;
datasegment^.concat(new(pai_const,init_32bit(0)));
{ pointer to dynamic table }
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(intmessagetable)))));
datasegment^.concat(new(pai_const_symbol,init(lab2str(intmessagetable))));
{ pointer to class name string }
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(classnamelabel)))));
datasegment^.concat(new(pai_const_symbol,init(lab2str(classnamelabel))));
end;
{$ifdef GDB}
{ generate the VMT }
@ -1542,7 +1542,7 @@ unit pdecl;
if assigned(aktclass^.childof) and
((aktclass^.childof^.options and oo_hasvmt)<>0) then
begin
datasegment^.concat(new(pai_const,init_symbol(strpnew(aktclass^.childof^.vmt_mangledname))));
datasegment^.concat(new(pai_const_symbol,init(aktclass^.childof^.vmt_mangledname)));
if aktclass^.childof^.owner^.symtabletype=unitsymtable then
concat_external(aktclass^.childof^.vmt_mangledname,EXT_NEAR);
end
@ -2193,7 +2193,11 @@ unit pdecl;
end.
{
$Log$
Revision 1.100 1999-02-24 00:59:14 peter
Revision 1.101 1999-02-25 21:02:41 peter
* ag386bin updates
+ coff writer
Revision 1.100 1999/02/24 00:59:14 peter
* small updates for ag386bin
Revision 1.99 1999/02/22 23:33:29 florian

View File

@ -194,10 +194,10 @@ unit pmodules;
target_link.binders:=2;
end;
if apptype=at_cui then
datasegment^.concat(new(pai_const,init_symbol(strpnew('_mainCRTStartup'))))
datasegment^.concat(new(pai_const_symbol,init('_mainCRTStartup')))
else
begin
datasegment^.concat(new(pai_const,init_symbol(strpnew('_WinMainCRTStartup'))));
datasegment^.concat(new(pai_const_symbol,init('_WinMainCRTStartup')));
target_link.linkcmd:='--subsystem windows '+target_link.linkcmd;
target_link.bindcmd[2]:='--subsystem windows '+target_link.bindcmd[2];
end;
@ -1247,7 +1247,11 @@ unit pmodules;
end.
{
$Log$
Revision 1.100 1999-02-23 18:29:20 pierre
Revision 1.101 1999-02-25 21:02:43 peter
* ag386bin updates
+ coff writer
Revision 1.100 1999/02/23 18:29:20 pierre
* win32 compilation error fix
+ some work for local browser (not cl=omplete yet)

View File

@ -396,7 +396,7 @@ Begin
New(TmpRef);
TmpRef^.segment := R_DEFAULT_SEG;
TmpRef^.symbol := nil;
TmpRef^.isintvalue := false;
TmpRef^.is_immediate := false;
TmpRef^.offset := 0;
Case Longint(Pai386(p)^.op1) Of
3: Begin
@ -463,7 +463,7 @@ Begin
New(TmpRef);
TmpRef^.segment := R_DEFAULT_SEG;
TmpRef^.symbol := nil;
TmpRef^.isintvalue := false;
TmpRef^.is_immediate := false;
TmpRef^.offset := 0;
TmpRef^.Index := TRegister(twowords(Pai386(p)^.op2).Word1);
TmpRef^.ScaleFactor := 2;
@ -569,7 +569,7 @@ Begin
New(TmpRef);
TmpRef^.segment := R_DEFAULT_SEG;
TmpRef^.symbol := nil;
TmpRef^.isintvalue := false;
TmpRef^.is_immediate := false;
TmpRef^.offset := 0;
TmpRef^.Index := TRegister(twowords(Pai386(p)^.op2).Word1);
If (Pai386(p)^.op3t = Top_Reg)
@ -874,18 +874,8 @@ Begin
If (Pai386(p)^.op2 <> Pai386(hp2)^.op2) Then
Begin
Pai386(hp1)^.opxt := top_ref + top_reg shl 4;
If Assigned(TReference(Pai386(hp1)^.op2^).Symbol)
Then Freemem(TReference(Pai386(hp1)^.op2^).Symbol,
Length(TReference(Pai386(hp1)^.op2^).Symbol^)+1);
Pai386(hp1)^.op1 := Pai386(hp1)^.op2; {move the treference}
TReference(Pai386(hp1)^.op1^) := TReference(Pai386(p)^.op1^);
If Assigned(TReference(Pai386(p)^.op1^).Symbol) Then
Begin
Getmem(TReference(Pai386(hp1)^.op1^).Symbol,
Length(TReference(Pai386(p)^.op1^).Symbol^)+1);
TReference(Pai386(hp1)^.op1^).Symbol^ :=
TReference(Pai386(p)^.op1^).Symbol^;
End;
Pai386(hp1)^.op2 := Pai386(hp2)^.op2;
End
Else
@ -1133,7 +1123,7 @@ Begin
TmpRef^.index := R_NO;
TmpRef^.scalefactor := 1;
TmpRef^.symbol := nil;
TmpRef^.isintvalue := false;
TmpRef^.is_immediate := false;
TmpRef^.offset := 0;
Pai386(p)^.op1 := Pointer(TmpRef);
hp1 := Pai(p^.next);
@ -1175,7 +1165,7 @@ Begin
TmpRef^.index := TRegister(Pai386(p)^.op2);
TmpRef^.scalefactor := 1 shl Longint(Pai386(p)^.op1);
TmpRef^.symbol := nil;
TmpRef^.isintvalue := false;
TmpRef^.is_immediate := false;
TmpRef^.offset := 0;
While TmpBool1 And
GetNextInstruction(p, hp1) And
@ -1259,7 +1249,7 @@ Begin
TmpRef^.index := TRegister(Pai386(p)^.op2);
TmpRef^.scalefactor := 1 shl Longint(Pai386(p)^.op1);
TmpRef^.symbol := nil;
TmpRef^.isintvalue := false;
TmpRef^.is_immediate := false;
TmpRef^.offset := 0;
hp1 := new(Pai386,op_ref_reg(A_LEA,S_L,TmpRef, TRegister(Pai386(p)^.op2)));
hp1^.fileinfo := p^.fileinfo;
@ -1523,7 +1513,7 @@ Begin
(hp1^.typ = ait_labeled_instruction) And
(pai386_labeled(hp1)^._operator = A_JMP) Then
Begin
hp2 := New(Pai386,op_csymbol(A_PUSH,S_L,NewCSymbol(Lab2Str(pai386_labeled(hp1)^.lab),0)));
hp2 := New(Pai386,op_sym(A_PUSH,S_L,NewAsmSymbol(Lab2Str(pai386_labeled(hp1)^.lab))));
hp2^.fileinfo := p^.fileinfo;
InsertLLItem(AsmL, p^.previous, p, hp2);
Pai386(p)^._operator := A_JMP;
@ -1619,7 +1609,11 @@ End.
{
$Log$
Revision 1.37 1999-02-22 02:15:30 peter
Revision 1.38 1999-02-25 21:02:44 peter
* ag386bin updates
+ coff writer
Revision 1.37 1999/02/22 02:15:30 peter
* updates for ag386bin
Revision 1.36 1999/01/04 22:04:15 jonas

View File

@ -209,7 +209,7 @@ unit ptconst;
(p^.treetype<>addrn) then
begin
getdatalabel(ll);
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
datasegment^.concat(new(pai_const_symbol,init(lab2str(ll))));
consts^.concat(new(pai_label,init(ll)));
if p^.treetype=stringconstn then
begin
@ -269,8 +269,7 @@ unit ptconst;
end;
hp:=hp^.left;
end;
datasegment^.concat(new(pai_const_symbol_offset,init(
strpnew(hp^.symtableentry^.mangledname),offset)));
datasegment^.concat(new(pai_const_symbol,init_offset(hp^.symtableentry^.mangledname,offset)));
(*if token=POINT then
begin
offset:=0;
@ -308,8 +307,7 @@ unit ptconst;
begin
if (p^.left^.treetype=typen) then
begin
datasegment^.concat(new(pai_const,init_symbol(
strpnew(pobjectdef(p^.left^.resulttype)^.vmt_mangledname))));
datasegment^.concat(new(pai_const_symbol,init(pobjectdef(p^.left^.resulttype)^.vmt_mangledname)));
if pobjectdef(p^.left^.resulttype)^.owner^.symtabletype=unitsymtable then
concat_external(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,EXT_NEAR);
end
@ -446,7 +444,7 @@ unit ptconst;
else
strlength:=p^.length;
getdatalabel(ll);
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(ll)))));
datasegment^.concat(new(pai_const_symbol,init(lab2str(ll))));
{ first write the maximum size }
consts^.concat(new(pai_const,init_32bit(strlength)));
{ second write the real length }
@ -589,7 +587,7 @@ unit ptconst;
end
else
Message(type_e_mismatch);
datasegment^.concat(new(pai_const,init_symbol(strpnew(pd^.mangledname))));
datasegment^.concat(new(pai_const_symbol,init(pd^.mangledname)));
if pd^.owner^.symtabletype=unitsymtable then
concat_external(pd^.mangledname,EXT_NEAR);
end;
@ -706,7 +704,11 @@ unit ptconst;
end.
{
$Log$
Revision 1.37 1999-02-22 02:44:13 peter
Revision 1.38 1999-02-25 21:02:45 peter
* ag386bin updates
+ coff writer
Revision 1.37 1999/02/22 02:44:13 peter
* ag386bin doesn't use i386.pas anymore
Revision 1.36 1999/02/17 10:15:26 peter

View File

@ -856,10 +856,7 @@ var
begin
{ get symbol name }
{ free the memory before changing the symbol name. }
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,
length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].ref.symbol:=newpasstr(strpas(p^.name));
instr.operands[operandnum].ref.symbol:=newasmsymbol(p^.sym^.name);
case p^.exttyp of
EXT_BYTE : instr.operands[operandnum].size := S_B;
EXT_WORD : instr.operands[operandnum].size := S_W;
@ -892,7 +889,7 @@ var
{ if so then it is considered }
{ as a displacement. }
Begin
if labellist.search(ref.symbol^) <> nil then
if labellist.search(ref.symbol^.name) <> nil then
findtype := ao_disp
else
findtype := ao_mem; { probably a mem ref. }
@ -1152,7 +1149,7 @@ var
(ref.symbol = nil) and
(ref.offset <> 0)) then
Begin
ref.isintvalue := TRUE;
ref.is_immediate := TRUE;
Message(assem_e_const_ref_not_allowed);
end;
opinfo := findtype(operands[i]);
@ -1486,9 +1483,6 @@ var
Begin
if numops =1 then
Begin
if (operands[1].operandtype = OPR_REFERENCE) and
(assigned(operands[1].ref.symbol)) then
Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
operands[1].operandtype := OPR_NONE;
numops := 0;
end;
@ -1499,9 +1493,6 @@ var
{ here we accept XLAT, XLATB and XLAT m8 }
if (numops = 1) or (numops = 0) then
Begin
if (operands[1].operandtype = OPR_REFERENCE) and
(assigned(operands[1].ref.symbol)) then
Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
operands[1].operandtype := OPR_NONE;
numops := 0;
{ always a byte for XLAT }
@ -1548,12 +1539,6 @@ var
Begin
if numops =2 then
Begin
if (operands[2].operandtype = OPR_REFERENCE) and
(assigned(operands[2].ref.symbol)) then
Freemem(operands[2].ref.symbol,length(operands[2].ref.symbol^)+1);
if (operands[1].operandtype = OPR_REFERENCE) and
(assigned(operands[1].ref.symbol)) then
Freemem(operands[1].ref.symbol,length(operands[2].ref.symbol^)+1);
operands[2].operandtype := OPR_NONE;
operands[1].operandtype := OPR_NONE;
numops := 0;
@ -1709,8 +1694,8 @@ var
End;
OPR_SYMBOL:
Begin
p^.concat(new(pai386,op_csymbol(instruc,
instr.stropsize, newcsymbol(instr.operands[1].symbol^,0))));
p^.concat(new(pai386,op_sym(instruc,
instr.stropsize,instr.operands[1].symbol)));
End;
OPR_REFERENCE:
{ now first check suffix ... }
@ -1982,7 +1967,7 @@ var
{ create an temporary reference }
End; {case}
reset_reference(href);
href.symbol:=stringdup(instr.operands[1].symbol^);
href.symbol:=instr.operands[1].symbol;
p^.concat(new(pai386,op_ref_reg(instruc,opsize,
newreference(href),operands[2].reg)));
clear_reference(href);
@ -3707,7 +3692,11 @@ end.
{
$Log$
Revision 1.32 1999-02-22 02:15:34 peter
Revision 1.33 1999-02-25 21:02:47 peter
* ag386bin updates
+ coff writer
Revision 1.32 1999/02/22 02:15:34 peter
* updates for ag386bin
Revision 1.31 1999/01/29 11:24:02 pierre

View File

@ -702,7 +702,7 @@ var
{ if so then it is considered }
{ as a displacement. }
Begin
if labellist.search(ref.symbol^) <> nil then
if labellist.search(ref.symbol^.name) <> nil then
findtype := ao_disp
else
findtype := ao_mem; { probably a mem ref. }
@ -964,7 +964,7 @@ var
(ref.symbol = nil) and
(ref.offset <> 0) then
Begin
ref.isintvalue := TRUE;
ref.is_immediate := TRUE;
Message(assem_e_const_ref_not_allowed);
end;
{$endif Go32v2}
@ -1233,7 +1233,7 @@ var
Begin
if (operands[1].operandtype = OPR_REFERENCE) and
(assigned(operands[1].ref.symbol)) then
Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^.name)+1);
operands[1].operandtype := OPR_NONE;
numops := 0;
end;
@ -1245,9 +1245,6 @@ var
{ here we accept XLAT, XLATB and XLAT m8 }
if (numops = 1) or (numops = 0) then
Begin
if (operands[1].operandtype = OPR_REFERENCE) and
(assigned(operands[1].ref.symbol)) then
Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
operands[1].operandtype := OPR_NONE;
numops := 0;
{ always a byte for XLAT }
@ -1264,12 +1261,6 @@ var
Begin
if numops =2 then
Begin
if (operands[1].operandtype = OPR_REFERENCE) and
(assigned(operands[1].ref.symbol)) then
Freemem(operands[1].ref.symbol,length(operands[1].ref.symbol^)+1);
if (operands[2].operandtype = OPR_REFERENCE) and
(assigned(operands[2].ref.symbol)) then
Freemem(operands[2].ref.symbol,length(operands[1].ref.symbol^)+1);
operands[1].operandtype := OPR_NONE;
operands[2].operandtype := OPR_NONE;
numops := 0;
@ -1435,8 +1426,8 @@ var
end;
End;
OPR_SYMBOL: Begin
p^.concat(new(pai386,op_csymbol(instruc,
instr.stropsize, newcsymbol(instr.operands[1].symbol^,0))));
p^.concat(new(pai386,op_sym(instruc,
instr.stropsize,instr.operands[1].symbol)));
End;
OPR_NONE: Begin
Message(assem_f_internal_error_in_concatopcode);
@ -3473,7 +3464,11 @@ begin
end.
{
$Log$
Revision 1.21 1999-02-22 02:15:37 peter
Revision 1.22 1999-02-25 21:02:50 peter
* ag386bin updates
+ coff writer
Revision 1.21 1999/02/22 02:15:37 peter
* updates for ag386bin
Revision 1.20 1999/01/10 15:37:58 peter

View File

@ -143,7 +143,7 @@ Type
OPR_LABINSTR: (hl: plabel);
{ Register list such as in the movem instruction }
OPR_REGLIST: (list: set of tregister);
OPR_SYMBOL : (symbol:pstring);
OPR_SYMBOL : (symbol:pasmsymbol);
end;
@ -826,18 +826,7 @@ end;
end;
Procedure TInstruction.done;
var
k: integer;
Begin
for k:=1 to numops do
begin
if (operands[k].operandtype=OPR_REFERENCE) and
assigned(operands[k].ref.symbol) then
stringdispose(operands[k].ref.symbol);
if (operands[k].operandtype=OPR_SYMBOL) and
assigned(operands[k].symbol) then
stringdispose(operands[k].symbol);
end;
end;
{*************************************************************************}
@ -1357,9 +1346,7 @@ end;
pvarsym(sym)^.is_valid:=1;
if pvarsym(sym)^.owner^.symtabletype=staticsymtable then
begin
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].ref.symbol:=newpasstr(pvarsym(sym)^.mangledname);
instr.operands[operandnum].ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname);
end
else
begin
@ -1391,9 +1378,7 @@ end;
typedconstsym : begin
{ we always assume in asm statements that }
{ that the variable is valid. }
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].ref.symbol:=newpasstr(pvarsym(sym)^.mangledname);
instr.operands[operandnum].ref.symbol:=newasmsymbol(pvarsym(sym)^.mangledname);
{ the current size is NOT overriden if it already }
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
@ -1432,11 +1417,8 @@ end;
end;
end;
procsym : begin
{ free the memory before changing the symbol name. }
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].operandtype:=OPR_SYMBOL;
instr.operands[operandnum].symbol:=newpasstr(pprocsym(sym)^.definition^.mangledname);
instr.operands[operandnum].symbol:=newasmsymbol(pprocsym(sym)^.definition^.mangledname);
CreateVarInstr := TRUE;
Exit;
end
@ -1505,10 +1487,7 @@ end;
case sym^.typ of
varsym,
typedconstsym : Begin
{ free the memory before changing the symbol name. }
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].ref.symbol:=newpasstr(sym^.mangledname);
instr.operands[operandnum].ref.symbol:=newasmsymbol(sym^.mangledname);
{ the current size is NOT overriden if it already }
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
@ -1567,12 +1546,9 @@ end;
procsym : begin
if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
Message(assem_w_calling_overload_func);
{ free the memory before changing the symbol name. }
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].operandtype:=OPR_SYMBOL;
instr.operands[operandnum].size:=S_L;
instr.operands[operandnum].symbol:=newpasstr(pprocsym(sym)^.definition^.mangledname);
instr.operands[operandnum].symbol:=newasmsymbol(pprocsym(sym)^.definition^.mangledname);
CreateVarInstr := TRUE;
Exit;
end;
@ -1810,7 +1786,11 @@ end;
end.
{
$Log$
Revision 1.4 1999-02-22 02:15:39 peter
Revision 1.5 1999-02-25 21:02:51 peter
* ag386bin updates
+ coff writer
Revision 1.4 1999/02/22 02:15:39 peter
* updates for ag386bin
Revision 1.3 1999/02/16 00:47:28 peter

View File

@ -805,7 +805,7 @@
rttilist^.concat(new(pai_const,init_32bit(min)));
rttilist^.concat(new(pai_const,init_32bit(max)));
if assigned(basedef) then
rttilist^.concat(new(pai_const,init_symbol(strpnew(basedef^.get_rtti_label))))
rttilist^.concat(new(pai_const_symbol,init(basedef^.get_rtti_label)))
else
rttilist^.concat(new(pai_const,init_32bit(0)));
hp:=first;
@ -1463,7 +1463,7 @@
begin
rttilist^.concat(new(pai_const,init_8bit(tkSet)));
rttilist^.concat(new(pai_const,init_8bit(otULong)));
rttilist^.concat(new(pai_const,init_symbol(strpnew(setof^.get_rtti_label))));
rttilist^.concat(new(pai_const_symbol,init(setof^.get_rtti_label)));
end;
@ -1666,7 +1666,7 @@
{ count of elements }
rttilist^.concat(new(pai_const,init_32bit(highrange-lowrange+1)));
{ element type }
rttilist^.concat(new(pai_const,init_symbol(strpnew(definition^.get_rtti_label))));
rttilist^.concat(new(pai_const_symbol,init(definition^.get_rtti_label)));
end;
@ -1882,7 +1882,7 @@
begin
if (sym^.typ=varsym) and pvarsym(sym)^.definition^.needs_inittable then
begin
rttilist^.concat(new(pai_const,init_symbol(strpnew(lab2str(pvarsym(sym)^.definition^.get_inittable_label)))));
rttilist^.concat(new(pai_const_symbol,init(lab2str(pvarsym(sym)^.definition^.get_inittable_label))));
rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
end;
end;
@ -1890,7 +1890,7 @@
procedure write_field_rtti(sym : psym);{$ifndef fpc}far;{$endif}
begin
rttilist^.concat(new(pai_const,init_symbol(strpnew(pvarsym(sym)^.definition^.get_rtti_label))));
rttilist^.concat(new(pai_const_symbol,init(pvarsym(sym)^.definition^.get_rtti_label)));
rttilist^.concat(new(pai_const,init_32bit(pvarsym(sym)^.address)));
end;
@ -2267,7 +2267,7 @@ Const local_symtable_index : longint = $8001;
end;
pdo:=pdo^.childof;
end;
new(parast,loadas(parasymtable));
parast^.next:=localsymtablestack;
localsymtablestack:=parast;
@ -2348,7 +2348,7 @@ Const local_symtable_index : longint = $8001;
end;
pdo:=pdo^.childof;
end;
{ we need TESTLOCALBROWSER para and local symtables
PPU files are then easier to read PM }
if not assigned(parast) then
@ -3210,7 +3210,7 @@ Const local_symtable_index : longint = $8001;
begin
if (pprocdef(def)^.options and povirtualmethod)=0 then
begin
rttilist^.concat(new(pai_const,init_symbol(strpnew(pprocdef(def)^.mangledname))));
rttilist^.concat(new(pai_const_symbol,init(pprocdef(def)^.mangledname)));
typvalue:=1;
end
else
@ -3231,7 +3231,7 @@ Const local_symtable_index : longint = $8001;
proctypesinfo:=0;
if (sym^.typ=propertysym) and ((sym^.properties and sp_published)<>0) then
begin
rttilist^.concat(new(pai_const,init_symbol(strpnew(ppropertysym(sym)^.proptype^.get_rtti_label))));
rttilist^.concat(new(pai_const_symbol,init(ppropertysym(sym)^.proptype^.get_rtti_label)));
writeproc(ppropertysym(sym)^.readaccesssym,ppropertysym(sym)^.readaccessdef,0);
writeproc(ppropertysym(sym)^.writeaccesssym,ppropertysym(sym)^.writeaccessdef,2);
{ isn't it stored ? }
@ -3303,11 +3303,11 @@ Const local_symtable_index : longint = $8001;
rttilist^.concat(new(pai_string,init(name^)));
{ write class type }
rttilist^.concat(new(pai_const,init_symbol(strpnew(vmt_mangledname))));
rttilist^.concat(new(pai_const_symbol,init(vmt_mangledname)));
{ write owner typeinfo }
if assigned(childof) and ((childof^.options and oo_can_have_published)<>0) then
rttilist^.concat(new(pai_const,init_symbol(strpnew(childof^.get_rtti_label))))
rttilist^.concat(new(pai_const_symbol,init(childof^.get_rtti_label)))
else
rttilist^.concat(new(pai_const,init_32bit(0)));
@ -3378,7 +3378,11 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.95 1999-02-23 18:29:23 pierre
Revision 1.96 1999-02-25 21:02:52 peter
* ag386bin updates
+ coff writer
Revision 1.95 1999/02/23 18:29:23 pierre
* win32 compilation error fix
+ some work for local browser (not cl=omplete yet)

View File

@ -529,7 +529,7 @@ implementation
asmbin : '';
asmcmd : '';
externals : true;
labelprefix : '';
labelprefix : 'L';
comment : ''
)
,(
@ -538,7 +538,7 @@ implementation
asmbin : '';
asmcmd : '';
externals : true;
labelprefix : '';
labelprefix : 'L';
comment : ''
)
,(
@ -547,7 +547,7 @@ implementation
asmbin : '';
asmcmd : '';
externals : true;
labelprefix : '';
labelprefix : 'L';
comment : ''
)
{$endif i386}
@ -810,7 +810,11 @@ implementation
exeext : '.exe';
os : os_i386_GO32V2;
link : link_i386_ldgo32v2;
{$ifdef Ag386Bin}
assem : as_i386_coff;
{$else}
assem : as_i386_o;
{$endif}
ar : ar_i386_ar;
res : res_none;
heapsize : 2048*1024;
@ -1342,7 +1346,11 @@ begin
end.
{
$Log$
Revision 1.58 1999-02-24 00:59:16 peter
Revision 1.59 1999-02-25 21:02:53 peter
* ag386bin updates
+ coff writer
Revision 1.58 1999/02/24 00:59:16 peter
* small updates for ag386bin
Revision 1.57 1999/02/22 02:15:42 peter

View File

@ -258,11 +258,10 @@ implementation
procedure del_reference(const ref : treference);
begin
if ref.isintvalue then
if ref.is_immediate then
exit;
ungetregister32(ref.base);
ungetregister32(ref.index);
{ ref.segment:=R_DEFAULT_SEG; }
end;
procedure del_locref(const location : tlocation);
@ -270,7 +269,7 @@ implementation
begin
if (location.loc<>loc_mem) and (location.loc<>loc_reference) then
exit;
if location.reference.isintvalue then
if location.reference.is_immediate then
exit;
ungetregister32(location.reference.base);
ungetregister32(location.reference.index);
@ -374,7 +373,11 @@ begin
end.
{
$Log$
Revision 1.19 1999-02-22 02:15:58 peter
Revision 1.20 1999-02-25 21:02:55 peter
* ag386bin updates
+ coff writer
Revision 1.19 1999/02/22 02:15:58 peter
* updates for ag386bin
Revision 1.18 1999/01/18 16:02:20 pierre

View File

@ -380,10 +380,6 @@ unit tree;
dispose(p^.value_set);
end;
end;
{ reference info }
if (p^.location.loc in [LOC_MEM,LOC_REFERENCE]) and
assigned(p^.location.reference.symbol) then
stringdispose(p^.location.reference.symbol);
{$ifdef extdebug}
if p^.firstpasscount>maxfirstpasscount then
maxfirstpasscount:=p^.firstpasscount;
@ -399,8 +395,6 @@ unit tree;
begin
hp:=getnode;
hp^:=p^;
if assigned(p^.location.reference.symbol) then
hp^.location.reference.symbol:=stringdup(p^.location.reference.symbol^);
case p^.disposetyp of
dt_leftright :
begin
@ -1583,9 +1577,6 @@ unit tree;
procedure clear_location(var loc : tlocation);
begin
if ((loc.loc=LOC_MEM) or (loc.loc=LOC_REFERENCE)) and
assigned(loc.reference.symbol) then
stringdispose(loc.reference.symbol);
loc.loc:=LOC_INVALID;
end;
@ -1593,17 +1584,7 @@ unit tree;
procedure set_location(var destloc,sourceloc : tlocation);
begin
if assigned(destloc.reference.symbol) then
stringdispose(destloc.reference.symbol);
destloc:= sourceloc;
if sourceloc.loc in [LOC_MEM,LOC_REFERENCE] then
begin
if assigned(sourceloc.reference.symbol) then
destloc.reference.symbol:=
stringdup(sourceloc.reference.symbol^);
end
else
destloc.reference.symbol:=nil;
end;
procedure swap_location(var destloc,sourceloc : tlocation);
@ -1688,7 +1669,11 @@ unit tree;
end.
{
$Log$
Revision 1.66 1999-02-22 02:15:59 peter
Revision 1.67 1999-02-25 21:02:56 peter
* ag386bin updates
+ coff writer
Revision 1.66 1999/02/22 02:15:59 peter
* updates for ag386bin
Revision 1.65 1999/02/11 09:46:31 pierre

View File

@ -862,10 +862,8 @@ unit types;
writestrentry(p^.l);
{ write name label }
datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str(p^.nl)))));
datasegment^.concat(new(pai_const,
init_symbol(strpnew(p^.p^.mangledname))));
datasegment^.concat(new(pai_const_symbol,init(lab2str(p^.nl))));
datasegment^.concat(new(pai_const_symbol,init(p^.p^.mangledname)));
maybe_concat_external(p^.p^.owner,p^.p^.mangledname);
if assigned(p^.r) then
@ -931,9 +929,7 @@ unit types;
{ write name label }
datasegment^.concat(new(pai_const,init_32bit(p^.p^.messageinf.i)));
datasegment^.concat(new(pai_const,
init_symbol(strpnew(p^.p^.mangledname))));
datasegment^.concat(new(pai_const_symbol,init(p^.p^.mangledname)));
maybe_concat_external(p^.p^.owner,p^.p^.mangledname);
if assigned(p^.r) then
@ -1250,13 +1246,13 @@ unit types;
if (procdefcoll^.data^.options and poabstractmethod)<>0 then
begin
_class^.options:=_class^.options or oo_is_abstract;
datasegment^.concat(new(pai_const,
init_symbol(strpnew('FPC_ABSTRACTERROR'))));
datasegment^.concat(new(pai_const_symbol,
init('FPC_ABSTRACTERROR')));
end
else
begin
datasegment^.concat(new(pai_const,
init_symbol(strpnew(procdefcoll^.data^.mangledname))));
datasegment^.concat(new(pai_const_symbol,
init(procdefcoll^.data^.mangledname)));
maybe_concat_external(procdefcoll^.data^.owner,
procdefcoll^.data^.mangledname);
end;
@ -1288,7 +1284,11 @@ unit types;
end.
{
$Log$
Revision 1.52 1999-02-24 09:51:44 florian
Revision 1.53 1999-02-25 21:02:57 peter
* ag386bin updates
+ coff writer
Revision 1.52 1999/02/24 09:51:44 florian
* wrong warning fixed, if a non-virtual method was hidden by a virtual
method (repoerted by Matthias Koeppe)

View File

@ -209,36 +209,36 @@ unit win_targ;
getdatalabel(lname);
getlabel(lidata4);
getlabel(lidata5);
importssection^.concat(new(pai_section,init_idata(2)));
importssection^.concat(new(pai_section,init(sec_idata2)));
importssection^.concat(new(pai_label,init(lhead)));
{ pointer to procedure names }
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lidata4)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(lidata4))));
{ two empty entries follow }
importssection^.concat(new(pai_const,init_32bit(0)));
importssection^.concat(new(pai_const,init_32bit(0)));
{ pointer to dll name }
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lname)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(lname))));
{ pointer to fixups }
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lidata5)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(lidata5))));
{ first write the name references }
importssection^.concat(new(pai_section,init_idata(4)));
importssection^.concat(new(pai_section,init(sec_idata4)));
importssection^.concat(new(pai_const,init_32bit(0)));
importssection^.concat(new(pai_label,init(lidata4)));
{ then the addresses and create also the indirect jump }
importssection^.concat(new(pai_section,init_idata(5)));
importssection^.concat(new(pai_section,init(sec_idata5)));
importssection^.concat(new(pai_const,init_32bit(0)));
importssection^.concat(new(pai_label,init(lidata5)));
{ write final section }
importssection^.concat(new(pai_cut,init_end));
{ end of name references }
importssection^.concat(new(pai_section,init_idata(4)));
importssection^.concat(new(pai_section,init(sec_idata4)));
importssection^.concat(new(pai_const,init_32bit(0)));
{ end if addresses }
importssection^.concat(new(pai_section,init_idata(5)));
importssection^.concat(new(pai_section,init(sec_idata5)));
importssection^.concat(new(pai_const,init_32bit(0)));
{ dllname }
importssection^.concat(new(pai_section,init_idata(7)));
importssection^.concat(new(pai_section,init(sec_idata7)));
importssection^.concat(new(pai_label,init(lname)));
importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
@ -254,7 +254,7 @@ unit win_targ;
getlabel(lcode);
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(lcode));
r^.symbol:=newasmsymbol(lab2str(lcode));
{ place jump in codesegment, insert a code section in the
importsection to reduce the amount of .s files (PFV) }
importssection^.concat(new(pai_section,init(sec_code)));
@ -267,24 +267,24 @@ unit win_targ;
importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
end;
{ create head link }
importssection^.concat(new(pai_section,init_idata(7)));
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lhead)))));
importssection^.concat(new(pai_section,init(sec_idata7)));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(lhead))));
{ fixup }
getlabel(plabel(hp2^.lab));
importssection^.concat(new(pai_section,init_idata(4)));
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
importssection^.concat(new(pai_section,init(sec_idata4)));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(hp2^.lab))));
{ add jump field to importsection }
importssection^.concat(new(pai_section,init_idata(5)));
importssection^.concat(new(pai_section,init(sec_idata5)));
if hp2^.is_var then
importssection^.concat(new(pai_symbol,init_global(hp2^.func^)))
else
importssection^.concat(new(pai_label,init(lcode)));
if hp2^.name^<>'' then
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))))
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(hp2^.lab))))
else
importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
{ finally the import information }
importssection^.concat(new(pai_section,init_idata(6)));
importssection^.concat(new(pai_section,init(sec_idata6)));
importssection^.concat(new(pai_label,init(hp2^.lab)));
importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
@ -327,22 +327,22 @@ unit win_targ;
getlabel(l1);
getlabel(l2);
getlabel(l3);
importssection^.concat(new(pai_section,init_idata(2)));
importssection^.concat(new(pai_section,init(sec_idata2)));
{ pointer to procedure names }
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l2)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(l2))));
{ two empty entries follow }
importssection^.concat(new(pai_const,init_32bit(0)));
importssection^.concat(new(pai_const,init_32bit(0)));
{ pointer to dll name }
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l1)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(l1))));
{ pointer to fixups }
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(l3)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(l3))));
{ only create one section for each else it will
create a lot of idata* }
{ first write the name references }
importssection^.concat(new(pai_section,init_idata(4)));
importssection^.concat(new(pai_section,init(sec_idata4)));
importssection^.concat(new(pai_label,init(l2)));
hp2:=pimported_item(hp1^.imported_items^.first);
@ -350,7 +350,7 @@ unit win_targ;
begin
getlabel(plabel(hp2^.lab));
if hp2^.name^<>'' then
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))))
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(hp2^.lab))))
else
importssection^.concat(new(pai_const,init_32bit($80000000 or hp2^.ordnr)));
hp2:=pimported_item(hp2^.next);
@ -359,7 +359,7 @@ unit win_targ;
importssection^.concat(new(pai_const,init_32bit(0)));
{ then the addresses and create also the indirect jump }
importssection^.concat(new(pai_section,init_idata(5)));
importssection^.concat(new(pai_section,init(sec_idata5)));
importssection^.concat(new(pai_label,init(l3)));
hp2:=pimported_item(hp1^.imported_items^.first);
while assigned(hp2) do
@ -370,7 +370,7 @@ unit win_targ;
{ create indirect jump }
new(r);
reset_reference(r^);
r^.symbol:=stringdup(lab2str(l4));
r^.symbol:=newasmsymbol(lab2str(l4));
{ place jump in codesegment }
codesegment^.concat(new(pai_align,init_op(4,$90)));
codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
@ -382,14 +382,14 @@ unit win_targ;
begin
importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
end;
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
importssection^.concat(new(pai_const_symbol,init_rva(lab2str(hp2^.lab))));
hp2:=pimported_item(hp2^.next);
end;
{ finalize the addresses }
importssection^.concat(new(pai_const,init_32bit(0)));
{ finally the import information }
importssection^.concat(new(pai_section,init_idata(6)));
importssection^.concat(new(pai_section,init(sec_idata6)));
hp2:=pimported_item(hp1^.imported_items^.first);
while assigned(hp2) do
begin
@ -401,7 +401,7 @@ unit win_targ;
hp2:=pimported_item(hp2^.next);
end;
{ create import dll name }
importssection^.concat(new(pai_section,init_idata(7)));
importssection^.concat(new(pai_section,init(sec_idata7)));
importssection^.concat(new(pai_label,init(l1)));
importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
@ -545,7 +545,7 @@ unit win_targ;
{ minor version }
exportssection^.concat(new(pai_const,init_16bit(0)));
{ pointer to dll name }
exportssection^.concat(new(pai_const,init_rva(strpnew(lab2str(dll_name_label)))));
exportssection^.concat(new(pai_const_symbol,init_rva(lab2str(dll_name_label))));
{ ordinal base normally set to 1 }
exportssection^.concat(new(pai_const,init_32bit(ordinal_base)));
{ number of entries }
@ -553,11 +553,11 @@ unit win_targ;
{ number of named entries }
exportssection^.concat(new(pai_const,init_32bit(named_entries)));
{ address of export address table }
exportssection^.concat(new(pai_const,init_rva(strpnew(lab2str(export_address_table)))));
exportssection^.concat(new(pai_const_symbol,init_rva(lab2str(export_address_table))));
{ address of name pointer pointers }
exportssection^.concat(new(pai_const,init_rva(strpnew(lab2str(export_name_table_pointers)))));
exportssection^.concat(new(pai_const_symbol,init_rva(lab2str(export_name_table_pointers))));
{ address of ordinal number pointers }
exportssection^.concat(new(pai_const,init_rva(strpnew(lab2str(export_ordinal_table)))));
exportssection^.concat(new(pai_const_symbol,init_rva(lab2str(export_ordinal_table))));
{ the name }
exportssection^.concat(new(pai_label,init(dll_name_label)));
if st='' then
@ -584,7 +584,7 @@ unit win_targ;
if (hp^.options and eo_name)<>0 then
begin
getlabel(name_label);
name_table_pointers^.concat(new(pai_const,init_rva(strpnew(lab2str(name_label)))));
name_table_pointers^.concat(new(pai_const_symbol,init_rva(lab2str(name_label))));
ordinal_table^.concat(new(pai_const,init_16bit(hp^.index-ordinal_base)));
name_table^.concat(new(pai_align,init_op(2,0)));
name_table^.concat(new(pai_label,init(name_label)));
@ -635,8 +635,7 @@ unit win_targ;
address_table^.concat(new(pai_const,init_32bit(0)));
inc(current_index);
end;
address_table^.concat(new(pai_const,init_rva(
strpnew(hp^.sym^.mangledname))));
address_table^.concat(new(pai_const_symbol,init_rva(hp^.sym^.mangledname)));
inc(current_index);
hp:=pexported_item(hp^.next);
end;
@ -700,7 +699,11 @@ unit win_targ;
end.
{
$Log$
Revision 1.20 1999-02-22 02:44:14 peter
Revision 1.21 1999-02-25 21:02:59 peter
* ag386bin updates
+ coff writer
Revision 1.20 1999/02/22 02:44:14 peter
* ag386bin doesn't use i386.pas anymore
Revision 1.19 1998/12/11 00:04:06 peter