diff --git a/compiler/cg386cnv.pas b/compiler/cg386cnv.pas index 156f00de70..d1c63c14f1 100644 --- a/compiler/cg386cnv.pas +++ b/compiler/cg386cnv.pas @@ -175,7 +175,10 @@ implementation var op : tasmop; opsize : topsize; - hregister : tregister; + hregister, + hregister2 : tregister; + l : pasmlabel; + begin { insert range check if not explicit conversion } if not(pto^.explizit) then @@ -192,6 +195,9 @@ implementation 2 : pto^.location.register:=makereg16(pfrom^.location.register); 4 : pto^.location.register:=makereg32(pfrom^.location.register); end; + { we can release the upper register } + if is_64bitint(pfrom^.resulttype) then + ungetregister32(pfrom^.location.registerhigh); end; end @@ -206,11 +212,14 @@ implementation ungetiftemp(pfrom^.location.reference); end; - { get op and opsize, handle separate for constants, becuase + { get op and opsize, handle separate for constants, because movz doesn't support constant values } if (pfrom^.location.loc=LOC_MEM) and (pfrom^.location.reference.is_immediate) then begin - opsize:=def_opsize(pto^.resulttype); + if is_64bitint(pto^.resulttype) then + opsize:=S_L + else + opsize:=def_opsize(pto^.resulttype); op:=A_MOV; end else @@ -229,13 +238,24 @@ implementation hregister:=getregister32 else hregister:=pfrom^.location.register; + { set the correct register size and location } clear_location(pto^.location); pto^.location.loc:=LOC_REGISTER; + + { do we need a second register for a 64 bit type ? } + if is_64bitint(pto^.resulttype) then + begin + hregister2:=getregister32; + pto^.location.registerhigh:=hregister2; + end; case pto^.resulttype^.size of - 1 : pto^.location.register:=makereg8(hregister); - 2 : pto^.location.register:=makereg16(hregister); - 4 : pto^.location.register:=makereg32(hregister); + 1: + pto^.location.register:=makereg8(hregister); + 2: + pto^.location.register:=makereg16(hregister); + 4,8: + pto^.location.register:=makereg32(hregister); end; { insert the assembler code } if pfrom^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then @@ -243,6 +263,23 @@ implementation else exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize, newreference(pfrom^.location.reference),pto^.location.register))); + + { do we need a sign extension for int64? } + if is_64bitint(pto^.resulttype) then + begin + exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L, + hregister2,hregister2))); + if (porddef(pto^.resulttype)^.typ=s64bitint) then + begin + getlabel(l); + exprasmlist^.concat(new(pai386,op_const_reg(A_TEST,S_L, + $80000000,hregister))); + emitjmp(C_Z,l); + exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L, + hregister2))); + emitlab(l); + end; + end; end; end; @@ -1300,7 +1337,12 @@ implementation end. { $Log$ - Revision 1.75 1999-05-31 20:35:46 peter + Revision 1.76 1999-06-28 22:29:10 florian + * qword division fixed + + code for qword/int64 type casting added: + range checking isn't implemented yet + + Revision 1.75 1999/05/31 20:35:46 peter * ansistring fixes, decr_ansistr called after all temp ansi reuses Revision 1.74 1999/05/27 19:44:09 peter diff --git a/compiler/cg386ld.pas b/compiler/cg386ld.pas index 4dd8ffc53f..319ef15b53 100644 --- a/compiler/cg386ld.pas +++ b/compiler/cg386ld.pas @@ -473,12 +473,22 @@ implementation 1 : opsize:=S_B; 2 : opsize:=S_W; 4 : opsize:=S_L; + { S_L is correct, the copy is done } + { with two moves } + 8 : opsize:=S_L; end; if loc=LOC_CREGISTER then begin exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize, newreference(p^.right^.location.reference), p^.left^.location.register))); + if is_64bitint(p^.right^.resulttype) then + begin + r:=newreference(p^.right^.location.reference); + inc(r^.offset,4); + exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,r, + p^.left^.location.registerhigh))); + end; {$IfDef regallocfix} del_reference(p^.right^.location.reference); {$EndIf regallocfix} @@ -488,6 +498,13 @@ implementation exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize, p^.right^.location.reference.offset, newreference(p^.left^.location.reference)))); + if is_64bitint(p^.right^.resulttype) then + begin + r:=newreference(p^.left^.location.reference); + inc(r^.offset,4); + exprasmlist^.concat(new(pai386,op_const_ref(A_MOV,opsize, + 0,r))); + end; {$IfDef regallocfix} del_reference(p^.left^.location.reference); {$EndIf regallocfix} @@ -835,7 +852,12 @@ implementation end. { $Log$ - Revision 1.60 1999-05-31 12:42:43 peter + Revision 1.61 1999-06-28 22:29:11 florian + * qword division fixed + + code for qword/int64 type casting added: + range checking isn't implemented yet + + Revision 1.60 1999/05/31 12:42:43 peter * fixed crash with empty array constructor Revision 1.59 1999/05/27 19:44:14 peter diff --git a/compiler/cg386mat.pas b/compiler/cg386mat.pas index d4a4fb69fa..1528a3176e 100644 --- a/compiler/cg386mat.pas +++ b/compiler/cg386mat.pas @@ -81,10 +81,6 @@ implementation pushusedregisters(pushedreg,$ff and not($80 shr byte(p^.location.registerlow)) and not($80 shr byte(p^.location.registerhigh))); - if cs_check_overflow in aktlocalswitches then - push_int(1) - else - push_int(0); { the left operand is in hloc, because the location of left is p^.location but p^.location is already destroyed @@ -934,7 +930,12 @@ implementation end. { $Log$ - Revision 1.26 1999-06-02 10:11:44 florian + Revision 1.27 1999-06-28 22:29:14 florian + * qword division fixed + + code for qword/int64 type casting added: + range checking isn't implemented yet + + Revision 1.26 1999/06/02 10:11:44 florian * make cycle fixed i.e. compilation with 0.99.10 * some fixes for qword * start of register calling conventions diff --git a/compiler/cgai386.pas b/compiler/cgai386.pas index e98da217f5..6b7e693a83 100644 --- a/compiler/cgai386.pas +++ b/compiler/cgai386.pas @@ -165,6 +165,8 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); 1 : o1:=S_B; 2 : o1:=S_W; 4 : o1:=S_L; + { I don't know if we need it (FK) } + 8 : o1:=S_L; else internalerror(78); end; @@ -178,12 +180,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); else o1:=S_W; end; - 4 : begin - case o1 of - S_B : o1:=S_BL; - S_W : o1:=S_WL; - end; - end; + 4,8: + begin + case o1 of + S_B : o1:=S_BL; + S_W : o1:=S_WL; + end; + end; end; end; def2def_opsize:=o1; @@ -1680,6 +1683,13 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); emitlab(hl); end; + { produces range check code, while one of the operands is a 64 bit + integer } + procedure emitrangecheck64(p : ptree;todef : pdef); + + begin + internalerror(28699); + end; { produces if necessary rangecheckcode } procedure emitrangecheck(p:ptree;todef:pdef); @@ -1711,7 +1721,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); { only check when assigning to scalar, subranges are different, when todef=fromdef then the check is always generated } fromdef:=p^.resulttype; - {we also need lto and hto when checking if we need to use doublebound! + if is_64bitint(fromdef) or is_64bitint(todef) then + begin + emitrangecheck64(p,todef); + exit; + end; + {we also need lto and hto when checking if we need to use doublebound! (JM)} getrange(todef,lto,hto); if todef<>fromdef then @@ -3088,7 +3103,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister); end. { $Log$ - Revision 1.7 1999-06-17 13:19:50 pierre + Revision 1.8 1999-06-28 22:29:15 florian + * qword division fixed + + code for qword/int64 type casting added: + range checking isn't implemented yet + + Revision 1.7 1999/06/17 13:19:50 pierre * merged from 0_99_12 branch Revision 1.5.2.2 1999/06/17 12:38:39 pierre diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 0dec4616fb..78956c37df 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -256,7 +256,7 @@ const msgtxt : array[0..000097,1..240] of char=( 'lowed'#000+ 'W_Label not defined $1'#000+ 'E_Illegal label declaration'#000+ - 'E_GOTO und LABEL are not supported (use switch -Sg)'#000+ + 'E_GOTO and LABEL are not supported (use switch -Sg)'#000+ 'E_Label not found'#000+ 'E_identifier isn'#039't a label'#000+ 'E_label already defined'#000+ diff --git a/compiler/tccnv.pas b/compiler/tccnv.pas index 6fb07223b7..ba409581ce 100644 --- a/compiler/tccnv.pas +++ b/compiler/tccnv.pas @@ -241,13 +241,13 @@ implementation procedure first_int_to_int(var p : ptree); begin - if (p^.registers32=0) and - (p^.left^.location.loc<>LOC_REGISTER) and + if (p^.left^.location.loc<>LOC_REGISTER) and (p^.resulttype^.size>p^.left^.resulttype^.size) then - begin - p^.registers32:=1; p^.location.loc:=LOC_REGISTER; - end; + if is_64bitint(p^.resulttype) then + p^.registers32:=max(p^.registers32,2) + else + p^.registers32:=max(p^.registers32,1); end; @@ -924,7 +924,12 @@ implementation end. { $Log$ - Revision 1.39 1999-06-28 19:30:07 peter + Revision 1.40 1999-06-28 22:29:21 florian + * qword division fixed + + code for qword/int64 type casting added: + range checking isn't implemented yet + + Revision 1.39 1999/06/28 19:30:07 peter * merged Revision 1.35.2.5 1999/06/28 19:07:47 peter diff --git a/compiler/types.pas b/compiler/types.pas index 8236c089cf..65e029f6e5 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -342,7 +342,7 @@ implementation case def^.deftype of orddef : begin dt:=porddef(def)^.typ; - is_signed:=(dt in [s8bit,s16bit,s32bit]); + is_signed:=(dt in [s8bit,s16bit,s32bit,s64bitint]); end; enumdef : is_signed:=false; else @@ -531,45 +531,62 @@ implementation procedure testrange(def : pdef;var l : longint); var lv,hv: longint; + begin - getrange(def,lv,hv); - if (def^.deftype=orddef) and - (porddef(def)^.typ=u32bit) then + { for 64 bit types we need only to check if it is less than } + { zero, if def is a qword node } + if is_64bitint(def) then begin - if lv<=hv then + if (l<0) and (porddef(def)^.typ=u64bit) then begin - if (lhv) then - begin - if (cs_check_range in aktlocalswitches) then - Message(parser_e_range_check_error) - else - Message(parser_w_range_check_error); - end; - end - else - { this happens with the wrap around problem } - { if lv is positive and hv is over $7ffffff } - { so it seems negative } - begin - if ((l>=0) and (lhv)) then - begin - if (cs_check_range in aktlocalswitches) then - Message(parser_e_range_check_error) - else - Message(parser_w_range_check_error); - end; + l:=0; + if (cs_check_range in aktlocalswitches) then + Message(parser_e_range_check_error) + else + Message(parser_w_range_check_error); end; end - else if (lhv) then + else begin - if (def^.deftype=enumdef) or - (cs_check_range in aktlocalswitches) then - Message(parser_e_range_check_error) - else - Message(parser_w_range_check_error); - { Fix the value to be in range } - l:=lv+(l mod (hv-lv+1)); + getrange(def,lv,hv); + if (def^.deftype=orddef) and + (porddef(def)^.typ=u32bit) then + begin + if lv<=hv then + begin + if (lhv) then + begin + if (cs_check_range in aktlocalswitches) then + Message(parser_e_range_check_error) + else + Message(parser_w_range_check_error); + end; + end + else + { this happens with the wrap around problem } + { if lv is positive and hv is over $7ffffff } + { so it seems negative } + begin + if ((l>=0) and (lhv)) then + begin + if (cs_check_range in aktlocalswitches) then + Message(parser_e_range_check_error) + else + Message(parser_w_range_check_error); + end; + end; + end + else if (lhv) then + begin + if (def^.deftype=enumdef) or + (cs_check_range in aktlocalswitches) then + Message(parser_e_range_check_error) + else + Message(parser_w_range_check_error); + { Fix the value to be in range } + l:=lv+(l mod (hv-lv+1)); + end; end; end; @@ -930,7 +947,12 @@ implementation end. { $Log$ - Revision 1.72 1999-06-13 22:41:08 peter + Revision 1.73 1999-06-28 22:29:22 florian + * qword division fixed + + code for qword/int64 type casting added: + range checking isn't implemented yet + + Revision 1.72 1999/06/13 22:41:08 peter * merged from fixes Revision 1.71.2.1 1999/06/13 22:37:17 peter