Skip to content

Commit

Permalink
Add files via upload
Browse files Browse the repository at this point in the history
  • Loading branch information
@tebe6502
tebe6502 committed Apr 11, 2022
1 parent 6c96aec commit 58dcaac
Show file tree
Hide file tree
Showing 2 changed files with 85 additions and 91 deletions.
3 changes: 3 additions & 0 deletions src/CHANGELOG
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,6 @@
10.04.2022
- modyfikator REGISTER dla funkcji spowoduje alokację wartości funkcji na stronie zerowej (typy proste)

09.04.2022
- poprawiona funkcja 'CardToHalf' przeliczająca stałe na typ Float16 ('if frac(s) <> 0 then Result := f32Tof16(Src)')

Expand Down
173 changes: 82 additions & 91 deletions src/mp.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2368,6 +2368,7 @@ procedure OptimizeTemporaryBuf;
end;
}


if (pos('lda ', TemporaryBuf[0]) > 0) and // lda I ; 0
(pos('cmp ', TemporaryBuf[1]) > 0) and // cmp ; 1
SKIP(2) and // SKIP ; 2
Expand Down Expand Up @@ -10458,7 +10459,7 @@ TStackBuf = record


function OptimizeEAX: Boolean;
var i: integer;
var p,i: integer;
tmp: string;
begin

Expand Down Expand Up @@ -10539,9 +10540,8 @@ function OptimizeEAX: Boolean;
for i := 0 to l - 1 do
if (listing[i] <> '') then begin


{
if (pos('fmulinit', listing[i]) > 0) then begin
if (pos('lda :STACKORIGIN+12', listing[i]) > 0) then begin

for p:=0 to l-1 do writeln(listing[p]);
writeln('-------');
Expand All @@ -10565,10 +10565,10 @@ function OptimizeEAX: Boolean;
listing[i] := copy(listing[i], 1, 5) + copy(listing[p-1], 6, 256);

if sta(p+1) then
listing[p] := ''
//listing[p] := ''
else begin
listing[p-1] := '';
listing[p] := '';
//listing[p-1] := '';
//listing[p] := '';
end;

Result:=false; Break;
Expand Down Expand Up @@ -11185,6 +11185,20 @@ function OptimizeEAX: Boolean;

// -----------------------------------------------------------------------------

if lda_stack(i) and // lda :STACKORIGIN ; 0
sta_stack(i+1) and // sta :STACKORIGIN+STACKWIDTH ; 1
lda_a(i+2) and (lda_stack(i+2) = false) and // lda ; 2
add_stack(i+3) and // add :STACKORIGIN+STACKWIDTH ; 3
tay(i+4) then // tay ; 4
if (copy(listing[i+1], 6, 256) = copy(listing[i+3], 6, 256)) then
begin
listing[i+1] := '';
listing[i+2] := #9'add ' + copy(listing[i+2], 6, 256);
listing[i+3] := '';

Result:=false; Break;
end;


if add_sub(i) and // add|sub ; 0
sta_stack(i+1) and // sta :STACKORIGIN+9 ; 1
Expand Down Expand Up @@ -11794,37 +11808,6 @@ function OptimizeEAX: Boolean;
end;


if lda(i) and // lda ; 0
adc_sbc(i+1) and // adc|sbc ; 1
sta_eax_1(i+2) and // sta :eax+1 ; 2
lda(i+3) and // lda ; 3
add_sub(i+4) and (pos(' :eax', listing[i+4]) > 0) and // add|sub :eax ; 4
sta(i+5) and // sta ; 5
(lda(i+6) = false) then // ~lda ; 6
begin
listing[i] := '';
listing[i+1] := '';
listing[i+2] := '';

Result:=false; Break;
end;


if lda(i) and // lda ; 0
adc_sbc(i+1) and // adc|sbc ; 1
sta_eax_1(i+2) and // sta :eax+1 ; 2
(listing[i+3] = #9'lda :eax') and // lda :eax ; 3
sta(i+4) and // sta ; 4
(lda(i+5) = false) then // ~lda ; 5
begin
listing[i] := '';
listing[i+1] := '';
listing[i+2] := '';

Result:=false; Break;
end;


if asl_stack(i) and // asl :STACKORIGIN+9 ; 0
rol_stack(i+1) and // rol :STACKORIGIN+STACKWIDTH+9 ; 1
rol_stack(i+2) and // rol :STACKORIGIN+STACKWIDTH*2+9 ; 2
Expand Down Expand Up @@ -13619,7 +13602,7 @@ function OptimizeEAX: Boolean;


{
if (pos('asl :STACK', listing[i]) > 0) and (pos('rol :STACK', listing[i+1]) > 0) then begin
if (pos('lda :STACKORIGIN+12', listing[i]) > 0) then begin

for p:=0 to l-1 do writeln(listing[p]);
writeln('-------');
Expand Down Expand Up @@ -15588,68 +15571,41 @@ function OptimizeEAX: Boolean;
end;


// -----------------------------------------------------------------------------
// lda adr.L_BLOCK,y ; 0
// sta :STACKORIGIN+9 ; 1
// lda adr.H_BLOCK,y ; 2
// sta :STACKORIGIN+STACKWIDTH+10 ; 3
// lda #$00 ; 4
// add :STACKORIGIN+9 ; 5
// sta TB ; 6
// lda #$00 ; 7
// adc :STACKORIGIN+STACKWIDTH+10 ; 8
// sta TB+1 ; 9


if (skip(i-1) = false) and
lda_a(i) and (iy(i) = false) and
sta_stack(i+1) and (sta_stack(i+2) = false) and
(add_sub_stack(i+4) or adc_sbc_stack(i+4)) then
if (copy(listing[i+1], 6, 256) = copy(listing[i+4], 6, 256)) and
(pos(copy(listing[i+1], 6, 256), listing[i+2]) = 0) and
(pos(copy(listing[i+1], 6, 256), listing[i+3]) = 0) then
begin
listing[i+4] := copy(listing[i+4], 1, 5) + copy(listing[i], 6, 256);
listing[i] := '';
listing[i+1] := '';

Result:=false; Break;
end;

if lda(i) and (iy(i) = false) and (lda_stack(i) = false) and // lda ; 0
sta_stack(i+1) and // sta :STACKORIGIN+STACKWIDTH ; 1
lda_a(i+2) and (lda_stack(i+2) = false) and // lda ; 2
add_sub_stack(i+3) and // add|sub :STACKORIGIN ; 3
tay(i+4) and // tay ; 4
lda(i+5) and (lda_stack(i+5) = false) and // lda ; 5
adc_sbc_stack(i+6) then // adc|sbc :STACKORIGIN+STACKWIDTH ; 6
if (copy(listing[i+1], 6, 256) = copy(listing[i+6], 6, 256)) then
begin
listing[i+6] := copy(listing[i+6], 1, 5) + copy(listing[i], 6, 256);

if (skip(i-1) = false) and
lda_a(i) and (iy(i) = false) and
sta_stack(i+1) and (sta_stack(i+2) = false) and
(add_sub_stack(i+5) or adc_sbc_stack(i+5)) then
if (copy(listing[i+1], 6, 256) = copy(listing[i+5], 6, 256)) and
(pos(copy(listing[i+1], 6, 256), listing[i+2]) = 0) and
(pos(copy(listing[i+1], 6, 256), listing[i+3]) = 0) and
(pos(copy(listing[i+1], 6, 256), listing[i+4]) = 0) then
begin
listing[i+5] := copy(listing[i+5], 1, 5) + copy(listing[i], 6, 256);
listing[i] := '';
listing[i+1] := '';

Result:=false; Break;
end;
Result:=false; Break;
end;


if (skip(i-1) = false) and
lda_a(i) and (iy(i) = false) and
sta_stack(i+1) and (sta_stack(i+2) = false) and
(add_sub_stack(i+6) or adc_sbc_stack(i+6)) then
if (copy(listing[i+1], 6, 256) = copy(listing[i+6], 6, 256)) and
(pos(copy(listing[i+1], 6, 256), listing[i+2]) = 0) and
(pos(copy(listing[i+1], 6, 256), listing[i+3]) = 0) and
(pos(copy(listing[i+1], 6, 256), listing[i+4]) = 0) and
(pos(copy(listing[i+1], 6, 256), listing[i+5]) = 0) then
begin
if lda_stack(i) and // lda :STACKORIGIN+STACKWIDHT*2 ; 0
sta_stack(i+1) and // sta :STACKORIGIN+STACKWIDTH ; 1
lda_a(i+2) and (lda_stack(i+2) = false) and // lda ; 2
add_sub_stack(i+3) and // add|sub :STACKORIGIN ; 3
tay(i+4) and // tay ; 4
lda(i+5) and (lda_stack(i+5) = false) and // lda ; 5
adc_sbc_stack(i+6) then // adc|sbc :STACKORIGIN+STACKWIDTH ; 6
if (copy(listing[i], 6, 256) <> copy(listing[i+3], 6, 256)) and
(copy(listing[i+1], 6, 256) = copy(listing[i+6], 6, 256)) then
begin
listing[i+6] := copy(listing[i+6], 1, 5) + copy(listing[i], 6, 256);

listing[i] := '';
listing[i+1] := '';

Result:=false; Break;
end;
Result:=false; Break;
end;


if lda_a(i) and (iy(i) = false) and // lda ; 0
Expand Down Expand Up @@ -22857,6 +22813,28 @@ function OptimizeEAX: Boolean;
end;


if lda_im_0(i) and // lda #$00 ; 0
add(i+1) and // add ; 1
sta_a(i+2) and // sta :STACKORIGIN+9 ; 2
lda_a(i+3) and // lda ; 3
adc_im_0(i+4) and // adc #$00 ; 4
sta_a(i+5) and // sta :STACKORIGIN+STACKWIDTH ; 5
lda_a(i+6) and // lda ; 6
adc_im_0(i+7) and // adc #$00 ; 7
sta_a(i+8) and // sta :STACKORIGIN+STACKWIDTH ; 8
(adc(i+10) = false) then //~adc ; 7
begin
listing[i] := '';
listing[i+1] := #9'lda ' + copy(listing[i+1], 6, 256);

listing[i+4] := '';

listing[i+7] := '';

Result:=false; Break;
end;


if lda_a(i) and // lda :STACKORIGIN+9 ; 0
add_im_0(i+1) and // add #$00 ; 1
sta_a(i+2) and // sta :STACKORIGIN+9 ; 2
Expand Down Expand Up @@ -40406,6 +40384,9 @@ procedure CompileActualParameters(var i: integer; IdentIndex: integer; ProcVarIn

(*------------------------------------------------------------------------------------------------------------*)

// if Ident[IdentIndex].isUnresolvedForward then begin
// Error(i, 'Unresolved forward declaration of ' + Ident[IdentIndex].Name);


if Ident[IdentIndex].isOverload then
svar := GetLocalName(IdentIndex) + '_' + IntToHex(Ident[IdentIndex].Value, 4)
Expand Down Expand Up @@ -47931,9 +47912,19 @@ function CompileBlock(i: Integer; BlockIdentIndex: Integer; NumParams: Integer;


// Allocate Result variable if the current block is a function
if IsFunction then begin //DefineIdent(i, 'RESULT', VARIABLE, FunctionResultType, 0, 0, 0);
if IsFunction then begin //DefineIdent(i, 'RESULT', VARIABLE, FunctionResultType, 0, 0, 0);

tmpVarDataSize := VarDataSize;

DefineIdent(i, 'RESULT', VARIABLE, FunctionResultType, FunctionNumAllocElements, FunctionAllocElementType, 0);

if isReg and (FunctionResultType in OrdinalTypes + RealTypes) then begin
Ident[NumIdent].isAbsolute := true;
Ident[NumIdent].Value := $87000000; // :STACKORIGIN-4 -> :TMP

VarDataSize := tmpVarDataSize;
end;

if FunctionResultType in [RECORDTOK, OBJECTTOK] then
for j := 1 to Types[FunctionNumAllocElements].NumFields do begin

Expand Down

0 comments on commit 58dcaac

Please sign in to comment.