paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 13:19:34 +01:00
Code Issues Packages Projects Releases Wiki Activity

* removed R_DEFAULT_SEG

Browse Source 
* uniform float names
This commit is contained in:
peter 1999-05-12 00:19:34 +00:00
parent 38a4f1d577
commit bc903063c1
23 changed files with 334 additions and 268 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

125
compiler/aasm.pas
View File

@ -25,18 +25,11 @@ unit aasm;
interface
uses
systems,cobjects,files,globals;
globtype,systems,cobjects,files,globals;
type
{$ifdef i386}
bestreal = extended;
{$endif}
{$ifdef m68k}
bestreal = real;
{$endif}
pbestreal=^bestreal;
tait = (
ait_none,
ait_string,
ait_label,
ait_direct,
@ -52,7 +45,7 @@ unit aasm;
ait_real_80bit,
ait_real_64bit,
ait_real_32bit,
ait_comp,
ait_comp_64bit,
ait_external,
ait_align,
ait_section,
@ -223,42 +216,33 @@ unit aasm;
constructor init_rva(const name:string);
end;
{ generates a double (64 bit real) }
pai_double = ^tai_double;
tai_double = object(tai)
value : double;
constructor init(_value : double);
end;
{ generates an comp (integer over 64 bits) }
pai_comp = ^tai_comp;
tai_comp = object(tai)
value : bestreal;
constructor init(_value : bestreal);
{$ifdef i386}
{ usefull for 64 bits apps, maybe later }
{ comp is not defined on m68k processors !! }
constructor init_comp(_value : comp);
{$endif i386}
end;
{ generates a single (32 bit real) }
pai_single = ^tai_single;
tai_single = object(tai)
value : single;
constructor init(_value : single);
pai_real_32bit = ^tai_real_32bit;
tai_real_32bit = object(tai)
value : ts32real;
constructor init(_value : ts32real);
end;
{ generates a double (64 bit real) }
pai_real_64bit = ^tai_real_64bit;
tai_real_64bit = object(tai)
value : ts80real;
constructor init(_value : ts64real);
end;
{ generates an extended (80 bit real) }
pai_extended = ^tai_extended;
tai_extended = object(tai)
value : bestreal;
constructor init(_value : bestreal);
pai_real_80bit = ^tai_real_80bit;
tai_real_80bit = object(tai)
value : ts80real;
constructor init(_value : ts80real);
end;
{ generates an comp (integer over 64 bits) }
pai_comp_64bit = ^tai_comp_64bit;
tai_comp_64bit = object(tai)
value : ts64comp;
constructor init(_value : ts64comp);
end;
{ insert a cut to split into several smaller files }
pai_cut = ^tai_cut;
@ -282,15 +266,15 @@ unit aasm;
const
ait_bestreal = ait_real_80bit;
type
pai_bestreal = pai_extended;
tai_bestreal = tai_extended;
pai_bestreal = pai_real_80bit;
tai_bestreal = tai_real_80bit;
{$endif i386}
{$ifdef m68k}
const
ait_bestreal = ait_real_32bit;
type
pai_bestreal = pai_single;
tai_bestreal = tai_single;
pai_bestreal = pai_real_32bit;
tai_bestreal = tai_real_32bit;
{$endif m68k}
@ -345,7 +329,7 @@ type
implementation
uses
strings,verbose,globtype;
strings,verbose;
{****************************************************************************
TAI
@ -494,22 +478,10 @@ uses
{****************************************************************************
TAI_DOUBLE
TAI_real_32bit
****************************************************************************}
constructor tai_double.init(_value : double);
begin
inherited init;
typ:=ait_real_64bit;
value:=_value;
end;
{****************************************************************************
TAI_SINGLE
****************************************************************************}
constructor tai_single.init(_value : single);
constructor tai_real_32bit.init(_value : ts32real);
begin
inherited init;
@ -518,10 +490,22 @@ uses
end;
{****************************************************************************
TAI_EXTENDED
TAI_real_64bit
****************************************************************************}
constructor tai_extended.init(_value : bestreal);
constructor tai_real_64bit.init(_value : ts64real);
begin
inherited init;
typ:=ait_real_64bit;
value:=_value;
end;
{****************************************************************************
TAI_real_80bit
****************************************************************************}
constructor tai_real_80bit.init(_value : ts80real);
begin
inherited init;
@ -530,26 +514,17 @@ uses
end;
{****************************************************************************
TAI_COMP
Tai_comp_64bit
****************************************************************************}
constructor tai_comp.init(_value : bestreal);
constructor tai_comp_64bit.init(_value : ts64comp);
begin
inherited init;
typ:=ait_comp;
typ:=ait_comp_64bit;
value:=_value;
end;
{$ifdef i386}
constructor tai_comp.init_comp(_value : comp);
begin
inherited init;
typ:=ait_comp;
value:=_value;
end;
{$endif i386}
{****************************************************************************
TAI_STRING
@ -1009,7 +984,11 @@ uses
end.
{
$Log$
Revision 1.43 1999-05-08 20:38:02 jonas
Revision 1.44 1999-05-12 00:19:34 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.43 1999/05/08 20:38:02 jonas
* seperate OPTimizer INFO pointer field in tai object
Revision 1.42 1999/05/06 09:05:05 peter

50
compiler/ag386bin.pas
View File

@ -68,9 +68,9 @@ unit ag386bin;
implementation
uses
strings,verbose,
globtype,globals,
i386asm,systems,
strings,
globtype,globals,systems,verbose,
i386asm,
{$ifdef GDB}
gdb,
{$endif}
@ -359,18 +359,14 @@ unit ag386bin;
objectalloc^.sectionalloc(2);
ait_const_8bit :
objectalloc^.sectionalloc(1);
ait_real_80bit :
objectalloc^.sectionalloc(10);
ait_real_64bit :
objectalloc^.sectionalloc(8);
ait_real_32bit :
objectalloc^.sectionalloc(4);
ait_real_80bit :
objectalloc^.sectionalloc(10);
ait_comp :
{$ifdef I386}
ait_comp_64bit :
objectalloc^.sectionalloc(8);
{$else not I386}
Message(asmw_f_comp_not_supported);
{$endif I386}
ait_const_rva,
ait_const_symbol :
objectalloc^.sectionalloc(4);
@ -481,18 +477,14 @@ unit ag386bin;
objectalloc^.sectionalloc(2);
ait_const_8bit :
objectalloc^.sectionalloc(1);
ait_real_80bit :
objectalloc^.sectionalloc(10);
ait_real_64bit :
objectalloc^.sectionalloc(8);
ait_real_32bit :
objectalloc^.sectionalloc(4);
ait_real_80bit :
objectalloc^.sectionalloc(10);
ait_comp :
{$ifdef I386}
ait_comp_64bit :
objectalloc^.sectionalloc(8);
{$else not I386}
Message(asmw_f_comp_not_supported);
{$endif I386}
ait_const_rva,
ait_const_symbol :
objectalloc^.sectionalloc(4);
@ -642,23 +634,21 @@ unit ag386bin;
objectoutput^.writebytes(pai_const(hp)^.value,2);
ait_const_8bit :
objectoutput^.writebytes(pai_const(hp)^.value,1);
ait_real_64bit :
objectoutput^.writebytes(pai_double(hp)^.value,8);
ait_real_32bit :
objectoutput^.writebytes(pai_single(hp)^.value,4);
ait_real_80bit :
objectoutput^.writebytes(pai_extended(hp)^.value,10);
{$ifdef I386}
ait_comp :
objectoutput^.writebytes(pai_real_80bit(hp)^.value,10);
ait_real_64bit :
objectoutput^.writebytes(pai_real_64bit(hp)^.value,8);
ait_real_32bit :
objectoutput^.writebytes(pai_real_32bit(hp)^.value,4);
ait_comp_64bit :
begin
{$ifdef FPC}
co:=comp(pai_comp(hp)^.value);
co:=comp(pai_comp_64bit(hp)^.value);
{$else}
co:=pai_comp(hp)^.value;
co:=pai_comp_64bit(hp)^.value;
{$endif}
objectoutput^.writebytes(co,8);
end;
{$endif I386}
ait_string :
objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
ait_const_rva :
@ -830,7 +820,11 @@ unit ag386bin;
end.
{
$Log$
Revision 1.8 1999-05-09 11:38:04 peter
Revision 1.9 1999-05-12 00:19:37 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.8 1999/05/09 11:38:04 peter
* don't write .o and link if errors occure during assembling
Revision 1.6 1999/05/07 00:36:58 pierre

47
compiler/ag386int.pas
View File

@ -39,13 +39,14 @@ unit ag386int;
implementation
uses
dos,globals,systems,cobjects,
dos,strings,
globtype,globals,systems,cobjects,
files,verbose
{$ifndef OLDASM}
i386base,i386asm,
,i386base,i386asm
{$else}
i386,
,i386
{$endif}
strings,files,verbose
{$ifdef GDB}
,gdb
{$endif GDB}
@ -59,6 +60,22 @@ unit ag386int;
'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
function single2str(d : single) : string;
var
hs : string;
p : byte;
begin
str(d,hs);
{ nasm expects a lowercase e }
p:=pos('E',hs);
if p>0 then
hs[p]:='e';
p:=pos('+',hs);
if p>0 then
delete(hs,p,1);
single2str:=lower(hs);
end;
function double2str(d : double) : string;
var
hs : string;
@ -122,7 +139,7 @@ unit ag386int;
with ref do
begin
first:=true;
if ref.segment<>R_DEFAULT_SEG then
if ref.segment<>R_NO then
s:=int_reg2str[segment]+':['
else
s:='[';
@ -444,10 +461,10 @@ unit ag386int;
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));
ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
ait_string : begin
counter := 0;
lines := pai_string(hp)^.len div line_length;
@ -526,10 +543,10 @@ unit ag386int;
if pai_label(hp)^.l^.is_used then
begin
AsmWrite(lab2str(pai_label(hp)^.l));
if (assigned(hp^.next) and not(pai(hp^.next)^.typ in
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_rva,
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_string])) then
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
AsmWriteLn(':');
end;
end;
@ -547,7 +564,7 @@ ait_labeled_instruction :
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_rva,
ait_real_64bit,ait_real_80bit,ait_string]) then
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
AsmWriteLn(':')
end;
ait_instruction : begin
@ -771,7 +788,11 @@ ait_stab_function_name : ;
end.
{
$Log$
Revision 1.40 1999-05-10 15:18:14 peter
Revision 1.41 1999-05-12 00:19:38 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.40 1999/05/10 15:18:14 peter
* fixed condition writing
Revision 1.39 1999/05/08 19:52:33 peter

43
compiler/ag386nsm.pas
View File

@ -40,13 +40,14 @@ unit ag386nsm;
implementation
uses
dos,globals,systems,cobjects,
dos,strings,
globtype,globals,systems,cobjects,
files,verbose
{$ifndef OLDASM}
i386base,i386asm,
,i386base,i386asm
{$else}
i386,
,i386
{$endif}
strings,files,verbose
{$ifdef GDB}
,gdb
{$endif GDB}
@ -59,6 +60,22 @@ unit ag386nsm;
('NEAR','FAR','PROC','BYTE','WORD','DWORD',
'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
function single2str(d : single) : string;
var
hs : string;
p : byte;
begin
str(d,hs);
{ nasm expects a lowercase e }
p:=pos('E',hs);
if p>0 then
hs[p]:='e';
p:=pos('+',hs);
if p>0 then
delete(hs,p,1);
single2str:=lower(hs);
end;
function double2str(d : double) : string;
var
hs : string;
@ -123,7 +140,7 @@ unit ag386nsm;
with ref do
begin
first:=true;
if ref.segment<>R_DEFAULT_SEG then
if ref.segment<>R_NO then
s:='['+int_reg2str[segment]+':'
else
s:='[';
@ -442,10 +459,10 @@ unit ag386nsm;
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));
ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
ait_string : begin
counter := 0;
lines := pai_string(hp)^.len div line_length;
@ -547,7 +564,7 @@ ait_labeled_instruction :
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_rva,
ait_real_64bit,ait_string]) then
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
AsmWriteLn(':')
end;
ait_instruction : begin
@ -735,7 +752,11 @@ ait_stab_function_name : ;
end.
{
$Log$
Revision 1.36 1999-05-11 16:28:16 peter
Revision 1.37 1999-05-12 00:19:39 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.36 1999/05/11 16:28:16 peter
* long lines fixed
Revision 1.35 1999/05/10 15:18:16 peter

10
compiler/cg386cnv.pas
View File

@ -442,7 +442,7 @@ implementation
begin
clear_location(pto^.location);
pto^.location.loc:=LOC_REFERENCE;
clear_reference(pto^.location.reference);
reset_reference(pto^.location.reference);
case pfrom^.location.loc of
LOC_REGISTER :
pto^.location.reference.base:=pfrom^.location.register;
@ -1202,7 +1202,7 @@ implementation
{$else}
exprasmlist^.concat(new(pai386_labeled,op_lab(A_JE,nillabel)));
{$endif}
{ this is one point where we need vmt_offset (PM) }
r^.offset:= pobjectdef(ppointerdef(p^.resulttype)^.definition)^.vmt_offset;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,r,R_EDI)));
@ -1331,7 +1331,11 @@ implementation
end.
{
$Log$
Revision 1.70 1999-05-07 00:33:47 pierre
Revision 1.71 1999-05-12 00:19:40 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.70 1999/05/07 00:33:47 pierre
explicit type conv to pobject checked with cond TESTOBJEXT2
Revision 1.69 1999/05/01 13:24:04 peter

82
compiler/cg386con.pas
View File

@ -56,11 +56,17 @@ implementation
*****************************************************************************}
procedure secondrealconst(var p : ptree);
const
floattype2ait:array[tfloattype] of tait=
(ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_none,ait_none);
var
hp1 : pai;
lastlabel : plabel;
realait : tait;
begin
lastlabel:=nil;
realait:=floattype2ait[pfloatdef(p^.resulttype)^.typ];
{ const already used ? }
if not assigned(p^.lab_real) then
begin
@ -72,11 +78,14 @@ implementation
lastlabel:=pai_label(hp1)^.l
else
begin
if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
if (hp1^.typ=realait) and (lastlabel<>nil) then
begin
if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.value_real)) or
((p^.realtyp=ait_real_80bit) and (pai_extended(hp1)^.value=p^.value_real)) or
((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.value_real)) then
if(
((realait=ait_real_32bit) and (pai_real_32bit(hp1)^.value=p^.value_real)) or
((realait=ait_real_64bit) and (pai_real_64bit(hp1)^.value=p^.value_real)) or
((realait=ait_real_80bit) and (pai_real_80bit(hp1)^.value=p^.value_real)) or
((realait=ait_comp_64bit) and (pai_comp_64bit(hp1)^.value=p^.value_real))
) then
begin
{ found! }
p^.lab_real:=lastlabel;
@ -95,16 +104,21 @@ implementation
if (cs_smartlink in aktmoduleswitches) then
consts^.concat(new(pai_cut,init));
consts^.concat(new(pai_label,init(lastlabel)));
case p^.realtyp of
ait_real_80bit : consts^.concat(new(pai_extended,init(p^.value_real)));
ait_real_64bit : consts^.concat(new(pai_double,init(p^.value_real)));
ait_real_32bit : consts^.concat(new(pai_single,init(p^.value_real)));
case realait of
ait_real_32bit :
consts^.concat(new(pai_real_32bit,init(p^.value_real)));
ait_real_64bit :
consts^.concat(new(pai_real_64bit,init(p^.value_real)));
ait_real_80bit :
consts^.concat(new(pai_real_80bit,init(p^.value_real)));
ait_comp_64bit :
consts^.concat(new(pai_comp_64bit,init(p^.value_real)));
else
internalerror(10120);
end;
end;
end;
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_real));
p^.location.loc:=LOC_MEM;
end;
@ -256,38 +270,24 @@ implementation
end;
st_shortstring:
begin
{ empty strings }
(* if p^.length=0 then
{ consts^.concat(new(pai_const,init_16bit(0)))}
{ this was not very good because several occurence
needed several data space ! }
begin
getmem(pc,3);
pc[0]:=#0;pc[1]:=#0;
consts^.concat(new(pai_string,init_length_pchar(pc,2)));
end
else *)
begin
{ truncate strings larger than 255 chars }
if p^.length>255 then
l:=255
else
l:=p^.length;
{ also length and terminating zero }
getmem(pc,l+3);
move(p^.value_str^,pc[1],l+1);
pc[0]:=chr(l);
{ to overcome this problem we set the length explicitly }
{ with the ending null char }
pc[l+1]:=#0;
consts^.concat(new(pai_string,init_length_pchar(pc,l+2)));
end;
{ truncate strings larger than 255 chars }
if p^.length>255 then
l:=255
else
l:=p^.length;
{ also length and terminating zero }
getmem(pc,l+3);
move(p^.value_str^,pc[1],l+1);
pc[0]:=chr(l);
{ to overcome this problem we set the length explicitly }
{ with the ending null char }
pc[l+1]:=#0;
consts^.concat(new(pai_string,init_length_pchar(pc,l+2)));
end;
end;
end;
end;
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_str));
p^.location.loc:=LOC_MEM;
end;
@ -389,7 +389,7 @@ implementation
end;
end;
end;
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
p^.location.reference.symbol:=newasmsymbol(lab2str(p^.lab_set));
p^.location.loc:=LOC_MEM;
end;
@ -410,7 +410,11 @@ implementation
end.
{
$Log$
Revision 1.33 1999-05-06 09:05:12 peter
Revision 1.34 1999-05-12 00:19:41 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.33 1999/05/06 09:05:12 peter
* generic write_float and str_float
* fixed constant float conversions

8
compiler/cg386inl.pas
View File

@ -738,7 +738,7 @@ implementation
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
{set up hr2 to a refernce with EDI as base register}
clear_reference(hr2);
reset_reference(hr2);
hr2.base := R_EDI;
{save the function result in the destination variable}
@ -1241,7 +1241,11 @@ implementation
end.
{
$Log$
Revision 1.47 1999-05-06 09:05:13 peter
Revision 1.48 1999-05-12 00:19:42 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.47 1999/05/06 09:05:13 peter
* generic write_float and str_float
* fixed constant float conversions

28
compiler/cg386ld.pas
View File

@ -116,7 +116,7 @@ implementation
{ any register except EAX }
emitcall('FPC_RELOCATE_THREADVAR',true);
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
p^.location.reference.base:=getregister32;
emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.reference.base);
if popeax then
@ -252,7 +252,7 @@ implementation
newreference(p^.location.reference),
hregister)));
end;
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
p^.location.reference.base:=hregister;
end;
end;
@ -387,7 +387,7 @@ implementation
exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,newreference(
p^.left^.location.reference),
hregister)));
clear_reference(p^.left^.location.reference);
reset_reference(p^.left^.location.reference);
p^.left^.location.reference.base:=hregister;
p^.left^.location.reference.index:=R_NO;
end;
@ -418,19 +418,7 @@ implementation
end;
{$endif test_dest_loc}
if (p^.right^.treetype=realconstn) then
begin
if p^.left^.resulttype^.deftype=floatdef then
begin
case pfloatdef(p^.left^.resulttype)^.typ of
s32real : p^.right^.realtyp:=ait_real_32bit;
s64real : p^.right^.realtyp:=ait_real_64bit;
s80real : p^.right^.realtyp:=ait_real_80bit;
end;
end;
end;
secondpass(p^.right);
if codegenerror then
exit;
@ -705,7 +693,7 @@ implementation
pp : pprocinfo;
hr_valid : boolean;
begin
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
hr_valid:=false;
if @procinfo<>pprocinfo(p^.funcretprocinfo) then
begin
@ -772,7 +760,7 @@ implementation
begin
if not p^.cargs then
begin
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
gettempofsizereference((parraydef(p^.resulttype)^.highrange+1)*8,p^.location.reference);
href:=p^.location.reference;
end;
@ -863,7 +851,11 @@ implementation
end.
{
$Log$
Revision 1.53 1999-05-06 09:05:16 peter
Revision 1.54 1999-05-12 00:19:43 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.53 1999/05/06 09:05:16 peter
* generic write_float and str_float
* fixed constant float conversions

22
compiler/cg386mem.pas
View File

@ -133,7 +133,7 @@ implementation
secondpass(p^.left);
if codegenerror then
exit;
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
case p^.left^.location.loc of
LOC_REGISTER,
LOC_CREGISTER:
@ -258,7 +258,7 @@ implementation
newreference(p^.left^.location.reference),
p^.location.register)));
{ for use of other segments }
if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
if p^.left^.location.reference.segment<>R_NO then
p^.location.segment:=p^.left^.location.reference.segment;
end;
@ -288,7 +288,7 @@ implementation
hr : tregister;
begin
secondpass(p^.left);
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
case p^.left^.location.loc of
LOC_REGISTER:
p^.location.reference.base:=p^.left^.location.register;
@ -332,7 +332,7 @@ implementation
if (p^.left^.resulttype^.deftype=objectdef) and
pobjectdef(p^.left^.resulttype)^.isclass then
begin
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
case p^.left^.location.loc of
LOC_REGISTER:
p^.location.reference.base:=p^.left^.location.register;
@ -776,7 +776,7 @@ implementation
hr:=reg32toreg8(getregister32);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_B,
newreference(p^.location.reference),hr)));
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hr;
{ we can remove all temps }
@ -788,7 +788,7 @@ implementation
del_reference(p^.location.reference);
hr:=reg32toreg16(getregister32);
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_W,
newreference(p^.location.reference),hr))); clear_reference(p^.location.reference);
newreference(p^.location.reference),hr))); reset_reference(p^.location.reference);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hr;
{ we can remove all temps }
@ -805,7 +805,7 @@ implementation
procedure secondselfn(var p : ptree);
begin
clear_reference(p^.location.reference);
reset_reference(p^.location.reference);
if (p^.resulttype^.deftype=classrefdef) or
((p^.resulttype^.deftype=objectdef)
and pobjectdef(p^.resulttype)^.isclass
@ -831,7 +831,7 @@ implementation
begin
secondpass(p^.left);
load:=true;
if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
if p^.left^.location.reference.segment<>R_NO then
message(parser_e_no_with_for_variable_in_other_segments);
ref.symbol:=nil;
gettempofsizereference(4,ref);
@ -882,7 +882,11 @@ implementation
end.
{
$Log$
Revision 1.35 1999-05-01 13:24:13 peter
Revision 1.36 1999-05-12 00:19:44 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.35 1999/05/01 13:24:13 peter
* merged nasm compiler
* old asm moved to oldasm/

8
compiler/gdb.pas
View File

@ -95,7 +95,7 @@ Const
GDB_i386index : array[tregister] of shortint =(-1,
0,1,2,3,4,5,6,7,0,1,2,3,4,5,7,0,1,2,3,0,1,2,3,
-1,10,12,13,14,15,11,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,
{$ifndef OLDASM}
-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,
@ -263,7 +263,11 @@ end.
{
$Log$
Revision 1.9 1999-05-01 13:24:20 peter
Revision 1.10 1999-05-12 00:19:48 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.9 1999/05/01 13:24:20 peter
* merged nasm compiler
* old asm moved to oldasm/

23
compiler/globtype.pas
View File

@ -26,6 +26,23 @@ interface
maxidlen = 64;
type
{ System independent float names }
{$ifdef i386}
bestreal = extended;
ts32real = single;
ts64real = double;
ts80real = extended;
ts64comp = extended;
{$endif}
{$ifdef m68k}
bestreal = real;
ts32real = single;
ts64real = double;
ts80real = extended;
ts64comp = comp;
{$endif}
pbestreal=^bestreal;
{ Switches which can be changed locally }
tlocalswitch = (cs_localnone,
{ codegen }
@ -112,7 +129,11 @@ begin
end.
{
$Log$
Revision 1.8 1999-04-26 13:31:33 peter
Revision 1.9 1999-05-12 00:19:49 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.8 1999/04/26 13:31:33 peter
* release storenumber,double_checksum
Revision 1.7 1999/04/25 22:34:58 pierre

14
compiler/i386asm.pas
View File

@ -259,7 +259,7 @@ uses
else
begin
ref:=p;
if not(ref^.segment in [R_DS,R_NO,R_DEFAULT_SEG]) then
if not(ref^.segment in [R_DS,R_NO]) then
segprefix:=ref^.segment;
typ:=top_ref;
end;
@ -845,7 +845,7 @@ begin
if m=100 then
begin
InsSize:=calcsize(insentry);
if not(segprefix in [R_NO,R_DEFAULT_SEG]) then
if (segprefix<>R_NO) then
inc(InsSize);
Pass1:=InsSize;
LastInsOffset:=InsOffset;
@ -872,7 +872,7 @@ begin
exit;
aktfilepos:=fileinfo;
{ Segment override }
if not(segprefix in [R_NO,R_DEFAULT_SEG]) then
if (segprefix<>R_NO) then
begin
case segprefix of
R_CS : c:=$2e;
@ -1277,7 +1277,7 @@ begin
else
bytes[0]:=$e;
end;
R_DEFAULT_SEG,
R_NO,
R_DS :
begin
if c=4 then
@ -1573,7 +1573,11 @@ end;
end.
{
$Log$
Revision 1.5 1999-05-11 16:29:59 peter
Revision 1.6 1999-05-12 00:19:50 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.5 1999/05/11 16:29:59 peter
* more noag386bin defines, so tp7 can compile at least
Revision 1.4 1999/05/05 22:21:51 peter

45
compiler/i386base.pas
View File

@ -463,8 +463,7 @@ type
R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI,
R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI,
R_AL,R_CL,R_DL,R_BL,R_AH,R_CH,R_BH,R_DH,
{ for an easier assembler generation }
R_DEFAULT_SEG,R_CS,R_DS,R_ES,R_SS,R_FS,R_GS,
R_CS,R_DS,R_ES,R_SS,R_FS,R_GS,
R_ST,R_ST0,R_ST1,R_ST2,R_ST3,R_ST4,R_ST5,R_ST6,R_ST7,
R_DR0,R_DR1,R_DR2,R_DR3,R_DR6,R_DR7,
R_CR0,R_CR2,R_CR3,R_CR4,
@ -482,7 +481,7 @@ const
lastreg = high(tregister);
firstsreg = R_CS;
lastsreg = R_GS;
lastsreg = R_GS;
regset8bit : tregisterset = [R_AL..R_DH];
regset16bit : tregisterset = [R_AX..R_DI,R_CS..R_SS];
@ -493,7 +492,7 @@ const
S_L,S_L,S_L,S_L,S_L,S_L,S_L,S_L,
S_W,S_W,S_W,S_W,S_W,S_W,S_W,S_W,
S_B,S_B,S_B,S_B,S_B,S_B,S_B,S_B,
S_NO,S_W,S_W,S_W,S_W,S_W,S_W,
S_W,S_W,S_W,S_W,S_W,S_W,
S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,S_FL,
S_L,S_L,S_L,S_L,S_L,S_L,
S_L,S_L,S_L,S_L,
@ -507,7 +506,7 @@ const
OT_REG_EAX,OT_REG_ECX,OT_REG32,OT_REG32,OT_REG32,OT_REG32,OT_REG32,OT_REG32,
OT_REG_AX,OT_REG_CX,OT_REG_DX,OT_REG16,OT_REG16,OT_REG16,OT_REG16,OT_REG16,
OT_REG_AL,OT_REG_CL,OT_REG8,OT_REG8,OT_REG8,OT_REG8,OT_REG8,OT_REG8,
OT_NONE,OT_REG_CS,OT_REG_DESS,OT_REG_DESS,OT_REG_DESS,OT_REG_FSGS,OT_REG_FSGS,
OT_REG_CS,OT_REG_DESS,OT_REG_DESS,OT_REG_DESS,OT_REG_FSGS,OT_REG_FSGS,
OT_FPU0,OT_FPU0,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,OT_FPUREG,
OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,OT_REG_DREG,
OT_REG_CREG,OT_REG_CREG,OT_REG_CREG,OT_REG_CR4,
@ -521,7 +520,7 @@ const
'eax','ecx','edx','ebx','esp','ebp','esi','edi',
'ax','cx','dx','bx','sp','bp','si','di',
'al','cl','dl','bl','ah','ch','bh','dh',
'','cs','ds','es','ss','fs','gs',
'cs','ds','es','ss','fs','gs',
'st','st(0)','st(1)','st(2)','st(3)','st(4)','st(5)','st(6)','st(7)',
'dr0','dr1','dr2','dr3','dr6','dr7',
'cr0','cr2','cr3','cr4',
@ -534,7 +533,7 @@ const
'eax','ecx','edx','ebx','esp','ebp','esi','edi',
'ax','cx','dx','bx','sp','bp','si','di',
'al','cl','dl','bl','ah','ch','bh','dh',
'','cs','ds','es','ss','fs','gs',
'cs','ds','es','ss','fs','gs',
'st0','st0','st1','st2','st3','st4','st5','st6','st7',
'dr0','dr1','dr2','dr3','dr6','dr7',
'cr0','cr2','cr3','cr4',
@ -549,7 +548,7 @@ const
'%eax','%ecx','%edx','%ebx','%esp','%ebp','%esi','%edi',
'%ax','%cx','%dx','%bx','%sp','%bp','%si','%di',
'%al','%cl','%dl','%bl','%ah','%ch','%bh','%dh',
'','%cs','%ds','%es','%ss','%fs','%gs',
'%cs','%ds','%es','%ss','%fs','%gs',
'%st','%st(0)','%st(1)','%st(2)','%st(3)','%st(4)','%st(5)','%st(6)','%st(7)',
'%dr0','%dr1','%dr2','%dr3','%dr6','%dr7',
'%cr0','%cr2','%cr3','%cr4',
@ -726,9 +725,6 @@ var
procedure reset_reference(var ref : treference);
{ set mostly used values of a new reference }
function new_reference(base : tregister;offset : longint) : preference;
{ same as reset_reference, but symbol is disposed }
{ use this only for already used references }
procedure clear_reference(var ref : treference);
function newreference(const r : treference) : preference;
procedure disposereference(var r : preference);
@ -861,18 +857,7 @@ end;
procedure reset_reference(var ref : treference);
begin
with ref do
begin
is_immediate:=false;
segment:=R_DEFAULT_SEG;
base:=R_NO;
index:=R_NO;
scalefactor:=0;
offset:=0;
symbol:=nil;
offsetfixup:=0;
options:=ref_none;
end;
FillChar(ref,sizeof(treference),0);
end;
@ -881,19 +866,13 @@ var
r : preference;
begin
new(r);
reset_reference(r^);
FillChar(r^,sizeof(treference),0);
r^.base:=base;
r^.offset:=offset;
new_reference:=r;
end;
procedure clear_reference(var ref : treference);
begin
reset_reference(ref);
end;
{*****************************************************************************
Instruction table
*****************************************************************************}
@ -937,7 +916,11 @@ begin
end.
{
$Log$
Revision 1.2 1999-05-11 16:30:00 peter
Revision 1.3 1999-05-12 00:19:51 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.2 1999/05/11 16:30:00 peter
* more noag386bin defines, so tp7 can compile at least
Revision 1.1 1999/05/01 13:24:23 peter

8
compiler/popt386.pas
View File

@ -563,7 +563,7 @@ Begin
Begin
{removes seg register prefixes from LEA operations, as they
don't do anything}
Pai386(p)^.oper[0].ref^.Segment := R_DEFAULT_SEG;
Pai386(p)^.oper[0].ref^.Segment := R_NO;
{changes "lea (%reg1), %reg2" into "mov %reg1, %reg2"}
If (Pai386(p)^.oper[0].ref^.Base In [R_EAX..R_EDI]) And
(Pai386(p)^.oper[0].ref^.Index = R_NO) And
@ -1514,7 +1514,11 @@ End.
{
$Log$
Revision 1.52 1999-05-05 16:19:04 jonas
Revision 1.53 1999-05-12 00:19:52 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.52 1999/05/05 16:19:04 jonas
+ remove the segment prefixes from LEA instructions
Revision 1.51 1999/05/05 10:05:54 florian

8
compiler/psystem.pas
View File

@ -131,7 +131,7 @@ begin
p^.insert(new(ptypesym,init('EXTENDED',s80floatdef)));
p^.insert(new(ptypesym,init('REAL',s64floatdef)));
{$ifdef i386}
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64bitcomp)))));
p^.insert(new(ptypesym,init('COMP',new(pfloatdef,init(s64comp)))));
{$endif}
p^.insert(new(ptypesym,init('POINTER',voidpointerdef)));
p^.insert(new(ptypesym,init('FARPOINTER',voidfarpointerdef)));
@ -248,7 +248,11 @@ end;
end.
{
$Log$
Revision 1.22 1999-05-06 09:05:23 peter
Revision 1.23 1999-05-12 00:19:53 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.22 1999/05/06 09:05:23 peter
* generic write_float and str_float
* fixed constant float conversions

14
compiler/ptconst.pas
View File

@ -178,10 +178,10 @@ unit ptconst;
Message(cg_e_illegal_expression);
case pfloatdef(def)^.typ of
s64real : curconstsegment^.concat(new(pai_double,init(value)));
s32real : curconstsegment^.concat(new(pai_single,init(value)));
s80real : curconstsegment^.concat(new(pai_extended,init(value)));
s64bitcomp : curconstsegment^.concat(new(pai_comp,init(value)));
s32real : curconstsegment^.concat(new(pai_real_32bit,init(value)));
s64real : curconstsegment^.concat(new(pai_real_64bit,init(value)));
s80real : curconstsegment^.concat(new(pai_real_80bit,init(value)));
s64comp : curconstsegment^.concat(new(pai_comp_64bit,init(value)));
f32bit : curconstsegment^.concat(new(pai_const,init_32bit(trunc(value*65536))));
else internalerror(18);
end;
@ -714,7 +714,11 @@ unit ptconst;
end.
{
$Log$
Revision 1.42 1999-05-06 09:05:24 peter
Revision 1.43 1999-05-12 00:19:54 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.42 1999/05/06 09:05:24 peter
* generic write_float and str_float
* fixed constant float conversions

8
compiler/ra386.pas
View File

@ -149,7 +149,7 @@ Begin
Message(asmr_e_invalid_operand_type);
end;
operands[operandnum].operandtype := OPR_REFERENCE;
operands[operandnum].ref.segment := R_DEFAULT_SEG;
operands[operandnum].ref.segment := R_NO;
end;
end;
@ -393,7 +393,11 @@ end;
end.
{
$Log$
Revision 1.3 1999-05-05 22:21:59 peter
Revision 1.4 1999-05-12 00:19:55 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.3 1999/05/05 22:21:59 peter
* updated messages
Revision 1.2 1999/05/02 14:24:26 peter

8
compiler/ra386att.pas
View File

@ -1841,7 +1841,7 @@ Begin
AS_DQ:
Begin
Consume(AS_DQ);
BuildRealConstant(s64bitcomp);
BuildRealConstant(s64comp);
end;
AS_SINGLE:
Begin
@ -1983,7 +1983,11 @@ begin
end.
{
$Log$
Revision 1.45 1999-05-06 09:05:25 peter
Revision 1.46 1999-05-12 00:19:56 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.45 1999/05/06 09:05:25 peter
* generic write_float and str_float
* fixed constant float conversions

10
compiler/symdef.inc
View File

@ -1118,7 +1118,7 @@
s32real : savesize:=4;
s64real : savesize:=8;
s80real : savesize:=extended_size;
s64bitcomp : savesize:=8;
s64comp : savesize:=8;
else
savesize:=0;
end;
@ -1148,7 +1148,7 @@
stabstring := strpnew('r'+s32bitdef^.numberstring+';0;'+
tostr($ffff)+';');
{ found this solution in stabsread.c from GDB v4.16 }
s64bitcomp : stabstring := strpnew('r'+
s64comp : stabstring := strpnew('r'+
s32bitdef^.numberstring+';-'+tostr(savesize)+';0;');
{$ifdef i386}
{ under dos at least you must give a size of twelve instead of 10 !! }
@ -3473,7 +3473,11 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.112 1999-05-08 19:52:35 peter
Revision 1.113 1999-05-12 00:19:58 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.112 1999/05/08 19:52:35 peter
+ MessagePos() which is enhanced Message() function but also gets the
position info
* Removed comp warnings

8
compiler/symdefh.inc
View File

@ -316,7 +316,7 @@
{ moment. }
{ s64 bit is considered as a real because all }
{ calculations are done by the fpu. }
tfloattype = (s32real,s64real,s80real,s64bitcomp,f16bit,f32bit);
tfloattype = (s32real,s64real,s80real,s64comp,f16bit,f32bit);
pfloatdef = ^tfloatdef;
tfloatdef = object(tdef)
@ -510,7 +510,11 @@
{
$Log$
Revision 1.25 1999-05-08 19:52:37 peter
Revision 1.26 1999-05-12 00:19:59 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.25 1999/05/08 19:52:37 peter
+ MessagePos() which is enhanced Message() function but also gets the
position info
* Removed comp warnings

10
compiler/tccnv.pas
View File

@ -406,8 +406,8 @@ implementation
end;
{ comp isn't a floating type }
{$ifdef i386}
if (pfloatdef(p^.resulttype)^.typ=s64bitcomp) and
(pfloatdef(p^.left^.resulttype)^.typ<>s64bitcomp) and
if (pfloatdef(p^.resulttype)^.typ=s64comp) and
(pfloatdef(p^.left^.resulttype)^.typ<>s64comp) and
not (p^.explizit) then
CGMessage(type_w_convert_real_2_comp);
{$endif}
@ -933,7 +933,11 @@ implementation
end.
{
$Log$
Revision 1.29 1999-05-09 11:37:05 peter
Revision 1.30 1999-05-12 00:20:00 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.29 1999/05/09 11:37:05 peter
* fixed order of arguments for incompatible types message
Revision 1.28 1999/05/06 09:05:34 peter

7
compiler/tcld.pas
View File

@ -82,7 +82,6 @@ implementation
{$ifdef SUPPORT_MMX}
p^.registersmmx:=0;
{$endif SUPPORT_MMX}
clear_reference(p^.location.reference);
if p^.symtableentry^.typ=funcretsym then
begin
p1:=genzeronode(funcretn);
@ -452,7 +451,11 @@ implementation
end.
{
$Log$
Revision 1.26 1999-05-06 09:05:36 peter
Revision 1.27 1999-05-12 00:20:02 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.26 1999/05/06 09:05:36 peter
* generic write_float and str_float
* fixed constant float conversions

16
compiler/tree.pas
View File

@ -225,7 +225,7 @@ unit tree;
no_check,unit_specific,
return_value_used,static_call : boolean);
ordconstn : (value : longint);
realconstn : (value_real : bestreal;lab_real : plabel;realtyp : tait);
realconstn : (value_real : bestreal;lab_real : plabel);
fixconstn : (value_fix: longint);
funcretn : (funcretprocinfo : pointer;retdef : pdef);
subscriptn : (vs : pvarsym);
@ -788,14 +788,6 @@ unit tree;
{$endif SUPPORT_MMX}
p^.resulttype:=def;
p^.value_real:=v;
case pfloatdef(def)^.typ of
s32real :
p^.realtyp:=ait_real_32bit;
s64real :
p^.realtyp:=ait_real_64bit;
s80real :
p^.realtyp:=ait_real_80bit;
end;
p^.lab_real:=nil;
genrealconstnode:=p;
end;
@ -1716,7 +1708,11 @@ unit tree;
end.
{
$Log$
Revision 1.77 1999-05-06 09:05:39 peter
Revision 1.78 1999-05-12 00:20:03 peter
* removed R_DEFAULT_SEG
* uniform float names
Revision 1.77 1999/05/06 09:05:39 peter
* generic write_float and str_float
* fixed constant float conversions