+ support of 64 bit integer constants

compiler/cg386con.pas

@@ -79,7 +79,7 @@ implementation
               { const already used ? }
               if not assigned(p^.lab_real) then
                 begin
-                   { tries to found an old entry }
+                   { tries to find an old entry }
                    hp1:=pai(consts^.first);
                    while assigned(hp1) do
                      begin
@@ -152,11 +152,29 @@ implementation
 *****************************************************************************}
 
     procedure secondordconst(var p : ptree);
+
+      var
+         l : pasmlabel;
+
       begin
-         { an integer const. behaves as a memory reference }
          p^.location.loc:=LOC_MEM;
-         p^.location.reference.is_immediate:=true;
+         if is_64bitint(p^.resulttype) then
-         p^.location.reference.offset:=p^.value;
+           begin
+              getdatalabel(l);
+              if (cs_create_smart in aktmoduleswitches) then
+                consts^.concat(new(pai_cut,init));
+              consts^.concat(new(pai_label,init(l)));
+              consts^.concat(new(pai_const,init_32bit(lo(p^.value))));
+              consts^.concat(new(pai_const,init_32bit(hi(p^.value))));
+              reset_reference(p^.location.reference);
+              p^.location.reference.symbol:=l;
+           end
+         else
+           begin
+              { non int64 const. behaves as a memory reference }
+              p^.location.reference.is_immediate:=true;
+              p^.location.reference.offset:=p^.value;
+           end;
       end;
 
 
@@ -440,7 +458,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:33  michael
+  Revision 1.3  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.2  2000/07/13 11:32:33  michael
   + removed logs
 
-}
+}

compiler/cg386inl.pas

@@ -1293,6 +1293,15 @@ implementation
                 emitoverflowcheck(p^.left^.left);
                 emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
               end;
+            in_typeinfo_x:
+               begin
+                  p^.left^.left^.typenodetype^.generate_rtti;
+                  p^.location.register:=getregister32;
+                  new(r);
+                  reset_reference(r^);
+                  r^.symbol:=p^.left^.left^.typenodetype^.rtti_label;
+                  emit_ref_reg(A_MOV,S_L,r,p^.location.register);
+               end;
             in_assigned_x :
               begin
                  secondpass(p^.left^.left);
@@ -1528,7 +1537,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.5  2000-08-04 22:00:50  peter
+  Revision 1.6  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.5  2000/08/04 22:00:50  peter
     * merges from fixes
 
   Revision 1.4  2000/07/29 18:27:53  sg
@@ -1543,4 +1555,4 @@ end.
   Revision 1.2  2000/07/13 11:32:34  michael
   + removed logs
 
-}
+}

compiler/cg386ld.pas

@@ -536,15 +536,21 @@ implementation
                                 end
                               else
                                 begin
-                                  emit_const_ref(A_MOV,opsize,
-                                    p^.right^.location.reference.offset,
-                                    newreference(p^.left^.location.reference));
                                   if is_64bitint(p^.right^.resulttype) then
                                     begin
+                                       emit_const_ref(A_MOV,opsize,
+                                         lo(p^.right^.value),
+                                         newreference(p^.left^.location.reference));
                                        r:=newreference(p^.left^.location.reference);
                                        inc(r^.offset,4);
                                        emit_const_ref(A_MOV,opsize,
-                                         0,r);
+                                         hi(p^.right^.value),r);
+                                    end
+                                  else
+                                    begin
+                                       emit_const_ref(A_MOV,opsize,
+                                         p^.right^.location.reference.offset,
+                                         newreference(p^.left^.location.reference));
                                     end;
 {$IfDef regallocfix}
                                   del_reference(p^.left^.location.reference);
@@ -1002,10 +1008,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:25  michael
+  Revision 1.4  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.3  2000/07/13 12:08:25  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:34  michael
   + removed logs
 
-}
+}

compiler/cgai386.pas

@@ -186,7 +186,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          2 : def_opsize:=S_W;
          4 : def_opsize:=S_L;
         else
-         internalerror(78);
+         internalerror(130820001);
         end;
       end;
 
@@ -202,7 +202,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          { I don't know if we need it (FK) }
          8 : o1:=S_L;
         else
-         internalerror(78);
+         internalerror(130820002);
         end;
         if assigned(p2) then
          begin
@@ -234,7 +234,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
          2 : def_getreg:=reg32toreg16(getregister32);
          4 : def_getreg:=getregister32;
         else
-         internalerror(78);
+         internalerror(130820003);
         end;
       end;
 
@@ -4067,7 +4067,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
 end.
 {
   $Log$
-  Revision 1.9  2000-08-10 18:42:03  peter
+  Revision 1.10  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.9  2000/08/10 18:42:03  peter
     * fixed for constants in emit_push_mem_size for go32v2 (merged)
 
   Revision 1.8  2000/08/07 11:29:40  jonas
@@ -4109,4 +4112,4 @@ end.
   Revision 1.2  2000/07/13 11:32:37  michael
   + removed logs
 
-}
+}

compiler/cpuinfo.pas

@@ -30,8 +30,14 @@ Type
 {$else FPC}
    AWord = Longint;
 {$endif FPC}
-   TConstExprInt = longint;
+   { the ordinal type used when evaluating constant integer expressions }
-   TConstExprUInt = dword;
+   TConstExprInt = int64;
+   { ... the same unsigned }
+   TConstExprUInt = qword;
+   { this must be an ordinal type with the same size as a pointer }
+   { to allow some dirty type casts for example when using        }
+   { tconstsym.value                                              }
+   TPointerOrd = longint;
 
 Const
    { Size of native extended type }
@@ -42,7 +48,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-08-12 06:45:08  florian
+  Revision 1.4  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.3  2000/08/12 06:45:08  florian
     + type TConstExprInt added
 
   Revision 1.2  2000/07/13 11:32:39  michael

compiler/innr.inc

@@ -52,6 +52,7 @@ const
    in_continue          = 40;
    in_assert_x_y        = 41;
    in_addr_x            = 42;
+   in_typeinfo_x        = 43;
 
 { Internal constant functions }
    in_const_trunc      = 100;
@@ -99,7 +100,10 @@ const
 
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:43  michael
+  Revision 1.3  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.2  2000/07/13 11:32:43  michael
   + removed logs
- 
+
-}
+}

compiler/pexpr.pas

@@ -270,6 +270,27 @@ unit pexpr;
                end;
             end;
 
+          in_typeinfo_x :
+            begin
+              consume(_LKLAMMER);
+              in_args:=true;
+              {allow_type:=true;}
+              p1:=comp_expr(true);
+              do_firstpass(p1);
+              {allow_type:=false; }
+              if p1^.treetype<>typen then
+                begin
+                   disposetree(p1);
+                   p1:=genzeronode(errorn);
+                   Message(parser_e_illegal_parameter_list);
+                end;
+              consume(_RKLAMMER);
+              p2:=gencallparanode(p1,nil);
+              p2:=geninlinenode(in_typeinfo_x,false,p2);
+              pd:=voidpointerdef;
+              statement_syssym:=p2;
+            end;
+
           in_assigned_x :
             begin
               consume(_LKLAMMER);
@@ -894,6 +915,7 @@ unit pexpr;
     function factor(getaddr : boolean) : ptree;
       var
          l      : longint;
+         ic     : TConstExprInt;
          oldp1,
          p1,p2,p3 : ptree;
          code     : integer;
@@ -1172,25 +1194,29 @@ unit pexpr;
                  constsym : begin
                               case pconstsym(srsym)^.consttyp of
                                 constint :
-                                  p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
+                                  { do a very dirty trick to bootstrap this code }
+                                  if (pconstsym(srsym)^.value>=-(int64(2147483647)+int64(1))) and (pconstsym(srsym)^.value<=2147483647) then
+                                    p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef)
+                                  else
+                                    p1:=genordinalconstnode(pconstsym(srsym)^.value,cs64bitdef);
                                 conststring :
                                   begin
                                     len:=pconstsym(srsym)^.len;
                                     if not(cs_ansistrings in aktlocalswitches) and (len>255) then
                                      len:=255;
                                     getmem(pc,len+1);
-                                    move(pchar(pconstsym(srsym)^.value)^,pc^,len);
+                                    move(pchar(tpointerord(pconstsym(srsym)^.value))^,pc^,len);
                                     pc[len]:=#0;
                                     p1:=genpcharconstnode(pc,len);
                                   end;
                                 constchar :
                                   p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
                                 constreal :
-                                  p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^,bestrealdef^);
+                                  p1:=genrealconstnode(pbestreal(tpointerord(pconstsym(srsym)^.value))^,bestrealdef^);
                                 constbool :
                                   p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
                                 constset :
-                                  p1:=gensetconstnode(pconstset(pconstsym(srsym)^.value),
+                                  p1:=gensetconstnode(pconstset(tpointerord(pconstsym(srsym)^.value)),
                                         psetdef(pconstsym(srsym)^.consttype.def));
                                 constord :
                                   p1:=genordinalconstnode(pconstsym(srsym)^.value,
@@ -1812,24 +1838,36 @@ unit pexpr;
                  valint(pattern,l,code);
                  if code<>0 then
                   begin
-                    val(pattern,d,code);
+                     { try int64 if available                          }
-                    if code<>0 then
+                     { if no int64 available longint is tried a second }
-                     begin
+                     { time which doesn't hurt                         }
-                       Message(cg_e_invalid_integer);
+                     val(pattern,ic,code);
-                       consume(_INTCONST);
+                     if code<>0 then
-                       l:=1;
+                       begin
-                       p1:=genordinalconstnode(l,s32bitdef);
+                          val(pattern,d,code);
-                     end
+                          if code<>0 then
-                    else
+                           begin
-                     begin
+                              Message(cg_e_invalid_integer);
-                       consume(_INTCONST);
+                              consume(_INTCONST);
-                       p1:=genrealconstnode(d,bestrealdef^);
+                              l:=1;
-                     end;
+                              p1:=genordinalconstnode(l,s32bitdef);
+                           end
+                         else
+                           begin
+                              consume(_INTCONST);
+                              p1:=genrealconstnode(d,bestrealdef^);
+                           end;
+                       end
+                     else
+                       begin
+                          consume(_INTCONST);
+                          p1:=genordinalconstnode(ic,cs64bitdef);
+                       end;
                   end
                  else
                   begin
-                    consume(_INTCONST);
+                     consume(_INTCONST);
-                    p1:=genordinalconstnode(l,s32bitdef);
+                     p1:=genordinalconstnode(l,s32bitdef)
                   end;
                end;
  _REALNUMBER : begin
@@ -2170,9 +2208,12 @@ _LECKKLAMMER : begin
 end.
 {
   $Log$
-  Revision 1.3  2000-08-04 22:00:52  peter
+  Revision 1.4  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.3  2000/08/04 22:00:52  peter
     * merges from fixes
 
   Revision 1.2  2000/07/13 11:32:44  michael
   + removed logs
-}
+}

compiler/psystem.pas

@@ -65,6 +65,7 @@ begin
   p^.insert(new(psyssym,init('ASSERT',in_assert_x_y)));
   p^.insert(new(psyssym,init('VAL',in_val_x)));
   p^.insert(new(psyssym,init('ADDR',in_addr_x)));
+  p^.insert(new(psyssym,init('TYPEINFO',in_typeinfo_x)));
 end;
 
 
@@ -249,7 +250,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:47  michael
+  Revision 1.3  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.2  2000/07/13 11:32:47  michael
   + removed logs
 
-}
+}

compiler/ptconst.pas

@@ -39,7 +39,7 @@ unit ptconst;
 {$else}
        strings,
 {$endif Delphi}
-       globtype,systems,tokens,
+       globtype,systems,tokens,cpuinfo,
        cobjects,globals,scanner,
        symconst,aasm,types,verbose,
        tree,pass_1,
@@ -435,7 +435,7 @@ unit ptconst;
                 end
               else if is_constresourcestringnode(p) then
                 begin
-                  strval:=pchar(pconstsym(p^.symtableentry)^.value);
+                  strval:=pchar(tpointerord(pconstsym(p^.symtableentry)^.value));
                   strlength:=pconstsym(p^.symtableentry)^.len;
                 end
               else
@@ -800,10 +800,13 @@ unit ptconst;
 end.
 {
   $Log$
-  Revision 1.3  2000-08-05 13:25:06  peter
+  Revision 1.4  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.3  2000/08/05 13:25:06  peter
     * packenum 1 fixes (merged)
 
   Revision 1.2  2000/07/13 11:32:47  michael
   + removed logs
 
-}
+}

compiler/symdef.inc

@@ -2502,9 +2502,9 @@
 	      case hpc^.consttyp of
 	        conststring,
 		constresourcestring :
-		  hs:=+strpas(pchar(hpc^.value));
+		  hs:=+strpas(pchar(tpointerord(hpc^.value)));
 		constreal :
-  	          str(pbestreal(hpc^.value)^,hs);
+                  str(pbestreal(tpointerord(hpc^.value))^,hs);
 		constord,
 		constpointer :
 		  hs:=tostr(hpc^.value);
@@ -2520,8 +2520,8 @@
 		constchar :
 		  hs:=chr(hpc^.value);
 		constset :
-		  hs:='<set>';      
+		  hs:='<set>';
-              end;  
+              end;
 	      if hs<>'' then
 	       s:=s+'="'+hs+'"';
 	    end;
@@ -2682,7 +2682,7 @@
          localst^.defowner:=@self;
          parast^.next:=localst;
 	 localst^.next:=owner;}
-	 
+	
          forwarddef:=false;
          interfacedef:=false;
          hasforward:=false;
@@ -2940,7 +2940,7 @@ Const local_symtable_index : longint = $8001;
                }
            end;
          current_ppu^.writeentry(ibprocdef);
-	 
+	
          { Save the para and local symtable, for easier reading
 	   save both always, they don't influence the interface crc }
          oldintfcrc:=current_ppu^.do_interface_crc;
@@ -2955,7 +2955,7 @@ Const local_symtable_index : longint = $8001;
 	  begin
             localst:=new(psymtable,init(localsymtable));
 	    localst^.defowner:=@self;
-	  end;  
+	  end;
          localst^.writeas;}
          current_ppu^.do_interface_crc:=oldintfcrc;
       end;
@@ -3030,7 +3030,7 @@ Const local_symtable_index : longint = $8001;
          resolvedef(pdef(nextoverloaded));
          resolvedef(pdef(_class));
          { parast }
-	 oldsymtablestack:=symtablestack; 
+	 oldsymtablestack:=symtablestack;
          oldlocalsymtable:=aktlocalsymtable;
          aktlocalsymtable:=parast;
          parast^.deref;
@@ -3038,7 +3038,7 @@ Const local_symtable_index : longint = $8001;
          aktlocalsymtable:=localst;
          localst^.deref;}
          aktlocalsymtable:=oldlocalsymtable;
-	 symtablestack:=oldsymtablestack; 
+	 symtablestack:=oldsymtablestack;
       end;
 
 
@@ -4252,7 +4252,10 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.9  2000-08-13 13:06:37  peter
+  Revision 1.10  2000-08-16 13:06:06  florian
+    + support of 64 bit integer constants
+
+  Revision 1.9  2000/08/13 13:06:37  peter
     * store parast always for procdef (browser needs still update)
     * add default parameter value to demangledpara
 
@@ -4285,4 +4288,4 @@ Const local_symtable_index : longint = $8001;
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
 
-}
+}

compiler/symsym.inc

@@ -1639,7 +1639,7 @@
                                   TCONSTSYM
 ****************************************************************************}
 
-    constructor tconstsym.init(const n : string;t : tconsttyp;v : longint);
+    constructor tconstsym.init(const n : string;t : tconsttyp;v : TConstExprInt);
       begin
          inherited init(n);
          typ:=constsym;
@@ -1651,7 +1651,7 @@
       end;
 
 
-    constructor tconstsym.init_def(const n : string;t : tconsttyp;v : longint;def : pdef);
+    constructor tconstsym.init_def(const n : string;t : tconsttyp;v : TConstExprInt;def : pdef);
       begin
          inherited init(n);
          typ:=constsym;
@@ -1671,20 +1671,31 @@
          consttype.reset;
          len:=l;
          if t=constresourcestring then
-           ResStrIndex:=ResourceStrings^.Register(name,pchar(value),len);
+           ResStrIndex:=ResourceStrings^.Register(name,
+             pchar(tpointerord(value)),len);
       end;
 
     constructor tconstsym.load;
       var
          pd : pbestreal;
          ps : pnormalset;
+         l1,l2 : longint;
+
       begin
          tsym.load;
          typ:=constsym;
          consttype.reset;
          consttyp:=tconsttyp(readbyte);
          case consttyp of
-           constint,
+           constint:
+             if sizeof(tconstexprint)=8 then
+               begin
+                  l1:=readlong;
+                  l2:=readlong;
+                  value:=int64(l1)+(int64(l2) shl 32);
+               end
+             else
+               value:=readlong;
            constbool,
            constchar :
              value:=readlong;
@@ -1692,13 +1703,20 @@
            constord :
              begin
                consttype.load;
-               value:=readlong;
+               if sizeof(TConstExprInt)=8 then
+                 begin
+                    l1:=readlong;
+                    l2:=readlong;
+                    value:=int64(l1)+(int64(l2) shl 32);
+                 end
+               else
+                 value:=readlong;
              end;
            conststring,constresourcestring :
              begin
                len:=readlong;
-               getmem(pchar(value),len+1);
+               getmem(pchar(tpointerord(value)),len+1);
-               current_ppu^.getdata(pchar(value)^,len);
+               current_ppu^.getdata(pchar(tpointerord(value))^,len);
                if consttyp=constresourcestring then
                  ResStrIndex:=readlong;
              end;
@@ -1726,11 +1744,11 @@
       begin
         case consttyp of
           conststring,constresourcestring :
-            freemem(pchar(value),len+1);
+            freemem(pchar(tpointerord(value)),len+1);
           constreal :
-            dispose(pbestreal(value));
+            dispose(pbestreal(tpointerord(value)));
           constset :
-            dispose(pnormalset(value));
+            dispose(pnormalset(tpointerord(value)));
         end;
         inherited done;
       end;
@@ -1755,7 +1773,15 @@
          writebyte(byte(consttyp));
          case consttyp of
            constnil : ;
-           constint,
+           constint:
+             if sizeof(TConstExprInt)=8 then
+               begin
+                  writelong(lo(value));
+                  writelong(hi(value));
+               end
+             else
+               writelong(value);
+
            constbool,
            constchar :
              writelong(value);
@@ -1763,21 +1789,27 @@
            constord :
              begin
                consttype.write;
-               writelong(value);
+               if sizeof(TConstExprInt)=8 then
+                 begin
+                    writelong(lo(value));
+                    writelong(hi(value));
+                 end
+               else
+                 writelong(value);
              end;
            conststring,constresourcestring :
              begin
                writelong(len);
-               current_ppu^.putdata(pchar(value)^,len);
+               current_ppu^.putdata(pchar(TPointerOrd(value))^,len);
                if consttyp=constresourcestring then
                  writelong(ResStrIndex);
              end;
            constreal :
-             writereal(pbestreal(value)^);
+             writereal(pbestreal(TPointerOrd(value))^);
            constset :
              begin
                consttype.write;
-               writenormalset(pointer(value)^);
+               writenormalset(pointer(TPointerOrd(value))^);
              end;
          else
            internalerror(13);
@@ -1793,7 +1825,7 @@
          case consttyp of
             conststring : begin
                           { I had to remove ibm2ascii !! }
-                          st := pstring(value)^;
+                          st := pstring(TPointerOrd(value))^;
                           {st := ibm2ascii(pstring(value)^);}
                           st := 's'''+st+'''';
                           end;
@@ -1803,7 +1835,7 @@
             constord,
             constchar : st := 'i'+tostr(value);
             constreal : begin
-                        system.str(pbestreal(value)^,st);
+                        system.str(pbestreal(TPointerOrd(value))^,st);
                         st := 'r'+st;
                         end;
          { if we don't know just put zero !! }
@@ -2157,7 +2189,10 @@
 
 {
   $Log$
-  Revision 1.4  2000-08-13 12:54:56  peter
+  Revision 1.5  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.4  2000/08/13 12:54:56  peter
     * class member decl wrong then no other error after it
     * -vb has now also line numbering
     * -vb is also used for interface/implementation different decls and
@@ -2168,5 +2203,5 @@
 
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
- 
+
-}
+}

compiler/symsymh.inc

@@ -270,10 +270,10 @@
           consttype  : ttype;
           consttyp : tconsttyp;
           resstrindex,    { needed for resource strings }
-          value,
+          value      : tconstexprint;
           len        : longint; { len is needed for string length }
-          constructor init(const n : string;t : tconsttyp;v : longint);
+          constructor init(const n : string;t : tconsttyp;v : tconstexprint);
-          constructor init_def(const n : string;t : tconsttyp;v : longint;def : pdef);
+          constructor init_def(const n : string;t : tconsttyp;v : tconstexprint;def : pdef);
           constructor init_string(const n : string;t : tconsttyp;str:pchar;l:longint);
           constructor load;
           destructor  done;virtual;
@@ -319,7 +319,10 @@
 
 {
   $Log$
-  Revision 1.3  2000-08-13 12:54:56  peter
+  Revision 1.4  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.3  2000/08/13 12:54:56  peter
     * class member decl wrong then no other error after it
     * -vb has now also line numbering
     * -vb is also used for interface/implementation different decls and
@@ -327,5 +330,5 @@
 
   Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
- 
+
-}
+}

compiler/t_go32v2.pas

@@ -32,6 +32,7 @@ unit t_go32v2;
     tlinkergo32v2=object(tlinker)
     private
        Function  WriteResponseFile(isdll:boolean) : Boolean;
+       Function  WriteScript(isdll:boolean) : Boolean;
     public
        constructor Init;
        procedure SetDefaultInfo;virtual;
@@ -62,7 +63,14 @@ procedure TLinkerGo32v2.SetDefaultInfo;
 begin
   with Info do
    begin
-     ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES';
+{$ifdef OPTALIGN}
+      if cs_align in aktglobalswitches then
+        ExeCmd[1]:='ld $SCRIPT $OPT $STRIP -o $EXE'
+      else
+        ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES'
+{$else OPTALIGN}
+      ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES';
+{$endif OPTALIGN}
    end;
 end;
 
@@ -152,6 +160,131 @@ begin
   WriteResponseFile:=True;
 end;
 
+Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
+Var
+  scriptres  : TLinkRes;
+  i        : longint;
+{$IFDEF NEWST}
+  HPath    : PStringItem;
+{$ELSE}
+  HPath    : PStringQueueItem;
+{$ENDIF NEWST}
+  s        : string;
+  linklibc : boolean;
+begin
+  WriteScript:=False;
+
+  { Open link.res file }
+  ScriptRes.Init(outputexedir+Info.ResName);
+  ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")');
+  ScriptRes.Add('ENTRY(start)');
+
+{$ifdef dummy}
+  { Write path to search libraries }
+  HPath:=current_module^.locallibrarysearchpath.First;
+  while assigned(HPath) do
+   begin
+     ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
+     HPath:=HPath^.Next;
+   end;
+  HPath:=LibrarySearchPath.First;
+  while assigned(HPath) do
+   begin
+     ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
+     HPath:=HPath^.Next;
+   end;
+{$endif dummy}
+
+  ScriptRes.Add('SECTIONS');
+  ScriptRes.Add('{');
+  ScriptRes.Add('  .text  0x1000+SIZEOF_HEADERS : {');
+  ScriptRes.Add('  . = ALIGN(16);');
+  { add objectfiles, start with prt0 always }
+  ScriptRes.Add('  '+GetShortName(FindObjectFile('prt0',''))+'(.text)');
+  while not ObjectFiles.Empty do
+   begin
+     s:=ObjectFiles.Get;
+     if s<>'' then
+       begin
+          ScriptRes.Add('  . = ALIGN(16);');
+          ScriptRes.Add('  '+GetShortName(s)+'(.text)');
+       end;
+   end;
+  ScriptRes.Add('    *(.text)');
+  ScriptRes.Add('    etext  =  . ; _etext = .;');
+  ScriptRes.Add('    . = ALIGN(0x200);');
+  ScriptRes.Add('  }');
+  ScriptRes.Add('    .data  ALIGN(0x200) : {');
+  ScriptRes.Add('      djgpp_first_ctor = . ;');
+  ScriptRes.Add('      *(.ctor)');
+  ScriptRes.Add('      djgpp_last_ctor = . ;');
+  ScriptRes.Add('      djgpp_first_dtor = . ;');
+  ScriptRes.Add('      *(.dtor)');
+  ScriptRes.Add('      djgpp_last_dtor = . ;');
+  ScriptRes.Add('      *(.data)');
+  ScriptRes.Add('      *(.gcc_exc)');
+  ScriptRes.Add('      ___EH_FRAME_BEGIN__ = . ;');
+  ScriptRes.Add('      *(.eh_fram)');
+  ScriptRes.Add('      ___EH_FRAME_END__ = . ;');
+  ScriptRes.Add('      LONG(0)');
+  ScriptRes.Add('       edata  =  . ; _edata = .;');
+  ScriptRes.Add('       . = ALIGN(0x200);');
+  ScriptRes.Add('    }');
+  ScriptRes.Add('    .bss  SIZEOF(.data) + ADDR(.data) :');
+  ScriptRes.Add('    {');
+  ScriptRes.Add('      _object.2 = . ;');
+  ScriptRes.Add('      . += 24 ;');
+  ScriptRes.Add('      *(.bss)');
+  ScriptRes.Add('      *(COMMON)');
+  ScriptRes.Add('       end = . ; _end = .;');
+  ScriptRes.Add('       . = ALIGN(0x200);');
+  ScriptRes.Add('    }');
+  ScriptRes.Add('  }');
+
+  { Write staticlibraries }
+  if not StaticLibFiles.Empty then
+   begin
+     ScriptRes.Add('-(');
+     While not StaticLibFiles.Empty do
+      begin
+        S:=StaticLibFiles.Get;
+        ScriptRes.AddFileName(GetShortName(s))
+      end;
+     ScriptRes.Add('-)');
+   end;
+
+  { Write sharedlibraries like -l<lib>, also add the needed dynamic linker
+    here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
+  linklibc:=false;
+  While not SharedLibFiles.Empty do
+   begin
+     S:=SharedLibFiles.Get;
+     if s<>'c' then
+      begin
+        i:=Pos(target_os.sharedlibext,S);
+        if i>0 then
+         Delete(S,i,255);
+        ScriptRes.Add('-l'+s);
+      end
+     else
+      begin
+        ScriptRes.Add('-l'+s);
+        linklibc:=true;
+      end;
+   end;
+  { be sure that libc&libgcc is the last lib }
+  if linklibc then
+   begin
+     ScriptRes.Add('-lc');
+     ScriptRes.Add('-lgcc');
+   end;
+
+{ Write and Close response }
+  ScriptRes.WriteToDisk;
+  ScriptRes.done;
+
+  WriteScript:=True;
+end;
 
 function TLinkerGo32v2.MakeExecutable:boolean;
 var
@@ -168,8 +301,15 @@ begin
   if (cs_link_strip in aktglobalswitches) then
    StripStr:='-s';
 
+{$ifdef OPTALIGN}
+  if cs_align in aktglobalswitches then
+    WriteScript(false)
+  else
+    WriteResponseFile(false);
+{$else OPTALIGN}
 { Write used files and libraries }
   WriteResponseFile(false);
+{$endif OPTALIGN}
 
 { Call linker }
   SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
@@ -177,6 +317,9 @@ begin
   Replace(cmdstr,'$OPT',Info.ExtraOptions);
   Replace(cmdstr,'$RES',outputexedir+Info.ResName);
   Replace(cmdstr,'$STRIP',StripStr);
+{$ifdef OPTALIGN}
+  Replace(cmdstr,'$SCRIPT','--script='+outputexedir+Info.ResName);
+{$endif OPTALIGN}
   success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
 
 { Remove ReponseFile }
@@ -292,7 +435,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:50  michael
+  Revision 1.3  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.2  2000/07/13 11:32:50  michael
   + removed logs
 
-}
+}

compiler/tcinl.pas

@@ -559,6 +559,13 @@ implementation
                     end;
                end;
 
+             in_typeinfo_x:
+               begin
+                  p^.resulttype:=voidpointerdef;
+                  p^.location.loc:=LOC_REGISTER;
+                  p^.registers32:=1;
+               end;
+
              in_assigned_x:
                begin
                   set_varstate(p^.left,true);
@@ -1328,7 +1335,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  2000-08-01 14:07:49  jonas
+  Revision 1.5  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.4  2000/08/01 14:07:49  jonas
     * fixed crash when passing undeclared identifiers to str() (merged from
       fixes branch)
 
@@ -1338,4 +1348,4 @@ end.
   Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
 
-}
+}

compiler/tcmat.pas

@@ -378,7 +378,9 @@ implementation
          if (p^.left^.treetype=ordconstn) then
            begin
               if is_boolean(p^.left^.resulttype) then
-               t:=genordinalconstnode(byte(not(boolean(p^.left^.value))),p^.left^.resulttype)
+               { here we do a boolena(byte(..)) type cast because }
+               { boolean(<int64>) is buggy in 1.00                }
+               t:=genordinalconstnode(byte(not(boolean(byte(p^.left^.value)))),p^.left^.resulttype)
               else
                t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
               disposetree(p);
@@ -477,7 +479,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:52  michael
+  Revision 1.3  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
 
-}
+}

compiler/tree.pas

@@ -229,7 +229,7 @@ unit tree;
                       no_check,unit_specific,
                       return_value_used,static_call : boolean);
              addrn : (procvarload:boolean);
-             ordconstn : (value : longint);
+             ordconstn : (value : TConstExprInt);
              realconstn : (value_real : bestreal;lab_real : pasmlabel);
              fixconstn : (value_fix: longint);
              funcretn : (funcretprocinfo : pointer;
@@ -273,8 +273,8 @@ unit tree;
     function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
     function gensinglenode(t : ttreetyp;l : ptree) : ptree;
     function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
-    function genordinalconstnode(v : longint;def : pdef) : ptree;
+    function genordinalconstnode(v : TConstExprInt;def : pdef) : ptree;
-    function genpointerconstnode(v : longint;def : pdef) : ptree;
+    function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
     function genfixconstnode(v : longint;def : pdef) : ptree;
     function gentypeconvnode(node : ptree;t : pdef) : ptree;
     function gentypenode(t : pdef;sym:ptypesym) : ptree;
@@ -848,7 +848,7 @@ unit tree;
          genloopnode:=p;
       end;
 
-    function genordinalconstnode(v : longint;def : pdef) : ptree;
+    function genordinalconstnode(v : tconstexprint;def : pdef) : ptree;
 
       var
          p : ptree;
@@ -876,7 +876,7 @@ unit tree;
          genordinalconstnode:=p;
       end;
 
-    function genpointerconstnode(v : longint;def : pdef) : ptree;
+    function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
 
       var
          p : ptree;
@@ -1470,18 +1470,18 @@ unit tree;
               if not(cs_ansistrings in aktlocalswitches) and (len>255) then
                len:=255;
               getmem(pc,len+1);
-              move(pchar(p^.value)^,pc^,len);
+              move(pchar(tpointerord(p^.value))^,pc^,len);
               pc[len]:=#0;
               p1:=genpcharconstnode(pc,len);
             end;
           constchar :
             p1:=genordinalconstnode(p^.value,cchardef);
           constreal :
-            p1:=genrealconstnode(pbestreal(p^.value)^,bestrealdef^);
+            p1:=genrealconstnode(pbestreal(tpointerord(p^.value))^,bestrealdef^);
           constbool :
             p1:=genordinalconstnode(p^.value,booldef);
           constset :
-            p1:=gensetconstnode(pconstset(p^.value),psetdef(p^.consttype.def));
+            p1:=gensetconstnode(pconstset(tpointerord(p^.value)),psetdef(p^.consttype.def));
           constord :
             p1:=genordinalconstnode(p^.value,p^.consttype.def);
           constpointer :
@@ -2133,7 +2133,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.5  2000-08-12 06:46:51  florian
+  Revision 1.6  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.5  2000/08/12 06:46:51  florian
     + case statement for int64/qword implemented
 
   Revision 1.4  2000/08/06 19:39:28  peter
@@ -2144,4 +2147,4 @@ end.
 
   Revision 1.2  2000/07/13 11:32:52  michael
   + removed logs
-}
+}

compiler/types.pas

@@ -24,7 +24,7 @@ unit types;
 interface
 
     uses
-       cobjects,symtable
+       cobjects,symtable,cpuinfo
        {$IFDEF NEWST}
        ,defs
        {$ENDIF NEWST};
@@ -168,7 +168,7 @@ interface
 
     { if l isn't in the range of def a range check error is generated and
       the value is placed within the range }
-    procedure testrange(def : pdef;var l : longint);
+    procedure testrange(def : pdef;var l : tconstexprint);
 
     { returns the range of def }
     procedure getrange(def : pdef;var l : longint;var h : longint);
@@ -241,8 +241,8 @@ implementation
              begin
                if sym1^.len=sym2^.len then
                 begin
-                  p1:=pchar(sym1^.value);
+                  p1:=pchar(tpointerord(sym1^.value));
-                  p2:=pchar(sym2^.value);
+                  p2:=pchar(tpointerord(sym2^.value));
                   pend:=p1+sym1^.len;
                   while (p1<pend) do
                    begin
@@ -256,9 +256,9 @@ implementation
                 end;
              end;
            constreal :
-             equal_constsym:=(pbestreal(sym1^.value)^=pbestreal(sym2^.value)^);
+             equal_constsym:=(pbestreal(tpointerord(sym1^.value))^=pbestreal(tpointerord(sym2^.value))^);
            constset :
-             equal_constsym:=(pnormalset(sym1^.value)^=pnormalset(sym2^.value)^);
+             equal_constsym:=(pnormalset(tpointerord(sym1^.value))^=pnormalset(tpointerord(sym2^.value))^);
            constnil :
              equal_constsym:=true;
         end;
@@ -705,7 +705,7 @@ implementation
       end;
 
     { test if l is in the range of def, outputs error if out of range }
-    procedure testrange(def : pdef;var l : longint);
+    procedure testrange(def : pdef;var l : tconstexprint);
       var
          lv,hv: longint;
 
@@ -1140,7 +1140,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2000-08-13 13:07:18  peter
+  Revision 1.7  2000-08-16 13:06:07  florian
+    + support of 64 bit integer constants
+
+  Revision 1.6  2000/08/13 13:07:18  peter
     * equal_paras now also checks default parameter value
 
   Revision 1.5  2000/08/12 06:49:22  florian