mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2025-02-06 04:30:13 +00:00
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
parent
3e5aa5b7b0
commit
5ed820717e
68
CGC.asm
68
CGC.asm
@ -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
76
CGC.macros
@ -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
16
CGC.pas
@ -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
82
DAG.pas
@ -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;
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user