paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 09:29:07 +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;
var
{$ifdef NEWINPUT}
infile : pinputfile;
{$else}
infile : pextfile;
{$endif}
includecount,lastline : longint;
function double2str(d : double) : string;
@ -207,10 +213,10 @@ unit ag68kgas;
var
{$ifdef GDB}
n_line : byte;
{$endif}
lastsec : tsection;
lastsecidx : longint;
const
@ -246,9 +252,14 @@ unit ag68kgas;
{$ifdef GDB}
if cs_debuginfo in aktswitches then
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
{$ifdef NEWINPUT}
if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile) then
{$else}
if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
{$endif NEWINPUT}
begin
infile:=hp^.infile;
inc(includecount);
@ -331,10 +342,6 @@ unit ag68kgas;
end;
ait_const_32bit, { alignment is required for 16/32 bit data! }
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));
consttyp:=hp^.typ;
l:=0;
@ -367,39 +374,19 @@ unit ag68kgas;
AsmLn;
end;
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)));
end;
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));
end;
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));
end;
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));
{ comp type is difficult to write so use double }
end;
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));
end;
ait_direct : begin
@ -443,6 +430,15 @@ unit ag68kgas;
end;
end;
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
AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
end;
@ -475,10 +471,14 @@ ait_labeled_instruction : begin
end;
ait_instruction : begin
{ 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
s:=#9+mot_op2str[pai68k(hp)^._operator]+gas_opsize2str[pai68k(hp)^.size]
if (pai68k(hp)^._operator in [
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
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
begin
{ call and jmp need an extra handling }
@ -526,21 +526,27 @@ ait_labeled_instruction : begin
end;
ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
{$endif GDB}
{$ifdef SMARTLINK}
ait_cut : begin { used to split into tiny assembler files }
if (cs_smartlink in aktswitches) then
ait_cut : begin
{ create only a new file when the last is not empty }
if AsmSize>0 then
begin
AsmClose;
DoAssemble;
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;
{ 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;
{$endif SMARTLINK}
else
internalerror(10000);
end;
@ -584,8 +590,13 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end;
infile:=current_module^.sourcefiles.files;
{ main source file is last in list }
{$ifdef NEWINPUT}
while assigned(infile^.next) do
infile:=infile^.next;
{$else}
while assigned(infile^._next) do
infile:=infile^._next;
{$endif}
lastline:=0;
{$endif GDB}
@ -612,7 +623,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end.
{
$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
Revision 1.4 1998/06/04 23:51:28 peter

84
compiler/ag68kmit.pas
View File

@ -55,7 +55,13 @@ unit ag68kmit;
{$ifdef GDB}
var
{$ifdef NEWINPUT}
infile : pinputfile;
{$else}
infile : pextfile;
{$endif}
includecount,
lastline : longint;
{$endif GDB}
@ -250,6 +256,7 @@ unit ag68kmit;
n_line : byte; { different types of source lines }
{$endif}
lastsec : tsection; { last section type written }
lastsecidx : longint;
const
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
@ -284,9 +291,14 @@ unit ag68kmit;
{$ifdef GDB}
if cs_debuginfo in aktswitches then
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
{$ifdef NEWINPUT}
if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile) then
{$else}
if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
{$endif NEWINPUT}
begin
infile:=hp^.infile;
inc(includecount);
@ -367,10 +379,6 @@ unit ag68kmit;
end;
ait_const_32bit, { alignment is required for 16/32 bit data! }
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));
consttyp:=hp^.typ;
l:=0;
@ -402,42 +410,20 @@ unit ag68kmit;
until (not found) or (l>line_length);
AsmLn;
end;
ait_const_symbol : begin
if not(cs_littlesize in aktswitches) then
AsmWriteLn(#9#9'.align 4')
else
AsmWriteLn(#9#9'.align 2');
AsmWrite(#9'.long'#9);
AsmWritePChar(pchar(pai_const(hp)^.value));
AsmLn;
ait_const_symbol : Begin
AsmWriteLn(#9'.long'#9+StrPas(pchar(pai_const(hp)^.value)));
end;
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));
end;
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));
end;
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));
{ comp type is difficult to write so use double }
end;
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));
end;
ait_direct : begin
@ -481,6 +467,15 @@ unit ag68kmit;
end;
end;
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
AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
end;
@ -568,6 +563,27 @@ ait_labeled_instruction : begin
end;
ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
{$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
internalerror(10000);
end;
@ -611,8 +627,13 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end;
infile:=current_module^.sourcefiles.files;
{ main source file is last in list }
{$ifdef NEWINPUT}
while assigned(infile^.next) do
infile:=infile^.next;
{$else}
while assigned(infile^._next) do
infile:=infile^._next;
{$endif}
lastline:=0;
{$endif GDB}
@ -639,7 +660,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
end.
{
$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
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));
end;
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));
end;
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));
end;
ait_const_8bit : AsmWriteLn(#9#9'DC.B'#9+tostr(pai_const(hp)^.value));
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)));
end;
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));
end;
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));
end;
{ TO SUPPORT SOONER OR LATER!!!
@ -411,6 +391,15 @@ unit ag68kmot;
AsmLn;
end;
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));
if assigned(hp^.next) and not(pai(hp^.next)^.typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
@ -521,12 +510,10 @@ ait_labeled_instruction :
Writetree(exportssection);
Writetree(resourcesection);
AsmLn;
AsmWriteLn(#9'END');
AsmLn;
{$ifdef EXTDEBUG}
if assigned(current_module^.mainsource) then
comment(v_info,'Done writing motorola-styled assembler output for '+current_module^.mainsource^);
@ -536,7 +523,10 @@ ait_labeled_instruction :
end.
{
$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
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 secondifn(var p : ptree);
procedure secondbreakn(var p : ptree);
{ copies p a set element on the stack }
procedure pushsetelement(var p : ptree);
{ copies p a set element into the d0.b register }
procedure loadsetelement(var p : ptree);
Implementation
@ -192,13 +192,15 @@ Implementation
{ on the right we do not need the register anymore too }
del_reference(p^.right^.location.reference);
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^.left^.location.reference);
emitcall('STRCONCAT',true);
maybe_loadA5;
popusedregisters(pushedregs);
set_location(p^.location,p^.left^.location);
ungetiftemp(p^.right^.location.reference);
maybe_loada5;
popusedregisters(pushedregs);
end; { this case }
ltn,lten,gtn,gten,
equaln,unequaln :
@ -234,8 +236,22 @@ Implementation
else
begin
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^.right^.location.reference);
emitpushreferenceaddr(p^.right^.location.reference); }
emitcall('STRCMP',true);
maybe_loada5;
popusedregisters(pushedregs);
@ -286,12 +302,13 @@ Implementation
((p^.left^.resulttype^.deftype=orddef) and
(porddef(p^.left^.resulttype)^.typ=u32bit)) or
((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
(psetdef(p^.left^.resulttype)^.settype=smallset)
) then
(psetdef(p^.left^.resulttype)^.settype=smallset))
then
begin
do_normal:
mboverflow:=false;
@ -332,7 +349,6 @@ Implementation
Message(sym_e_type_mismatch);
end;
end;
muln : begin
if is_set then
begin
@ -905,8 +921,13 @@ Implementation
del_reference(p^.left^.location.reference);
del_reference(p^.right^.location.reference);
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);
maybe_loada5;
popusedregisters(pushedregs);
@ -933,6 +954,8 @@ Implementation
newcsymbol('SET_ADD_SETS',0))));
muln : exprasmlist^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,
newcsymbol('SET_MUL_SETS',0))));
symdifn:
emitcall('SET_SYMDIF_SETS',true);
end;
maybe_loada5;
popusedregisters(pushedregs);
@ -1389,25 +1412,30 @@ Implementation
{ copies p a set element on the stack }
procedure pushsetelement(var p : ptree);
{ This routine needs to be further checked to see if it works correctly }
{ 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
hr : tregister;
begin
{ copy the element on the stack, slightly complicated }
{ copy the element in the d0.b register, slightly complicated }
case p^.location.loc of
LOC_REGISTER,
LOC_CREGISTER : begin
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);
end;
else
begin
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
newreference(p^.location.reference),R_SPPUSH)));
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
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);
end;
end;
@ -1491,7 +1519,7 @@ Implementation
end;
end;
analizeset:=true;
end;
end; { end analizeset }
begin
if psetdef(p^.right^.resulttype)^.settype=smallset then
@ -1504,19 +1532,22 @@ Implementation
if codegenerror then
exit;
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
LOC_REGISTER,LOC_CREGISTER : begin
LOC_REGISTER,LOC_CREGISTER :
begin
emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
exprasmlist^.concat(new(pai68k,
op_const_reg(A_AND,S_L, 1 shl
(p^.left^.value and 31),R_D1)));
op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
end;
else
begin
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
p^.right^.location.reference),R_D1)));
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;
del_reference(p^.right^.location.reference);
@ -1545,7 +1576,7 @@ Implementation
{ the set element isn't never samller than a byte }
{ and because it's a small set we need only 5 bits }
{ 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)));
hr:=R_D1;
del_reference(p^.left^.location.reference);
@ -1581,7 +1612,7 @@ Implementation
p^.location.resflags:=F_C;
end;
end
else
else { NOT a small set }
begin
if p^.left^.treetype=ordconstn then
begin
@ -1591,11 +1622,11 @@ Implementation
if codegenerror then
exit;
p^.location.resflags:=F_NE;
inc(p^.right^.location.reference.offset,p^.left^.value shr 3);
exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_B,
inc(p^.right^.location.reference.offset,(p^.left^.value div 32)*4);
exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L,
newreference(p^.right^.location.reference), R_D1)));
exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_B,
1 shl (p^.left^.value and 7),R_D1)));
exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
1 shl (p^.left^.value mod 32),R_D1)));
del_reference(p^.right^.location.reference);
end
else
@ -1614,11 +1645,17 @@ Implementation
LOC_CREGISTER :
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
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;
{Get a label to jump to the end.}
p^.location.loc:=LOC_FLAGS;
{It's better to use the zero flag when there are
no ranges.}
{It's better to use the zero flag when there are no ranges.}
if ranges then
p^.location.resflags:=F_C
else
@ -1638,15 +1675,16 @@ Implementation
href.symbol:=stringdup(lab2str(l2));
if setparts[i].start=setparts[i].stop-1 then
begin
case p^.left^.location.loc of
LOC_REGISTER,
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)));
else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].start,newreference(p^.left^.location.reference))));
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
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;
{Result should be in carry flag when ranges are used.}
{ Here the m68k does not affect any flag except the }
@ -1658,11 +1696,13 @@ Implementation
case p^.left^.location.loc of
LOC_REGISTER,
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)));
else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].stop,newreference(p^.left^.location.reference))));
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
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;
{Result should be in carry flag when ranges are used.}
{ Here the m68k does not affect any flag except the }
@ -1681,11 +1721,13 @@ Implementation
case p^.left^.location.loc of
LOC_REGISTER,
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)));
else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].start,newreference(p^.left^.location.reference))));
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
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;
{If lower, jump to next check.}
emitl(A_BCS,l2);
@ -1697,11 +1739,13 @@ Implementation
case p^.left^.location.loc of
LOC_REGISTER,
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)));
else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].stop+1,newreference(p^.left^.location.reference))));
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
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 }
{If higher, element is in set.}
emitl(A_BCS,l);
@ -1716,11 +1760,13 @@ Implementation
case p^.left^.location.loc of
LOC_REGISTER,
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)));
else
exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
setparts[i].stop,newreference(p^.left^.location.reference))));
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
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;
{Result should be in carry flag when ranges are used.}
if ranges then
@ -1750,27 +1796,20 @@ Implementation
{ of course not commutative }
if p^.swaped then
swaptree(p);
pushsetelement(p^.left);
emitpushreferenceaddr(p^.right^.location.reference);
{ SET_IN_BYTE is an inline assembler procedure instead }
{ 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);
{ registers need not be save. that happens in SET_IN_BYTE }
emitcall('SET_IN_BYTE',true);
{ 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.resflags:=F_C;
end;
@ -1921,7 +1960,10 @@ Implementation
end.
{
$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
because it is processor independent
* mppc68k.bat modified to undefine i386 and support_mmx
@ -1939,111 +1981,4 @@ end.
+ started inline procedures
+ added starstarn : use ** for exponentiation (^ gave problems)
+ 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
systems,globals,verbose,files,types,pbase,
tgen68k,hcodegen,temp_gen
{$ifndef OLDPPU}
,ppu
{$endif}
{$ifdef GDB}
,gdb
{$endif}
@ -1216,7 +1220,10 @@ end;
end.
{
$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
because it is processor independent
* mppc68k.bat modified to undefine i386 and support_mmx

96
compiler/ra68kmot.pas
View File

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

73
compiler/symdef.inc
View File

@ -204,12 +204,14 @@
if assigned(sym) then
begin
name := sym^.name;
{$ifdef NEWINPUT}
{$ifdef NEWINPUT}
sym_line_no:=sym^.fileinfo.line;
{$else}
sym_line_no:=sym^.line_no;
{$endif}
{$endif}
end
else
@ -853,22 +855,22 @@
procedure tfiledef.setsize;
begin
{$ifdef i386}
case target_info.target of
target_LINUX:
begin
case filetype of
ft_text : savesize:=432;
ft_typed,ft_untyped : savesize:=304;
end;
end;
target_Win32:
begin
case filetype of
ft_text : savesize:=434;
ft_typed,ft_untyped : savesize:=306;
end;
end
target_LINUX : begin
case filetype of
ft_text : savesize:=432;
ft_typed,
ft_untyped : savesize:=304;
end;
end;
target_Win32 : begin
case filetype of
ft_text : savesize:=434;
ft_typed,
ft_untyped : savesize:=306;
end;
end;
else
begin
case filetype of
@ -876,16 +878,28 @@
ft_typed,ft_untyped : savesize:=128;
end;
end;
end;
end;
{$endif}
{$ifdef m68k}
case filetype of
ft_text : savesize:=256;
ft_typed,
ft_untyped : savesize:=128;
end;
{$endif}
case target_info.target of
target_Amiga,
target_Mac68k : begin
case filetype of
ft_text : savesize:=434;
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;
@ -1051,12 +1065,14 @@
if assigned(sym) then
begin
st := sym^.name;
{$ifdef NEWINPUT}
{$ifdef NEWINPUT}
sym_line_no:=sym^.fileinfo.line;
{$else}
sym_line_no:=sym^.line_no;
{$endif}
{$endif}
end
else
@ -2658,9 +2674,8 @@
{
$Log$
Revision 1.17 1998-07-10 00:00:03 peter
* fixed ttypesym bug finally
* fileinfo in the symtable and better using for unused vars
Revision 1.18 1998-07-10 10:51:04 peter
* m68k updates
Revision 1.16 1998/07/07 11:20:13 peter
+ 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);
begin
{ generates problems
if (l mod 4 <> 0) then dec(l,l mod 4);}
{ this is a negative value normally }
if l < 0 then
Begin
if odd(l) then
Dec(l);
end
else
Begin
if odd(l) then
Inc(l);
end;
firsttemp:=l;
maxtemp := l;
maxtemp:=l;
lastoccupied:=l;
end;
@ -194,9 +203,21 @@ unit temp_gen;
function gettempsize : longint;
begin
{$ifdef i386}
{ align local data to dwords }
if (maxtemp mod 4)<>0 then
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;
end;
@ -242,7 +263,8 @@ unit temp_gen;
' at pos '+tostr(pos)+ ' not found !');
{$endif}
end;
procedure ungetpersistanttemp(pos : longint;size : longint);
var
prev,hp : pfreerecord;
@ -426,7 +448,10 @@ begin
end.
{
$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
(processor independent)