+ start of val(int64/qword)

* longbool, wordbool constants weren't written, fixed

compiler/cg386inl.pas

@@ -626,12 +626,13 @@ implementation
 
         var
            hp,node, code_para, dest_para : ptree;
-           hreg: TRegister;
+           hreg,hreg2: TRegister;
            hdef: POrdDef;
            procedureprefix : string;
            hr, hr2: TReference;
            dummycoll : tdefcoll;
            has_code, has_32bit_code, oldregisterdef: boolean;
+           r : preference;
 
           begin
            dummycoll.register:=R_NO;
@@ -702,16 +703,26 @@ implementation
              floatdef:
                procedureprefix := 'FPC_VAL_REAL_';
              orddef:
-               if is_signed(dest_para^.resulttype) then
+               if is_64bitint(dest_para^.resulttype) then
                  begin
-                   {if we are converting to a signed number, we have to include the
+                    if is_signed(dest_para^.resulttype) then
-                    size of the destination, so the Val function can extend the sign
+                      procedureprefix := 'FPC_VAL_INT64_'
-                    of the result to allow proper range checking}
+                    else
-                   exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,dest_para^.resulttype^.size)));
+                      procedureprefix := 'FPC_VAL_QWORD_';
-                   procedureprefix := 'FPC_VAL_SINT_'
                  end
                else
-                 procedureprefix := 'FPC_VAL_UINT_';
+                 begin
+                    if is_signed(dest_para^.resulttype) then
+                      begin
+                        {if we are converting to a signed number, we have to include the
+                         size of the destination, so the Val function can extend the sign
+                         of the result to allow proper range checking}
+                        exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,dest_para^.resulttype^.size)));
+                        procedureprefix := 'FPC_VAL_SINT_'
+                      end
+                    else
+                      procedureprefix := 'FPC_VAL_UINT_';
+                 end;
            End;
            emitcall(procedureprefix+pstringdef(node^.resulttype)^.stringtypname);
            { before disposing node we need to ungettemp !! PM }
@@ -729,6 +740,11 @@ implementation
                register variable}
                hreg := getexplicitregister32(R_EAX);
                emit_reg_reg(A_MOV,S_L,R_EAX,hreg);
+               if is_64bitint(dest_para^.resulttype) then
+                 begin
+                    hreg2:=getexplicitregister32(R_EDX);
+                    emit_reg_reg(A_MOV,S_L,R_EDX,hreg2);
+                 end;
               {as of now, hreg now holds the location of the result, if it was
                integer}
              End;
@@ -770,11 +786,20 @@ implementation
                  u32bit,s32bit:
                    exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
                      hreg,newreference(hr2))));
-                 {u64bit,s64bitint: ???}
+                 u64bit,s64bitint:
+                   begin
+                      exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
+                        hreg,newreference(hr2))));
+                      r:=newreference(hr2);
+                      inc(r^.offset,4);
+                      exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV, S_L,
+                        hreg2,r)));
+                   end;
                End;
            End;
            If (cs_check_range in aktlocalswitches) and
               (dest_para^.left^.resulttype^.deftype = orddef) and
+              (not(is_64bitint(dest_para^.left^.resulttype))) and
             {the following has to be changed to 64bit checking, once Val
              returns 64 bit values (unless a special Val function is created
              for that)}
@@ -1293,7 +1318,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.60  1999-07-01 15:49:09  florian
+  Revision 1.61  1999-07-03 14:14:27  florian
+    + start of val(int64/qword)
+    * longbool, wordbool constants weren't written, fixed
+
+  Revision 1.60  1999/07/01 15:49:09  florian
     * int64/qword type release
     + lo/hi for int64/qword
 

compiler/ptconst.pas

@@ -135,6 +135,16 @@ unit ptconst;
                                     Message(cg_e_illegal_expression);
                                   curconstsegment^.concat(new(pai_const,init_8bit(p^.value)));
                                end;
+                    bool16bit : begin
+                                  if not is_constboolnode(p) then
+                                    Message(cg_e_illegal_expression);
+                                  curconstsegment^.concat(new(pai_const,init_16bit(p^.value)));
+                               end;
+                    bool32bit : begin
+                                  if not is_constboolnode(p) then
+                                    Message(cg_e_illegal_expression);
+                                  curconstsegment^.concat(new(pai_const,init_32bit(p^.value)));
+                               end;
                     uchar : begin
                                 if not is_constcharnode(p) then
                                   Message(cg_e_illegal_expression);
@@ -159,6 +169,8 @@ unit ptconst;
                               curconstsegment^.concat(new(pai_const,init_32bit(0)));
                            end;
                       end;
+                    else
+                      internalerror(3799);
                  end;
                  disposetree(p);
               end;
@@ -713,7 +725,11 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.46  1999-05-27 19:44:54  peter
+  Revision 1.47  1999-07-03 14:14:28  florian
+    + start of val(int64/qword)
+    * longbool, wordbool constants weren't written, fixed
+
+  Revision 1.46  1999/05/27 19:44:54  peter
     * removed oldasm
     * plabel -> pasmlabel
     * -a switches to source writing automaticly

compiler/tcinl.pas

@@ -925,8 +925,8 @@ implementation
                     If Not((hpp^.left^.resulttype^.deftype = floatdef) or
                            ((hpp^.left^.resulttype^.deftype = orddef) And
                             (POrdDef(hpp^.left^.resulttype)^.typ in
-                              [u32bit,s32bit,{s64bitint,u64bit, -- not supported yet in RTL}
+                              [u32bit,s32bit,
-                               u8bit,s8bit,u16bit,s16bit])))
+                               u8bit,s8bit,u16bit,s16bit,s64bitint,u64bit])))
                         Then CGMessage(type_e_mismatch);
                   must_be_valid:=true;
                  {hp = source (String)}
@@ -947,7 +947,10 @@ implementation
 
                   { val doesn't calculate the registers really }
                   { correct, we need one register extra   (FK) }
-                  inc(p^.registers32,1);
+                  if is_64bitint(hpp^.left^.resulttype) then
+                    inc(p^.registers32,2)
+                  else
+                    inc(p^.registers32,1);
                end;
 {$EndIf OLDVAL}
 
@@ -1118,7 +1121,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.38  1999-07-01 15:49:22  florian
+  Revision 1.39  1999-07-03 14:14:31  florian
+    + start of val(int64/qword)
+    * longbool, wordbool constants weren't written, fixed
+
+  Revision 1.38  1999/07/01 15:49:22  florian
     * int64/qword type release
     + lo/hi for int64/qword
 

compiler/todo.txt

@@ -66,8 +66,8 @@ compiler version and your short cut.
   - val/str
   - range checking
   - type cast QWord -> real
-  - lo/hi testing
+        - lo/hi testing ......................................... 0.99.13 (FK)
-  - overflow checking test
+        - overflow checking test ................................ 0.99.13 (FK)
 * Misc
         - array of const as subroutine parameter ................ 0.99.9 (PFV)
         - open array with call by value ......................... 0.99.6 (FK)
@@ -84,7 +84,7 @@ compiler version and your short cut.
         - open strings, $P....................................... 0.99.10 (PFV)
         - include/exclude........................................ 0.99.10 (PM)
 - fix all bugs of the bug directory
-- sysutils unit for go32v2 (excpetions!)
+- sysutils unit for go32v2 (exceptions!)
         - initialisation/finalization for units ................. 0.99.11 (PFV)
 - fixed data type
 - add alignment $A switch