From 8b7be9c5ddc876b5eb8e4e0f4beeedf8aa7323eb Mon Sep 17 00:00:00 2001 From: florian Date: Fri, 22 Sep 2000 22:09:54 +0000 Subject: [PATCH] * more stuff converted --- compiler/nmat.pas | 445 +++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 438 insertions(+), 7 deletions(-) diff --git a/compiler/nmat.pas b/compiler/nmat.pas index 01869ccf1b..88c03d8b59 100644 --- a/compiler/nmat.pas +++ b/compiler/nmat.pas @@ -20,7 +20,7 @@ **************************************************************************** } -unit ncal; +unit nmat; interface @@ -29,44 +29,364 @@ unit ncal; type tmoddivnode = class(tbinopnode) + function pass_1 : tnode;override; end; tshlshrnode = class(tbinopnode) + function pass_1 : tnode;override; end; tunaryminusnode = class(tunarynode) constructor create(expr : tnode);virtual; + function pass_1 : tnode;override; end; tnotnode = class(tunarynode) - constructor create(expr : tnode);virtual; + constructor create(expr : tnode);virtual; + function pass_1 : tnode;override; end; var cmoddivnode : class of tmoddivnode; cshlshrnode : class of tshlshrnode; cunaryminusnode : class of tunaryminusnode; - cnotnode : class of cnotnode; + cnotnode : class of tnotnode; implementation + uses + globtype,systems,tokens, + cobjects,verbose,globals, + symconst,symtable,aasm,types, + htypechk,pass_1,cpubase,cpuinfo, +{$ifdef newcg} + cgbase, +{$else newcg} + hcodegen, +{$endif newcg} + { for isbinaryoverloaded function } + nadd; + {**************************************************************************** TMODDIVNODE ****************************************************************************} + function tmoddivnode.pass_1 : tnode; + var + t : tnode + rv,lv : tconstexprint; + rd,ld : pdef; + + begin + firstpass(left); + right.set_varstate(true); + firstpass(right); + right.set_varstate(true); + if codegenerror then + exit; + + if isbinaryoverloaded(p) then + exit; + + { check for division by zero } + rv:=right.value; + lv:=left.value; + if is_constintnode(right) and (rv=0) then + begin + Message(parser_e_division_by_zero); + { recover } + rv:=1; + end; + + if is_constintnode(left) and is_constintnode(right) then + begin + case treetype of + modn: + t:=genintconstnode(lv mod rv); + divn: + t:=genintconstnode(lv div rv); + end; + firstpass(t); + pass_1:=t; + exit; + end; + if (left.resulttype^.deftype=orddef) and (right.resulttype^.deftype=orddef) and + (is_64bitint(left.resulttype) or is_64bitint(right.resulttype)) then + begin + rd:=right.resulttype; + ld:=left.resulttype; + if (porddef(rd)^.typ=s64bit) or (porddef(ld)^.typ=s64bit) then + begin + if (porddef(ld)^.typ<>s64bit) then + begin + left:=gentypeconvnode(left,cs64bitdef); + firstpass(left); + end; + if (porddef(rd)^.typ<>s64bit) then + begin + right:=gentypeconvnode(right,cs64bitdef); + firstpass(right); + end; + calcregisters(p,2,0,0); + end + else if (porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit) then + begin + if (porddef(ld)^.typ<>u64bit) then + begin + left:=gentypeconvnode(left,cu64bitdef); + firstpass(left); + end; + if (porddef(rd)^.typ<>u64bit) then + begin + right:=gentypeconvnode(right,cu64bitdef); + firstpass(right); + end; + calcregisters(p,2,0,0); + end; + resulttype:=left.resulttype; + end + else + begin + if not(right.resulttype^.deftype=orddef) or + not(porddef(right.resulttype)^.typ in [s32bit,u32bit]) then + right:=gentypeconvnode(right,s32bitdef); + + if not(left.resulttype^.deftype=orddef) or + not(porddef(left.resulttype)^.typ in [s32bit,u32bit]) then + left:=gentypeconvnode(left,s32bitdef); + + firstpass(left); + firstpass(right); + +{$ifdef cardinalmulfix} +{ if we divide a u32bit by a positive constant, the result is also u32bit (JM) } + if (left.resulttype^.deftype = orddef) and + (left.resulttype^.deftype = orddef) then + begin + if (porddef(left.resulttype)^.typ = u32bit) and + is_constintnode(right) and +{ (porddef(right.resulttype)^.typ <> u32bit) and} + (right.value > 0) then + begin + right := gentypeconvnode(right,u32bitdef); + firstpass(right); + end; +{ adjust also the left resulttype if necessary } + if (porddef(right.resulttype)^.typ = u32bit) and + is_constintnode(left) and + { (porddef(left.resulttype)^.typ <> u32bit) and} + (left.value > 0) then + begin + left := gentypeconvnode(left,u32bitdef); + firstpass(left); + end; + end; +{$endif cardinalmulfix} + + { the resulttype depends on the right side, because the left becomes } + { always 64 bit } + resulttype:=right.resulttype; + + if codegenerror then + exit; + + left_right_max(p); + if left.registers32<=right.registers32 then + inc(registers32); + end; + location.loc:=LOC_REGISTER; + end; + + {**************************************************************************** TSHLSHRNODE ****************************************************************************} + function tshlshrnode.pass_1 : tnode; + var + t : tnode; + regs : longint; + begin + firstpass(left); + set_varstate(left,true); + firstpass(right); + set_varstate(right,true); + if codegenerror then + exit; + + if isbinaryoverloaded(p) then + exit; + + if is_constintnode(left) and is_constintnode(right) then + begin + case treetype of + shrn: + t:=genintconstnode(left.value shr right.value); + shln: + t:=genintconstnode(left.value shl right.value); + end; + firstpass(t); + pass_1:=t; + exit; + end; + { 64 bit ints have their own shift handling } + if not(is_64bitint(left.resulttype)) then + begin + left:=gentypeconvnode(left,s32bitdef); + firstpass(left); + regs:=1; + resulttype:=s32bitdef; + end + else + begin + resulttype:=left.resulttype; + regs:=2; + end; + + right:=gentypeconvnode(right,s32bitdef); + firstpass(right); + + if codegenerror then + exit; + + if (right.treetype<>ordconstn) then + inc(regs); + calcregisters(p,regs,0,0); + + location.loc:=LOC_REGISTER; + end; + + {**************************************************************************** TUNARYMINUSNODE ****************************************************************************} - constructor tnotnode.create(expr : tnode); + constructor tunaryminusnode.create(expr : tnode); begin - inherited create(notn,expr); + inherited create(unaryminusn,expr); end; + function tunaryminusnode.pass_1 : tnode; + var + t : tnode; + minusdef : pprocdef; + begin + pass_1:=nil; + firstpass(left); + set_varstate(left,true); + registers32:=left.registers32; + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + resulttype:=left.resulttype; + if codegenerror then + exit; + if is_constintnode(left) then + begin + t:=genintconstnode(-left.value); + firstpass(t); + pass_1:=t; + exit; + end; + { nasm can not cope with negativ reals !! } + if is_constrealnode(left) +{$ifdef i386} + and not(aktoutputformat in [as_i386_nasmcoff,as_i386_nasmelf,as_i386_nasmobj]) +{$endif i386} + then + begin + t:=genrealconstnode(-left.value_real,bestrealdef^); + firstpass(t); + pass_1:=t; + exit; + end; + if (left.resulttype^.deftype=floatdef) then + begin + if pfloatdef(left.resulttype)^.typ=f32bit then + begin + if (left.location.loc<>LOC_REGISTER) and + (registers32<1) then + registers32:=1; + location.loc:=LOC_REGISTER; + end + else + location.loc:=LOC_FPU; + end +{$ifdef SUPPORT_MMX} + else if (cs_mmx in aktlocalswitches) and + is_mmx_able_array(left.resulttype) then + begin + if (left.location.loc<>LOC_MMXREGISTER) and + (registersmmx<1) then + registersmmx:=1; + { if saturation is on, left.resulttype isn't + "mmx able" (FK) + if (cs_mmx_saturation in aktlocalswitches^) and + (porddef(parraydef(resulttype)^.definition)^.typ in + [s32bit,u32bit]) then + CGMessage(type_e_mismatch); + } + end +{$endif SUPPORT_MMX} + else if is_64bitint(left.resulttype) then + begin + firstpass(left); + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + registers32:=left.registers32; + if codegenerror then + exit; + if (left.location.loc<>LOC_REGISTER) and + (registers32<2) then + registers32:=2; + location.loc:=LOC_REGISTER; + resulttype:=left.resulttype; + end + else if (left.resulttype^.deftype=orddef) then + begin + left:=gentypeconvnode(left,s32bitdef); + firstpass(left); + registersfpu:=left.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + registers32:=left.registers32; + if codegenerror then + exit; + if (left.location.loc<>LOC_REGISTER) and + (registers32<1) then + registers32:=1; + location.loc:=LOC_REGISTER; + resulttype:=left.resulttype; + end + else + begin + if assigned(overloaded_operators[_minus]) then + minusdef:=overloaded_operators[_minus]^.definition + else + minusdef:=nil; + while assigned(minusdef) do + begin + if is_equal(pparaitem(minusdef^.para^.first)^.paratype.def,left.resulttype) and + (pparaitem(minusdef^.para^.first)^.next=nil) then + begin + t:=gencallnode(overloaded_operators[_minus],nil); + t.left:=gencallparanode(left,nil); + left:=nil; + firstpass(t); + pass_1:=t; + exit; + end; + minusdef:=minusdef^.nextoverloaded; + end; + CGMessage(type_e_mismatch); + end; + end; + + {**************************************************************************** TNOTNODE ****************************************************************************} @@ -77,6 +397,115 @@ unit ncal; inherited create(notn,expr); end; + function tnotnode.pass_1 : tnode; + var + t : tnode; + notdef : pprocdef; + begin + firstpass(left); + set_varstate(left,true); + if codegenerror then + exit; + + if (left.treetype=ordconstn) then + begin + if is_boolean(left.resulttype) then + { here we do a boolena(byte(..)) type cast because } + { boolean() is buggy in 1.00 } + t:=genordinalconstnode(byte(not(boolean(byte(left.value)))),left.resulttype) + else + t:=genordinalconstnode(not(left.value),left.resulttype); + firstpass(t); + pass_1:=t; + exit; + end; + resulttype:=left.resulttype; + location.loc:=left.location.loc; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + if is_boolean(resulttype) then + begin + registers32:=left.registers32; + if (location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then + begin + location.loc:=LOC_REGISTER; + if (registers32<1) then + registers32:=1; + end; + { before loading it into flags we need to load it into + a register thus 1 register is need PM } +{$ifdef i386} + if left.location.loc<>LOC_JUMP then + location.loc:=LOC_FLAGS; +{$endif def i386} + end + else +{$ifdef SUPPORT_MMX} + if (cs_mmx in aktlocalswitches) and + is_mmx_able_array(left.resulttype) then + begin + if (left.location.loc<>LOC_MMXREGISTER) and + (registersmmx<1) then + registersmmx:=1; + end + else +{$endif SUPPORT_MMX} + if is_64bitint(left.resulttype) then + begin + registers32:=left.registers32; + if (location.loc in [LOC_REFERENCE,LOC_MEM,LOC_CREGISTER]) then + begin + location.loc:=LOC_REGISTER; + if (registers32<2) then + registers32:=2; + end; + end + else if is_integer(left.resulttype) then + begin + left:=gentypeconvnode(left,s32bitdef); + firstpass(left); + if codegenerror then + exit; + + resulttype:=left.resulttype; + registers32:=left.registers32; +{$ifdef SUPPORT_MMX} + registersmmx:=left.registersmmx; +{$endif SUPPORT_MMX} + + if (left.location.loc<>LOC_REGISTER) and + (registers32<1) then + registers32:=1; + location.loc:=LOC_REGISTER; + end + else + begin + if assigned(overloaded_operators[_op_not]) then + notdef:=overloaded_operators[_op_not]^.definition + else + notdef:=nil; + while assigned(notdef) do + begin + if is_equal(pparaitem(notdef^.para^.first)^.paratype.def,left.resulttype) and + (pparaitem(notdef^.para^.first)^.next=nil) then + begin + t:=gencallnode(overloaded_operators[_op_not],nil); + t.left:=gencallparanode(left,nil); + left:=nil; + firstpass(t); + pass_1:=t; + exit; + end; + notdef:=notdef^.nextoverloaded; + end; + CGMessage(type_e_mismatch); + end; + + registersfpu:=left.registersfpu; + end; + + begin cmoddivnode:=tmoddivnode; cshlshrnode:=tshlshrnode; @@ -85,7 +514,9 @@ begin end. { $Log$ - Revision 1.1 2000-09-20 21:35:12 florian - * initial revision + Revision 1.2 2000-09-22 22:09:54 florian + * more stuff converted + Revision 1.1 2000/09/20 21:35:12 florian + * initial revision } \ No newline at end of file