Apple-2gs-SW
/
ORCA-C
mirror of https://github.com/byteworksinc/ORCA-C.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
CGC.asm
View File

@ -139,6 +139,74 @@ CnvXULL start cg
return
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
****************************************************************
*

76
CGC.macros
View File

@ -359,3 +359,79 @@
.j
rtl
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 }
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;
{ 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);
end; {if}
if op^.left^.opcode = pc_ldc then begin
doit := true;
case fromtype.optype of
cgByte,cgWord:
case totype.optype of
@ -1217,6 +1218,60 @@ case op^.opcode of {check for optimizations of this node}
end;
otherwise: ;
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
rval := op^.left^.rval;
case totype.optype of
@ -1294,21 +1349,22 @@ case op^.opcode of {check for optimizations of this node}
end; {case}
otherwise: ;
end; {case}
if fromtype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgReal,cgDouble,
cgComp,cgExtended] then
if totype.optype in
if doit then
if fromtype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
cgReal,cgDouble,cgComp,cgExtended] then begin
op^.left^.optype := totype.optype;
if totype.optype in [cgByte,cgUByte] then begin
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;
cgReal,cgDouble,cgComp,cgExtended] then
if totype.optype in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad,
cgReal,cgDouble,cgComp,cgExtended] then begin
op^.left^.optype := totype.optype;
if totype.optype in [cgByte,cgUByte] then begin
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}
opv := op^.left;
end; {if}
end {if}
else if op^.left^.opcode = pc_cnv then begin
doit := false;