Implement conversions from long long to other types in the optimizer.

The code of PeepHoleOptimization is now big enough that it triggers bogus "Relative address out of range" range errors from the linker. This is a linker bug and should be fixed there.
This commit is contained in:
Stephen Heumann 2021-02-18 23:27:18 -06:00
parent 3e5aa5b7b0
commit 5ed820717e
4 changed files with 229 additions and 13 deletions

68
CGC.asm
View File

@ -139,6 +139,74 @@ CnvXULL start cg
return return
end end
****************************************************************
*
* function CnvLLX (val: longlong): extended;
*
* convert a long long to a real number
*
* Inputs:
* val - the long long value
*
****************************************************************
CnvLLX start cg
subroutine (4:val),0
ph8 [val]
jsl ~CnvLongLongReal
pla
sta >rval
pla
sta >rval+2
pla
sta >rval+4
pla
sta >rval+6
pla
sta >rval+8
lla val,rval
return 4:val
rval ds 10
end
****************************************************************
*
* function CnvULLX (val: longlong): extended;
*
* convert an unsigned long long to a real number
*
* Inputs:
* val - the unsigned long long value
*
****************************************************************
CnvULLX start cg
subroutine (4:val),0
ph8 [val]
jsl ~CnvULongLongReal
pla
sta >rval
pla
sta >rval+2
pla
sta >rval+4
pla
sta >rval+6
pla
sta >rval+8
lla val,rval
return 4:val
rval ds 10
end
datachk off datachk off
**************************************************************** ****************************************************************
* *

View File

@ -359,3 +359,79 @@
.j .j
rtl rtl
mend mend
macro
&l lla &ad1,&ad2
&l anop
lcla &lb
lclb &la
aif s:longa,.a
rep #%00100000
longa on
&la setb 1
.a
lda #&ad2
&lb seta c:&ad1
.b
sta &ad1(&lb)
&lb seta &lb-1
aif &lb,^b
lda #^&ad2
&lb seta c:&ad1
.c
sta 2+&ad1(&lb)
&lb seta &lb-1
aif &lb,^c
aif &la=0,.d
sep #%00100000
longa off
.d
mend
macro
&l ph8 &n1
lclc &c
&l anop
&c amid &n1,1,1
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"="#",.d
aif "&c"="[",.b
aif "&c"<>"{",.c
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
&n1 setc (&n1)
.b
ldy #6
~&SYSCNT lda &n1,y
pha
dey
dey
bpl ~&SYSCNT
ago .e
.c
ldx #6
~&SYSCNT lda &n1,x
pha
dex
dex
bpl ~&SYSCNT
ago .e
.d
&n1 amid &n1,2,l:&n1-1
bra ~b&SYSCNT
~a&SYSCNT dc i8"&n1"
~b&SYSCNT ldx #6
~c&SYSCNT lda ~a&SYSCNT,x
pha
dex
dex
bpl ~c&SYSCNT
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend

16
CGC.pas
View File

@ -85,6 +85,22 @@ procedure CnvXULL (var result: longlong; val: extended); extern;
{ val - the real value } { val - the real value }
function CnvLLX (val: longlong): extended; extern;
{ convert a long long to a real number }
{ }
{ parameters: }
{ val - the long long value }
function CnvULLX (val: longlong): extended; extern;
{ convert an unsigned long long to a real number }
{ }
{ parameters: }
{ val - the unsigned long long value }
procedure InitLabels; extern; procedure InitLabels; extern;
{ initialize the labels array for a procedure } { initialize the labels array for a procedure }

82
DAG.pas
View File

@ -1128,6 +1128,7 @@ case op^.opcode of {check for optimizations of this node}
op^.q := (op^.q & $FF0F) | (fromtype.i << 4); op^.q := (op^.q & $FF0F) | (fromtype.i << 4);
end; {if} end; {if}
if op^.left^.opcode = pc_ldc then begin if op^.left^.opcode = pc_ldc then begin
doit := true;
case fromtype.optype of case fromtype.optype of
cgByte,cgWord: cgByte,cgWord:
case totype.optype of case totype.optype of
@ -1217,6 +1218,60 @@ case op^.opcode of {check for optimizations of this node}
end; end;
otherwise: ; otherwise: ;
end; {case} end; {case}
cgQuad:
case totype.optype of
cgByte,cgUByte,cgWord,cgUWord: begin
q := long(op^.left^.qval.lo).lsw;
op^.left^.qval := longlong0;
op^.left^.q := q;
end;
cgLong, cgULong: begin
lval := op^.left^.qval.lo;
op^.left^.qval := longlong0;
op^.left^.lval := lval;
end;
cgQuad,cgUQuad: ;
cgDouble,cgExtended: begin
{only convert values exactly representable in double}
rval := CnvLLX(op^.left^.qval);
if rval = CnvLLX(op^.left^.qval) then begin
op^.left^.qval := longlong0;
op^.left^.rval := rval;
end {if}
else
doit := false;
end;
cgReal,cgComp:
doit := false;
otherwise: ;
end; {case}
cgUQuad:
case totype.optype of
cgByte,cgUByte,cgWord,cgUWord: begin
q := long(op^.left^.qval.lo).lsw;
op^.left^.qval := longlong0;
op^.left^.q := q;
end;
cgLong, cgULong: begin
lval := op^.left^.qval.lo;
op^.left^.qval := longlong0;
op^.left^.lval := lval;
end;
cgQuad,cgUQuad: ;
cgDouble,cgExtended: begin
{only convert values exactly representable in double}
rval := CnvULLX(op^.left^.qval);
if rval = CnvULLX(op^.left^.qval) then begin
op^.left^.qval := longlong0;
op^.left^.rval := rval;
end {if}
else
doit := false;
end;
cgReal,cgComp:
doit := false;
otherwise: ;
end; {case}
cgReal,cgDouble,cgComp,cgExtended: begin cgReal,cgDouble,cgComp,cgExtended: begin
rval := op^.left^.rval; rval := op^.left^.rval;
case totype.optype of case totype.optype of
@ -1294,21 +1349,22 @@ case op^.opcode of {check for optimizations of this node}
end; {case} end; {case}
otherwise: ; otherwise: ;
end; {case} end; {case}
if fromtype.optype in if doit then
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble, if fromtype.optype in
cgComp,cgExtended] then
if totype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad, [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
cgReal,cgDouble,cgComp,cgExtended] then begin cgReal,cgDouble,cgComp,cgExtended] then
op^.left^.optype := totype.optype; if totype.optype in
if totype.optype in [cgByte,cgUByte] then begin [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
op^.left^.q := op^.left^.q & $00FF; cgReal,cgDouble,cgComp,cgExtended] then begin
if totype.optype = cgByte then op^.left^.optype := totype.optype;
if (op^.left^.q & $0080) <> 0 then if totype.optype in [cgByte,cgUByte] then begin
op^.left^.q := op^.left^.q | $FF00; op^.left^.q := op^.left^.q & $00FF;
if totype.optype = cgByte then
if (op^.left^.q & $0080) <> 0 then
op^.left^.q := op^.left^.q | $FF00;
end; {if}
opv := op^.left;
end; {if} end; {if}
opv := op^.left;
end; {if}
end {if} end {if}
else if op^.left^.opcode = pc_cnv then begin else if op^.left^.opcode = pc_cnv then begin
doit := false; doit := false;