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;