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

* m68k updates

Browse Source
This commit is contained in:
peter 1998-07-10 10:50:54 +00:00
parent 889203c8ba
commit 2cd0720f62
9 changed files with 924 additions and 889 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
compiler/ag68kgas.pas
View File

@ -53,7 +53,13 @@ unit ag68kgas;
line_length = 70; line_length = 70;
var var
{$ifdef NEWINPUT}
infile : pinputfile;
{$else}
infile : pextfile; infile : pextfile;
{$endif}
includecount,lastline : longint; includecount,lastline : longint;
function double2str(d : double) : string; function double2str(d : double) : string;
@ -207,10 +213,10 @@ unit ag68kgas;
var var
{$ifdef GDB} {$ifdef GDB}
n_line : byte; n_line : byte;
{$endif} {$endif}
lastsec : tsection; lastsec : tsection;
lastsecidx : longint;
const const
@ -246,9 +252,14 @@ unit ag68kgas;
{$ifdef GDB} {$ifdef GDB}
if cs_debuginfo in aktswitches then if cs_debuginfo in aktswitches then
begin begin
if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,ait_stab_function_name]) then if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,
ait_label,ait_cut,ait_align,ait_stab_function_name]) then
begin begin
{$ifdef NEWINPUT}
if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile) then
{$else}
if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
{$endif NEWINPUT}
begin begin
infile:=hp^.infile; infile:=hp^.infile;
inc(includecount); inc(includecount);
@ -331,10 +342,6 @@ unit ag68kgas;
end; end;
ait_const_32bit, { alignment is required for 16/32 bit data! } ait_const_32bit, { alignment is required for 16/32 bit data! }
ait_const_16bit: begin ait_const_16bit: begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value)); AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
consttyp:=hp^.typ; consttyp:=hp^.typ;
l:=0; l:=0;
@ -367,39 +374,19 @@ unit ag68kgas;
AsmLn; AsmLn;
end; end;
ait_const_symbol : Begin ait_const_symbol : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value))); AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
end; end;
ait_real_64bit : Begin ait_real_64bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value)); AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
end; end;
ait_real_32bit : Begin ait_real_32bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value)); AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
end; end;
ait_real_extended : Begin ait_real_extended : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value)); AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
{ comp type is difficult to write so use double } { comp type is difficult to write so use double }
end; end;
ait_comp : Begin ait_comp : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value)); AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
end; end;
ait_direct : begin ait_direct : begin
@ -443,6 +430,15 @@ unit ag68kgas;
end; end;
end; end;
ait_label : begin ait_label : begin
if assigned(hp^.next) and (pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_symbol,
ait_real_64bit,ait_real_32bit,ait_string]) then
begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
end;
if (pai_label(hp)^.l^.is_used) then if (pai_label(hp)^.l^.is_used) then
AsmWriteLn(lab2str(pai_label(hp)^.l)+':'); AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
end; end;
@ -475,10 +471,14 @@ ait_labeled_instruction : begin
end; end;
ait_instruction : begin ait_instruction : begin
{ old versions of GAS don't like PEA.L and LEA.L } { old versions of GAS don't like PEA.L and LEA.L }
if (pai68k(hp)^._operator <> A_LEA) and (pai68k(hp)^._operator<> A_PEA) then if (pai68k(hp)^._operator in [
s:=#9+mot_op2str[pai68k(hp)^._operator]+gas_opsize2str[pai68k(hp)^.size] A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST,
A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS,
A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI,
A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
s:=#9+mot_op2str[pai68k(hp)^._operator]
else else
s:=#9+mot_op2str[pai68k(hp)^._operator]; s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
if pai68k(hp)^.op1t<>top_none then if pai68k(hp)^.op1t<>top_none then
begin begin
{ call and jmp need an extra handling } { call and jmp need an extra handling }
@ -526,21 +526,27 @@ ait_labeled_instruction : begin
end; end;
ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str; ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
{$endif GDB} {$endif GDB}
{$ifdef SMARTLINK} ait_cut : begin
ait_cut : begin { used to split into tiny assembler files } { create only a new file when the last is not empty }
if (cs_smartlink in aktswitches) then if AsmSize>0 then
begin begin
AsmClose; AsmClose;
DoAssemble; DoAssemble;
AsmCreate; AsmCreate;
AsmWriteLn(ait_section2str[lastsec]);
{ avoid empty files }
while assigned(hp^.next) and (pai(hp^.next)^.typ=ait_cut) do
hp:=pai(hp^.next);
end; end;
{ avoid empty files }
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;
hp:=pai(hp^.next);
end;
if lastsec<>sec_none then
AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
end; end;
{$endif SMARTLINK}
else else
internalerror(10000); internalerror(10000);
end; end;
@ -584,8 +590,13 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end; end;
infile:=current_module^.sourcefiles.files; infile:=current_module^.sourcefiles.files;
{ main source file is last in list } { main source file is last in list }
{$ifdef NEWINPUT}
while assigned(infile^.next) do
infile:=infile^.next;
{$else}
while assigned(infile^._next) do while assigned(infile^._next) do
infile:=infile^._next; infile:=infile^._next;
{$endif}
lastline:=0; lastline:=0;
{$endif GDB} {$endif GDB}
@ -612,7 +623,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end. end.
{ {
$Log$ $Log$
Revision 1.5 1998-06-05 17:46:04 peter Revision 1.6 1998-07-10 10:50:54 peter
* m68k updates
Revision 1.5 1998/06/05 17:46:04 peter
* tp doesn't like comp() typecast * tp doesn't like comp() typecast
Revision 1.4 1998/06/04 23:51:28 peter Revision 1.4 1998/06/04 23:51:28 peter

84
compiler/ag68kmit.pas
View File

@ -55,7 +55,13 @@ unit ag68kmit;
{$ifdef GDB} {$ifdef GDB}
var var
{$ifdef NEWINPUT}
infile : pinputfile;
{$else}
infile : pextfile; infile : pextfile;
{$endif}
includecount, includecount,
lastline : longint; lastline : longint;
{$endif GDB} {$endif GDB}
@ -250,6 +256,7 @@ unit ag68kmit;
n_line : byte; { different types of source lines } n_line : byte; { different types of source lines }
{$endif} {$endif}
lastsec : tsection; { last section type written } lastsec : tsection; { last section type written }
lastsecidx : longint;
const const
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]= ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
@ -284,9 +291,14 @@ unit ag68kmit;
{$ifdef GDB} {$ifdef GDB}
if cs_debuginfo in aktswitches then if cs_debuginfo in aktswitches then
begin begin
if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,ait_stab_function_name]) then if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,
ait_label,ait_cut,ait_align,ait_stab_function_name]) then
begin begin
{$ifdef NEWINPUT}
if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile) then
{$else}
if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
{$endif NEWINPUT}
begin begin
infile:=hp^.infile; infile:=hp^.infile;
inc(includecount); inc(includecount);
@ -367,10 +379,6 @@ unit ag68kmit;
end; end;
ait_const_32bit, { alignment is required for 16/32 bit data! } ait_const_32bit, { alignment is required for 16/32 bit data! }
ait_const_16bit: begin ait_const_16bit: begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value)); AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
consttyp:=hp^.typ; consttyp:=hp^.typ;
l:=0; l:=0;
@ -402,42 +410,20 @@ unit ag68kmit;
until (not found) or (l>line_length); until (not found) or (l>line_length);
AsmLn; AsmLn;
end; end;
ait_const_symbol : begin ait_const_symbol : Begin
if not(cs_littlesize in aktswitches) then AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWrite(#9'.long'#9);
AsmWritePChar(pchar(pai_const(hp)^.value));
AsmLn;
end; end;
ait_real_64bit : Begin ait_real_64bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value)); AsmWriteLn(#9'.double'#9+double2str(pai_double(hp)^.value));
end; end;
ait_real_32bit : Begin ait_real_32bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value)); AsmWriteLn(#9'.single'#9+double2str(pai_single(hp)^.value));
end; end;
ait_real_extended : Begin ait_real_extended : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value)); AsmWriteLn(#9'.extend'#9+double2str(pai_extended(hp)^.value));
{ comp type is difficult to write so use double } { comp type is difficult to write so use double }
end; end;
ait_comp : Begin ait_comp : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value)); AsmWriteLn(#9'.double'#9+comp2str(pai_extended(hp)^.value));
end; end;
ait_direct : begin ait_direct : begin
@ -481,6 +467,15 @@ unit ag68kmit;
end; end;
end; end;
ait_label : begin ait_label : begin
if assigned(hp^.next) and (pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_symbol,
ait_real_64bit,ait_real_32bit,ait_string]) then
begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
end;
if (pai_label(hp)^.l^.is_used) then if (pai_label(hp)^.l^.is_used) then
AsmWriteLn(lab2str(pai_label(hp)^.l)+':'); AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
end; end;
@ -568,6 +563,27 @@ ait_labeled_instruction : begin
end; end;
ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str; ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
{$endif GDB} {$endif GDB}
ait_cut : begin
{ create only a new file when the last is not empty }
if AsmSize>0 then
begin
AsmClose;
DoAssemble;
AsmCreate;
end;
{ avoid empty files }
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;
hp:=pai(hp^.next);
end;
if lastsec<>sec_none then
AsmWriteLn(ait_section2str[lastsec,lastsecidx]);
end;
else else
internalerror(10000); internalerror(10000);
end; end;
@ -611,8 +627,13 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end; end;
infile:=current_module^.sourcefiles.files; infile:=current_module^.sourcefiles.files;
{ main source file is last in list } { main source file is last in list }
{$ifdef NEWINPUT}
while assigned(infile^.next) do
infile:=infile^.next;
{$else}
while assigned(infile^._next) do while assigned(infile^._next) do
infile:=infile^._next; infile:=infile^._next;
{$endif}
lastline:=0; lastline:=0;
{$endif GDB} {$endif GDB}
@ -639,7 +660,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end. end.
{ {
$Log$ $Log$
Revision 1.5 1998-06-05 17:46:05 peter Revision 1.6 1998-07-10 10:50:55 peter
* m68k updates
Revision 1.5 1998/06/05 17:46:05 peter
* tp doesn't like comp() typecast * tp doesn't like comp() typecast
Revision 1.4 1998/06/04 23:51:29 peter Revision 1.4 1998/06/04 23:51:29 peter

36
compiler/ag68kmot.pas
View File

@ -300,39 +300,19 @@ unit ag68kmot;
AsmWriteLn(StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size)); AsmWriteLn(StrPas(pai_datablock(hp)^.name)+#9#9'DS.B '+tostr(pai_datablock(hp)^.size));
end; end;
ait_const_32bit : Begin ait_const_32bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9'CNOP 0,4')
else
AsmWriteLn(#9'CNOP 0,2');
AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value)); AsmWriteLn(#9#9'DC.L'#9+tostr(pai_const(hp)^.value));
end; end;
ait_const_16bit : Begin ait_const_16bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9'CNOP 0,4')
else
AsmWriteLn(#9'CNOP 0,2');
AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value)); AsmWriteLn(#9#9'DC.W'#9+tostr(pai_const(hp)^.value));
end; end;
ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value)); ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value));
ait_const_symbol : Begin ait_const_symbol : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9'CNOP 0,4')
else
AsmWriteLn(#9'CNOP 0,2');
AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value))); AsmWriteLn(#9#9+'DC.L '#9+StrPas(pchar(pai_const(hp)^.value)));
end; end;
ait_real_64bit : Begin ait_real_64bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9'CNOP 0,4')
else
AsmWriteLn(#9'CNOP 0,2');
AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value)); AsmWriteLn(#9#9'DC.D'#9+double2str(pai_double(hp)^.value));
end; end;
ait_real_32bit : Begin ait_real_32bit : Begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9'CNOP 0,4')
else
AsmWriteLn(#9'CNOP 0,2');
AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value)); AsmWriteLn(#9#9'DC.S'#9+double2str(pai_single(hp)^.value));
end; end;
{ TO SUPPORT SOONER OR LATER!!! { TO SUPPORT SOONER OR LATER!!!
@ -411,6 +391,15 @@ unit ag68kmot;
AsmLn; AsmLn;
end; end;
ait_label : begin ait_label : begin
if assigned(hp^.next) and (pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_symbol,
ait_real_64bit,ait_real_32bit,ait_string]) then
begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9'CNOP 0,4')
else
AsmWriteLn(#9'CNOP 0,2');
end;
AsmWrite(lab2str(pai_label(hp)^.l)); 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_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
@ -521,12 +510,10 @@ ait_labeled_instruction :
Writetree(exportssection); Writetree(exportssection);
Writetree(resourcesection); Writetree(resourcesection);
AsmLn; AsmLn;
AsmWriteLn(#9'END'); AsmWriteLn(#9'END');
AsmLn; AsmLn;
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if assigned(current_module^.mainsource) then if assigned(current_module^.mainsource) then
comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^); comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
@ -536,7 +523,10 @@ ait_labeled_instruction :
end. end.
{ {
$Log$ $Log$
Revision 1.5 1998-06-05 17:46:06 peter Revision 1.6 1998-07-10 10:50:56 peter
* m68k updates
Revision 1.5 1998/06/05 17:46:06 peter
* tp doesn't like comp() typecast * tp doesn't like comp() typecast
Revision 1.4 1998/06/04 23:51:30 peter Revision 1.4 1998/06/04 23:51:30 peter

1105
compiler/cg68k.pas
View File

File diff suppressed because it is too large Load Diff

283
compiler/cg68k2.pas
View File

@ -55,8 +55,8 @@ Interface
procedure second_while_repeatn(var p : ptree); procedure second_while_repeatn(var p : ptree);
procedure secondifn(var p : ptree); procedure secondifn(var p : ptree);
procedure secondbreakn(var p : ptree); procedure secondbreakn(var p : ptree);
{ copies p a set element on the stack } { copies p a set element into the d0.b register }
procedure pushsetelement(var p : ptree); procedure loadsetelement(var p : ptree);
Implementation Implementation
@ -192,13 +192,15 @@ Implementation
{ on the right we do not need the register anymore too } { on the right we do not need the register anymore too }
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
pushusedregisters(pushedregs,$ffff); pushusedregisters(pushedregs,$ffff);
emitpushreferenceaddr(p^.left^.location.reference); { WE INVERSE THE PARAMETERS!!! }
{ Because parameters are inversed in the rtl }
emitpushreferenceaddr(p^.right^.location.reference); emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference);
emitcall('STRCONCAT',true); emitcall('STRCONCAT',true);
maybe_loadA5;
popusedregisters(pushedregs);
set_location(p^.location,p^.left^.location); set_location(p^.location,p^.left^.location);
ungetiftemp(p^.right^.location.reference); ungetiftemp(p^.right^.location.reference);
maybe_loada5;
popusedregisters(pushedregs);
end; { this case } end; { this case }
ltn,lten,gtn,gten, ltn,lten,gtn,gten,
equaln,unequaln : equaln,unequaln :
@ -234,8 +236,22 @@ Implementation
else else
begin begin
pushusedregisters(pushedregs,$ffff); pushusedregisters(pushedregs,$ffff);
{ parameters are directly passed via registers }
{ this has several advantages, no loss of the flags }
{ on exit ,and MUCH faster on m68k machines }
{ speed difference (68000) }
{ normal routine: entry, exit code + push = 124 }
{ (best case) }
{ assembler routine: param setup (worst case) = 48 }
exprasmlist^.concat(new(pai68k,op_ref_reg(
A_LEA,S_L,newreference(p^.left^.location.reference),R_A0)));
exprasmlist^.concat(new(pai68k,op_ref_reg(
A_LEA,S_L,newreference(p^.right^.location.reference),R_A1)));
{
emitpushreferenceaddr(p^.left^.location.reference); emitpushreferenceaddr(p^.left^.location.reference);
emitpushreferenceaddr(p^.right^.location.reference); emitpushreferenceaddr(p^.right^.location.reference); }
emitcall('STRCMP',true); emitcall('STRCMP',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -286,12 +302,13 @@ Implementation
((p^.left^.resulttype^.deftype=orddef) and ((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=u32bit)) or (porddef(p^.left^.resulttype)^.typ=u32bit)) or
((p^.right^.resulttype^.deftype=orddef) and ((p^.right^.resulttype^.deftype=orddef) and
(porddef(p^.right^.resulttype)^.typ=u32bit)) or (porddef(p^.right^.resulttype)^.typ=u32bit))
{ as well as small sets } { SMALL SETS DO NOT WORK BECAUSE OF ENDIAN! }
or { as well as small sets }
((p^.left^.resulttype^.deftype=setdef) and ((p^.left^.resulttype^.deftype=setdef) and
(psetdef(p^.left^.resulttype)^.settype=smallset) (psetdef(p^.left^.resulttype)^.settype=smallset))
) then then
begin begin
do_normal: do_normal:
mboverflow:=false; mboverflow:=false;
@ -332,7 +349,6 @@ Implementation
Message(sym_e_type_mismatch); Message(sym_e_type_mismatch);
end; end;
end; end;
muln : begin muln : begin
if is_set then if is_set then
begin begin
@ -905,8 +921,13 @@ Implementation
del_reference(p^.left^.location.reference); del_reference(p^.left^.location.reference);
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
pushusedregisters(pushedregs,$ffff); pushusedregisters(pushedregs,$ffff);
emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference); { emitpushreferenceaddr(p^.right^.location.reference);
emitpushreferenceaddr(p^.left^.location.reference);}
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
newreference(p^.left^.location.reference),R_A0)));
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
newreference(p^.right^.location.reference),R_A1)));
emitcall('SET_COMP_SETS',true); emitcall('SET_COMP_SETS',true);
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -933,6 +954,8 @@ Implementation
newcsymbol('SET_ADD_SETS',0)))); newcsymbol('SET_ADD_SETS',0))));
muln : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO, muln : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('SET_MUL_SETS',0)))); newcsymbol('SET_MUL_SETS',0))));
symdifn:
emitcall('SET_SYMDIF_SETS',true);
end; end;
maybe_loada5; maybe_loada5;
popusedregisters(pushedregs); popusedregisters(pushedregs);
@ -1389,25 +1412,30 @@ Implementation
{ copies p a set element on the stack } { This routine needs to be further checked to see if it works correctly }
procedure pushsetelement(var p : ptree); { because contrary to the intel version, all large set elements are read }
{ as 32-bit values, and then decomposed to find the correct byte. }
{ CHECKED -> Requires 32-bit read. }
procedure loadsetelement(var p : ptree);
var var
hr : tregister; hr : tregister;
begin begin
{ copy the element on the stack, slightly complicated } { copy the element in the d0.b register, slightly complicated }
case p^.location.loc of case p^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : begin LOC_CREGISTER : begin
hr:=p^.location.register; hr:=p^.location.register;
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,hr,R_SPPUSH))); emit_reg_reg(A_MOVE,S_L,hr,R_D0);
ungetregister32(hr); ungetregister32(hr);
end; end;
else else
begin begin
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W, exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
newreference(p^.location.reference),R_SPPUSH))); newreference(p^.location.reference),R_D0)));
{ exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
$ff,R_D0))); }
del_reference(p^.location.reference); del_reference(p^.location.reference);
end; end;
end; end;
@ -1491,7 +1519,7 @@ Implementation
end; end;
end; end;
analizeset:=true; analizeset:=true;
end; end; { end analizeset }
begin begin
if psetdef(p^.right^.resulttype)^.settype=smallset then if psetdef(p^.right^.resulttype)^.settype=smallset then
@ -1504,19 +1532,22 @@ Implementation
if codegenerror then if codegenerror then
exit; exit;
p^.location.resflags:=F_NE; p^.location.resflags:=F_NE;
{ Because of the Endian of the m68k, we have to consider this as a }
{ normal set and load it byte per byte, otherwise we will never get }
{ the correct result. }
case p^.right^.location.loc of case p^.right^.location.loc of
LOC_REGISTER,LOC_CREGISTER : begin LOC_REGISTER,LOC_CREGISTER :
begin
emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1); emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
exprasmlist^.concat(new(pai68k, exprasmlist^.concat(new(pai68k,
op_const_reg(A_AND,S_L, 1 shl op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
(p^.left^.value and 31),R_D1)));
end; end;
else else
begin begin
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference( exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
p^.right^.location.reference),R_D1))); p^.right^.location.reference),R_D1)));
exprasmlist^.concat(new(pai68k,op_const_reg( exprasmlist^.concat(new(pai68k,op_const_reg(
A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1))); A_AND,S_L,1 shl (p^.left^.value and 31) ,R_D1)));
end; end;
end; end;
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
@ -1545,7 +1576,7 @@ Implementation
{ the set element isn't never samller than a byte } { the set element isn't never samller than a byte }
{ and because it's a small set we need only 5 bits } { and because it's a small set we need only 5 bits }
{ but 8 bits are eaiser to load } { but 8 bits are eaiser to load }
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B, exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
newreference(p^.left^.location.reference),R_D1))); newreference(p^.left^.location.reference),R_D1)));
hr:=R_D1; hr:=R_D1;
del_reference(p^.left^.location.reference); del_reference(p^.left^.location.reference);
@ -1581,7 +1612,7 @@ Implementation
p^.location.resflags:=F_C; p^.location.resflags:=F_C;
end; end;
end end
else else { NOT a small set }
begin begin
if p^.left^.treetype=ordconstn then if p^.left^.treetype=ordconstn then
begin begin
@ -1591,11 +1622,11 @@ Implementation
if codegenerror then if codegenerror then
exit; exit;
p^.location.resflags:=F_NE; p^.location.resflags:=F_NE;
inc(p^.right^.location.reference.offset,p^.left^.value shr 3); inc(p^.right^.location.reference.offset,(p^.left^.value div 32)*4);
exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_B, exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L,
newreference(p^.right^.location.reference), R_D1))); newreference(p^.right^.location.reference), R_D1)));
exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B, exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
1 shl (p^.left^.value and 7),R_D1))); 1 shl (p^.left^.value mod 32),R_D1)));
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
end end
else else
@ -1614,11 +1645,17 @@ Implementation
LOC_CREGISTER : LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L, exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
255,p^.left^.location.register))); 255,p^.left^.location.register)));
else
Begin
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
newreference(p^.left^.location.reference),R_D0)));
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
255,R_D0)));
end;
end; end;
{Get a label to jump to the end.} {Get a label to jump to the end.}
p^.location.loc:=LOC_FLAGS; p^.location.loc:=LOC_FLAGS;
{It's better to use the zero flag when there are {It's better to use the zero flag when there are no ranges.}
no ranges.}
if ranges then if ranges then
p^.location.resflags:=F_C p^.location.resflags:=F_C
else else
@ -1638,15 +1675,16 @@ Implementation
href.symbol:=stringdup(lab2str(l2)); href.symbol:=stringdup(lab2str(l2));
if setparts[i].start=setparts[i].stop-1 then if setparts[i].start=setparts[i].stop-1 then
begin begin
case p^.left^.location.loc of case p^.left^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].start,p^.left^.location.register))); setparts[i].start,p^.left^.location.register)));
else else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].start,newreference(p^.left^.location.reference)))); setparts[i].start,R_D0)));
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].start,newreference(p^.left^.location.reference))));}
end; end;
{Result should be in carry flag when ranges are used.} {Result should be in carry flag when ranges are used.}
{ Here the m68k does not affect any flag except the } { Here the m68k does not affect any flag except the }
@ -1658,11 +1696,13 @@ Implementation
case p^.left^.location.loc of case p^.left^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].stop,p^.left^.location.register))); setparts[i].stop,p^.left^.location.register)));
else else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].stop,newreference(p^.left^.location.reference)))); setparts[i].stop,R_D0)));
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].stop,newreference(p^.left^.location.reference))));}
end; end;
{Result should be in carry flag when ranges are used.} {Result should be in carry flag when ranges are used.}
{ Here the m68k does not affect any flag except the } { Here the m68k does not affect any flag except the }
@ -1681,11 +1721,13 @@ Implementation
case p^.left^.location.loc of case p^.left^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].start,p^.left^.location.register))); setparts[i].start,p^.left^.location.register)));
else else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].start,newreference(p^.left^.location.reference)))); setparts[i].start,R_D0)));
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].start,newreference(p^.left^.location.reference)))); }
end; end;
{If lower, jump to next check.} {If lower, jump to next check.}
emitl(A_BCS,l2); emitl(A_BCS,l2);
@ -1697,11 +1739,13 @@ Implementation
case p^.left^.location.loc of case p^.left^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].stop+1,p^.left^.location.register))); setparts[i].stop+1,p^.left^.location.register)));
else else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].stop+1,newreference(p^.left^.location.reference)))); setparts[i].stop+1,R_D0)));
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].stop+1,newreference(p^.left^.location.reference))));}
end; { end case } end; { end case }
{If higher, element is in set.} {If higher, element is in set.}
emitl(A_BCS,l); emitl(A_BCS,l);
@ -1716,11 +1760,13 @@ Implementation
case p^.left^.location.loc of case p^.left^.location.loc of
LOC_REGISTER, LOC_REGISTER,
LOC_CREGISTER : LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_B, exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].stop,p^.left^.location.register))); setparts[i].stop,p^.left^.location.register)));
else else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B, { exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].stop,newreference(p^.left^.location.reference)))); setparts[i].stop,newreference(p^.left^.location.reference))));}
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
setparts[i].stop,R_D0)));
end; end;
{Result should be in carry flag when ranges are used.} {Result should be in carry flag when ranges are used.}
if ranges then if ranges then
@ -1750,27 +1796,20 @@ Implementation
{ of course not commutative } { of course not commutative }
if p^.swaped then if p^.swaped then
swaptree(p); swaptree(p);
pushsetelement(p^.left); { SET_IN_BYTE is an inline assembler procedure instead }
emitpushreferenceaddr(p^.right^.location.reference); { of a normal procedure, which is *MUCH* faster }
{ Parameters are passed by registers, and FLAGS are set }
{ according to the result. }
{ a0 = address of set }
{ d0.b = value to compare with }
{ CARRY SET IF FOUND ON EXIT }
loadsetelement(p^.left);
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
newreference(p^.right^.location.reference),R_A0)));;
{ emitpushreferenceaddr(p^.right^.location.reference);}
del_reference(p^.right^.location.reference); del_reference(p^.right^.location.reference);
{ registers need not be save. that happens in SET_IN_BYTE }
emitcall('SET_IN_BYTE',true); emitcall('SET_IN_BYTE',true);
{ ungetiftemp(p^.right^.location.reference); } { ungetiftemp(p^.right^.location.reference); }
{ here we must set the flags manually }
{ on returne from the routine, because }
{ flags are corrupt when restoring the }
{ stack }
exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
getlabel(hl2);
emitl(A_BEQ,hl2);
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,
$fe,R_CCR)));
getlabel(hl3);
emitl(A_BRA,hl3);
emitl(A_LABEL,hl2);
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,
$01,R_CCR)));
emitl(A_LABEL,hl3);
p^.location.loc:=LOC_FLAGS; p^.location.loc:=LOC_FLAGS;
p^.location.resflags:=F_C; p^.location.resflags:=F_C;
end; end;
@ -1921,7 +1960,10 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 1998-06-08 13:13:37 pierre Revision 1.6 1998-07-10 10:51:00 peter
* m68k updates
Revision 1.5 1998/06/08 13:13:37 pierre
+ temporary variables now in temp_gen.pas unit + temporary variables now in temp_gen.pas unit
because it is processor independent because it is processor independent
* mppc68k.bat modified to undefine i386 and support_mmx * mppc68k.bat modified to undefine i386 and support_mmx
@ -1939,111 +1981,4 @@ end.
+ started inline procedures + started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems) + added starstarn : use ** for exponentiation (^ gave problems)
+ started UseTokenInfo cond to get accurate positions + started UseTokenInfo cond to get accurate positions
Revision 1.2 1998/03/28 23:09:54 florian
* secondin bugfix (m68k and i386)
* overflow checking bugfix (m68k and i386) -- pretty useless in
secondadd, since everything is done using 32-bit
* loading pointer to routines hopefully fixed (m68k)
* flags problem with calls to RTL internal routines fixed (still strcmp
to fix) (m68k)
* #ELSE was still incorrect (didn't take care of the previous level)
* problem with filenames in the command line solved
* problem with mangledname solved
* linking name problem solved (was case insensitive)
* double id problem and potential crash solved
* stop after first error
* and=>test problem removed
* correct read for all float types
* 2 sigsegv fixes and a cosmetic fix for Internal Error
* push/pop is now correct optimized (=> mov (%esp),reg)
Revision 1.1.1.1 1998/03/25 11:18:13 root
* Restored version
Revision 1.18 1998/03/10 01:17:15 peter
* all files have the same header
* messages are fully implemented, EXTDEBUG uses Comment()
+ AG... files for the Assembler generation
Revision 1.17 1998/03/09 10:44:34 peter
+ string='', string<>'', string:='', string:=char optimizes (the first 2
were already in cg68k2)
Revision 1.16 1998/03/06 00:52:02 peter
* replaced all old messages from errore.msg, only ExtDebug and some
Comment() calls are left
* fixed options.pas
Revision 1.15 1998/03/02 01:48:15 peter
* renamed target_DOS to target_GO32V1
+ new verbose system, merged old errors and verbose units into one new
verbose.pas, so errors.pas is obsolete
Revision 1.14 1998/02/14 05:05:43 carl
+ now compiles under TP with overlays
Revision 1.13 1998/02/13 10:34:44 daniel
* Made Motorola version compilable.
* Fixed optimizer
Revision 1.12 1998/02/12 11:49:49 daniel
Yes! Finally! After three retries, my patch!
Changes:
Complete rewrite of psub.pas.
Added support for DLL's.
Compiler requires less memory.
Platform units for each platform.
Revision 1.11 1998/02/07 06:51:51 carl
+ moved secondraise from cg68k
Revision 1.10 1998/02/05 21:54:31 florian
+ more MMX
Revision 1.9 1998/02/05 00:59:29 carl
+ added secondas
Revision 1.8 1998/02/01 17:13:26 florian
+ comparsion of class references
Revision 1.7 1998/01/21 22:34:23 florian
+ comparsion of Delphi classes
Revision 1.6 1998/01/11 03:37:18 carl
* bugfix of muls.l under MC68000 target
* long subtract bugfix
Revision 1.3 1997/12/10 23:07:15 florian
* bugs fixed: 12,38 (also m68k),39,40,41
+ warning if a system unit is without -Us compiled
+ warning if a method is virtual and private (was an error)
* some indentions changed
+ factor does a better error recovering (omit some crashes)
+ problem with @type(x) removed (crashed the compiler)
Revision 1.2 1997/12/04 15:15:05 carl
+ updated to v099.
Revision 1.1.1.1 1997/11/27 08:32:53 michael
FPC Compiler CVS start
Pre-CVS log:
FK Florian Klaempfl
+ feature added
- removed
* bug fixed or changed
History:
8th october 1997:
+ only a cmpb $0,_S is generated if s is a string and a
s='' or s<>'' is performed (FK)
17th october 1997:
+ unit started (CEC)
} }

9
compiler/cga68k.pas
View File

@ -76,6 +76,10 @@ unit cga68k;
uses uses
systems,globals,verbose,files,types,pbase, systems,globals,verbose,files,types,pbase,
tgen68k,hcodegen,temp_gen tgen68k,hcodegen,temp_gen
{$ifndef OLDPPU}
,ppu
{$endif}
{$ifdef GDB} {$ifdef GDB}
,gdb ,gdb
{$endif} {$endif}
@ -1216,7 +1220,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.6 1998-06-08 13:13:39 pierre Revision 1.7 1998-07-10 10:51:01 peter
* m68k updates
Revision 1.6 1998/06/08 13:13:39 pierre
+ temporary variables now in temp_gen.pas unit + temporary variables now in temp_gen.pas unit
because it is processor independent because it is processor independent
* mppc68k.bat modified to undefine i386 and support_mmx * mppc68k.bat modified to undefine i386 and support_mmx

96
compiler/ra68kmot.pas
View File

@ -236,15 +236,11 @@ var
{* INIT TOKEN TO NOTHING *} {* INIT TOKEN TO NOTHING *}
token := AS_NONE; token := AS_NONE;
{ while space and tab , continue scan... } { while space and tab , continue scan... }
while (c = ' ') or (c = #9) do while c in [' ',#9] do
begin c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
c := asmgetchar; {$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
end;
{ Possiblities for first token in a statement: } { Possiblities for first token in a statement: }
{ Local Label, Label, Directive, Prefix or Opcode.... } { Local Label, Label, Directive, Prefix or Opcode.... }
tokenpos.line:=current_module^.current_inputfile^.line_no;
tokenpos.column:=get_file_col;
tokenpos.fileindex:=current_module^.current_index;
if firsttoken and not (c in [newline,#13,'{',';']) then if firsttoken and not (c in [newline,#13,'{',';']) then
begin begin
@ -253,7 +249,7 @@ var
begin begin
token := AS_LLABEL; { this is a local label } token := AS_LLABEL; { this is a local label }
{ Let us point to the next character } { Let us point to the next character }
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
@ -263,7 +259,7 @@ var
{ if there is an at_sign, then this must absolutely be a label } { if there is an at_sign, then this must absolutely be a label }
if c = '@' then forcelabel:=TRUE; if c = '@' then forcelabel:=TRUE;
actasmpattern := actasmpattern + c; actasmpattern := actasmpattern + c;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
uppervar(actasmpattern); uppervar(actasmpattern);
@ -275,7 +271,7 @@ var
AS_LLABEL: ; { do nothing } AS_LLABEL: ; { do nothing }
end; { end case } end; { end case }
{ let us point to the next character } { let us point to the next character }
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
gettoken := token; gettoken := token;
exit; exit;
end; end;
@ -311,11 +307,11 @@ var
{ - @Result, @Code or @Data special variables. } { - @Result, @Code or @Data special variables. }
begin begin
actasmpattern := c; actasmpattern := c;
c:= asmgetchar; c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do
begin begin
actasmpattern := actasmpattern + c; actasmpattern := actasmpattern + c;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
uppervar(actasmpattern); uppervar(actasmpattern);
gettoken := AS_ID; gettoken := AS_ID;
@ -324,11 +320,11 @@ var
{ identifier, register, opcode, prefix or directive } { identifier, register, opcode, prefix or directive }
'A'..'Z','a'..'z','_': begin 'A'..'Z','a'..'z','_': begin
actasmpattern := c; actasmpattern := c;
c:= asmgetchar; c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
while c in ['A'..'Z','a'..'z','0'..'9','_','.'] do while c in ['A'..'Z','a'..'z','0'..'9','_','.'] do
begin begin
actasmpattern := actasmpattern + c; actasmpattern := actasmpattern + c;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
uppervar(actasmpattern); uppervar(actasmpattern);
@ -354,7 +350,7 @@ var
end; end;
{ override operator... not supported } { override operator... not supported }
'&': begin '&': begin
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
gettoken := AS_AND; gettoken := AS_AND;
end; end;
{ string or character } { string or character }
@ -365,7 +361,7 @@ var
begin begin
if c = '''' then if c = '''' then
begin begin
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
if c=newline then if c=newline then
begin begin
Message(scan_f_string_exceeds_line); Message(scan_f_string_exceeds_line);
@ -374,11 +370,11 @@ var
repeat repeat
if c=''''then if c=''''then
begin begin
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
if c='''' then if c='''' then
begin begin
actasmpattern:=actasmpattern+''''; actasmpattern:=actasmpattern+'''';
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
if c=newline then if c=newline then
begin begin
Message(scan_f_string_exceeds_line); Message(scan_f_string_exceeds_line);
@ -390,7 +386,7 @@ var
else else
begin begin
actasmpattern:=actasmpattern+c; actasmpattern:=actasmpattern+c;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
if c=newline then if c=newline then
begin begin
Message(scan_f_string_exceeds_line); Message(scan_f_string_exceeds_line);
@ -406,101 +402,101 @@ var
exit; exit;
end; end;
'$' : begin '$' : begin
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
while c in ['0'..'9','A'..'F','a'..'f'] do while c in ['0'..'9','A'..'F','a'..'f'] do
begin begin
actasmpattern := actasmpattern + c; actasmpattern := actasmpattern + c;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
gettoken := AS_HEXNUM; gettoken := AS_HEXNUM;
exit; exit;
end; end;
',' : begin ',' : begin
gettoken := AS_COMMA; gettoken := AS_COMMA;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'(' : begin '(' : begin
gettoken := AS_LPAREN; gettoken := AS_LPAREN;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
')' : begin ')' : begin
gettoken := AS_RPAREN; gettoken := AS_RPAREN;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
':' : begin ':' : begin
gettoken := AS_COLON; gettoken := AS_COLON;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
{ '.' : begin { '.' : begin
gettoken := AS_DOT; gettoken := AS_DOT;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; } end; }
'+' : begin '+' : begin
gettoken := AS_PLUS; gettoken := AS_PLUS;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'-' : begin '-' : begin
gettoken := AS_MINUS; gettoken := AS_MINUS;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'*' : begin '*' : begin
gettoken := AS_STAR; gettoken := AS_STAR;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'/' : begin '/' : begin
gettoken := AS_SLASH; gettoken := AS_SLASH;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'<' : begin '<' : begin
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
{ invalid characters } { invalid characters }
if c <> '<' then if c <> '<' then
Message(assem_e_invalid_char_smaller); Message(assem_e_invalid_char_smaller);
{ still assume << } { still assume << }
gettoken := AS_SHL; gettoken := AS_SHL;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'>' : begin '>' : begin
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
{ invalid characters } { invalid characters }
if c <> '>' then if c <> '>' then
Message(assem_e_invalid_char_greater); Message(assem_e_invalid_char_greater);
{ still assume << } { still assume << }
gettoken := AS_SHR; gettoken := AS_SHR;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'|' : begin '|' : begin
gettoken := AS_OR; gettoken := AS_OR;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'^' : begin '^' : begin
gettoken := AS_XOR; gettoken := AS_XOR;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'#' : begin '#' : begin
gettoken:=AS_APPT; gettoken:=AS_APPT;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
exit; exit;
end; end;
'%' : begin '%' : begin
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
while c in ['0','1'] do while c in ['0','1'] do
Begin Begin
actasmpattern := actasmpattern + c; actasmpattern := actasmpattern + c;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
gettoken := AS_BINNUM; gettoken := AS_BINNUM;
exit; exit;
@ -508,25 +504,25 @@ var
{ integer number } { integer number }
'0'..'9': begin '0'..'9': begin
actasmpattern := c; actasmpattern := c;
c := asmgetchar; c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
while c in ['0'..'9'] do while c in ['0'..'9'] do
Begin Begin
actasmpattern := actasmpattern + c; actasmpattern := actasmpattern + c;
c:= asmgetchar; c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
end; end;
gettoken := AS_INTNUM; gettoken := AS_INTNUM;
exit; exit;
end; end;
';' : begin ';' : begin
repeat repeat
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
until c=newline; until c=newline;
firsttoken := TRUE; firsttoken := TRUE;
gettoken:=AS_SEPARATOR; gettoken:=AS_SEPARATOR;
end; end;
'{',#13,newline : begin '{',#13,newline : begin
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
firsttoken := TRUE; firsttoken := TRUE;
gettoken:=AS_SEPARATOR; gettoken:=AS_SEPARATOR;
end; end;
@ -753,6 +749,7 @@ var
if fits then if fits then
Begin Begin
case instr.numops of case instr.numops of
0: 0:
if instr.stropsize <> S_NO then if instr.stropsize <> S_NO then
p^.concat(new(pai68k,op_none(instruc,instr.stropsize))) p^.concat(new(pai68k,op_none(instruc,instr.stropsize)))
@ -760,6 +757,10 @@ var
p^.concat(new(pai68k,op_none(instruc,S_NO))); p^.concat(new(pai68k,op_none(instruc,S_NO)));
1: Begin 1: Begin
case instr.operands[1].operandtype of case instr.operands[1].operandtype of
OPR_SYMBOL: Begin
p^.concat(new(pai68k,op_ref(instruc,
instr.stropsize, newreference(instr.operands[1].ref))));
end;
OPR_CONSTANT: Begin OPR_CONSTANT: Begin
p^.concat(new(pai68k,op_const(instruc, p^.concat(new(pai68k,op_const(instruc,
instr.stropsize, instr.operands[1].val))); instr.stropsize, instr.operands[1].val)));
@ -1679,6 +1680,8 @@ var
Begin Begin
InitAsmRef(instr); InitAsmRef(instr);
instr.operands[operandnum].ref.offset:=BuildRefExpression; instr.operands[operandnum].ref.offset:=BuildRefExpression;
{ negate because was preceded by a negative sign! }
instr.operands[operandnum].ref.offset:=-instr.operands[operandnum].ref.offset;
BuildReference(instr); BuildReference(instr);
end end
else else
@ -2030,7 +2033,7 @@ var
store_p:=p; store_p:=p;
{ setup label linked list } { setup label linked list }
labellist.init; labellist.init;
c:=asmgetchar; c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
actasmtoken:=gettoken; actasmtoken:=gettoken;
while actasmtoken<>AS_END do while actasmtoken<>AS_END do
Begin Begin
@ -2174,7 +2177,10 @@ Begin
end. end.
{ {
$Log$ $Log$
Revision 1.2 1998-06-24 14:06:39 peter Revision 1.3 1998-07-10 10:51:02 peter
* m68k updates
Revision 1.2 1998/06/24 14:06:39 peter
* fixed the name changes * fixed the name changes
Revision 1.1 1998/06/23 14:00:20 peter Revision 1.1 1998/06/23 14:00:20 peter

73
compiler/symdef.inc
View File

@ -204,12 +204,14 @@
if assigned(sym) then if assigned(sym) then
begin begin
name := sym^.name; name := sym^.name;
{$ifdef NEWINPUT} {$ifdef NEWINPUT}
sym_line_no:=sym^.fileinfo.line; sym_line_no:=sym^.fileinfo.line;
{$else} {$else}
sym_line_no:=sym^.line_no; sym_line_no:=sym^.line_no;
{$endif} {$endif}
end end
else else
@ -853,22 +855,22 @@
procedure tfiledef.setsize; procedure tfiledef.setsize;
begin begin
{$ifdef i386} {$ifdef i386}
case target_info.target of case target_info.target of
target_LINUX: target_LINUX : begin
begin case filetype of
case filetype of ft_text : savesize:=432;
ft_text : savesize:=432; ft_typed,
ft_typed,ft_untyped : savesize:=304; ft_untyped : savesize:=304;
end; end;
end; end;
target_Win32: target_Win32 : begin
begin case filetype of
case filetype of ft_text : savesize:=434;
ft_text : savesize:=434; ft_typed,
ft_typed,ft_untyped : savesize:=306; ft_untyped : savesize:=306;
end; end;
end end;
else else
begin begin
case filetype of case filetype of
@ -876,16 +878,28 @@
ft_typed,ft_untyped : savesize:=128; ft_typed,ft_untyped : savesize:=128;
end; end;
end; end;
end; end;
{$endif} {$endif}
{$ifdef m68k} {$ifdef m68k}
case filetype of case target_info.target of
ft_text : savesize:=256; target_Amiga,
ft_typed, target_Mac68k : begin
ft_untyped : savesize:=128; case filetype of
end; ft_text : savesize:=434;
{$endif} ft_typed,
ft_untyped : savesize:=306;
end;
end;
else
begin
case filetype of
ft_text : savesize:=256;
ft_typed,ft_untyped : savesize:=128;
end;
end;
end;
{$endif}
end; end;
@ -1051,12 +1065,14 @@
if assigned(sym) then if assigned(sym) then
begin begin
st := sym^.name; st := sym^.name;
{$ifdef NEWINPUT} {$ifdef NEWINPUT}
sym_line_no:=sym^.fileinfo.line; sym_line_no:=sym^.fileinfo.line;
{$else} {$else}
sym_line_no:=sym^.line_no; sym_line_no:=sym^.line_no;
{$endif} {$endif}
end end
else else
@ -2658,9 +2674,8 @@
{ {
$Log$ $Log$
Revision 1.17 1998-07-10 00:00:03 peter Revision 1.18 1998-07-10 10:51:04 peter
* fixed ttypesym bug finally * m68k updates
* fileinfo in the symtable and better using for unused vars
Revision 1.16 1998/07/07 11:20:13 peter Revision 1.16 1998/07/07 11:20:13 peter
+ NEWINPUT for a better inputfile and scanner object + NEWINPUT for a better inputfile and scanner object

35
compiler/temp_gen.pas
View File

@ -106,10 +106,19 @@ unit temp_gen;
procedure setfirsttemp(l : longint); procedure setfirsttemp(l : longint);
begin begin
{ generates problems { this is a negative value normally }
if (l mod 4 <> 0) then dec(l,l mod 4);} if l < 0 then
Begin
if odd(l) then
Dec(l);
end
else
Begin
if odd(l) then
Inc(l);
end;
firsttemp:=l; firsttemp:=l;
maxtemp := l; maxtemp:=l;
lastoccupied:=l; lastoccupied:=l;
end; end;
@ -194,9 +203,21 @@ unit temp_gen;
function gettempsize : longint; function gettempsize : longint;
begin begin
{$ifdef i386}
{ align local data to dwords } { align local data to dwords }
if (maxtemp mod 4)<>0 then if (maxtemp mod 4)<>0 then
dec(maxtemp,4+(maxtemp mod 4)); dec(maxtemp,4+(maxtemp mod 4));
{$endif}
{$ifdef m68k}
{ we only push words and we want to stay on }
{ even stack addresses }
{ maxtemp is negative }
if (maxtemp mod 2)<>0 then
dec(maxtemp);
{$endif}
gettempsize:=-maxtemp; gettempsize:=-maxtemp;
end; end;
@ -242,7 +263,8 @@ unit temp_gen;
' at pos '+tostr(pos)+ ' not found !'); ' at pos '+tostr(pos)+ ' not found !');
{$endif} {$endif}
end; end;
procedure ungetpersistanttemp(pos : longint;size : longint); procedure ungetpersistanttemp(pos : longint;size : longint);
var var
prev,hp : pfreerecord; prev,hp : pfreerecord;
@ -426,7 +448,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-06-08 16:07:41 pierre Revision 1.2 1998-07-10 10:51:05 peter
* m68k updates
Revision 1.1 1998/06/08 16:07:41 pierre
* temp_gen contains all temporary var functions * temp_gen contains all temporary var functions
(processor independent) (processor independent)