From 5ed820717ed14c5eda4c84533c3005ef6c42f6b1 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 18 Feb 2021 23:27:18 -0600 Subject: [PATCH] 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. --- CGC.asm | 68 ++++++++++++++++++++++++++++++++++++++++++++ CGC.macros | 76 ++++++++++++++++++++++++++++++++++++++++++++++++++ CGC.pas | 16 +++++++++++ DAG.pas | 82 +++++++++++++++++++++++++++++++++++++++++++++--------- 4 files changed, 229 insertions(+), 13 deletions(-) diff --git a/CGC.asm b/CGC.asm index 716a217..4b9867f 100644 --- a/CGC.asm +++ b/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 **************************************************************** * diff --git a/CGC.macros b/CGC.macros index 3f9e3c4..4613e41 100644 --- a/CGC.macros +++ b/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 diff --git a/CGC.pas b/CGC.pas index bc8ff55..348e1ff 100644 --- a/CGC.pas +++ b/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 } diff --git a/DAG.pas b/DAG.pas index 63db1ce..49e87ee 100644 --- a/DAG.pas +++ b/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;