Merged revisions 1620-1623 via svnmerge from

http://svn.freepascal.org/svn/fpc/trunk

r1620 (florian)
* BGI font fix from Lowell C. Savage


r1621 (florian)
* patch from Ales Katona to add a stack size parameter to tthread functions


r1622 (florian)
* fixed for 64 bit targets


r1623 (florian)
* fixed previous commit

git-svn-id: branches/fixes_2_0@1624 -

fcl/db/sqldb/odbc/odbcconn.pas

@@ -17,7 +17,7 @@ interface
 
 uses
   Classes, SysUtils, sqldb, db, odbcsql;
-  
+
 type
 
   // forward declarations
@@ -35,13 +35,13 @@ type
     constructor Create(Connection:TODBCConnection);
     destructor Destroy; override;
   end;
-  
+
   { TODBCHandle } // this name is a bit confusing, but follows the standards for naming classes in sqldb
 
   TODBCHandle = class(TSQLHandle)
   protected
   end;
-  
+
   { TODBCEnvironment }
 
   TODBCEnvironment = class
@@ -61,7 +61,7 @@ type
     FEnvironment:TODBCEnvironment;
     FDBCHandle:SQLHDBC; // ODBC Connection Handle
     FFileDSN: string;
-    
+
     procedure SetParameters(ODBCCursor:TODBCCursor; AParams:TParams);
     procedure FreeParamBuffers(ODBCCursor:TODBCCursor);
   protected
@@ -96,7 +96,7 @@ type
     procedure UpdateIndexDefs(var IndexDefs:TIndexDefs; TableName:string); override;
     // - Schema info
     function GetSchemaInfoSQL(SchemaType:TSchemaType; SchemaObjectName, SchemaObjectPattern:string):string; override;
-    
+
     // Internal utility functions
     function CreateConnectionString:string;
   public
@@ -119,7 +119,7 @@ type
     property Params;       // will be added to connection string
     property OnLogin;
   end;
-  
+
   EODBCException = class(Exception)
     // currently empty; perhaps we can add fields here later that describe the error instead of one simple message string
   end;
@@ -132,7 +132,7 @@ uses
 const
   DefaultEnvironment:TODBCEnvironment = nil;
   ODBCLoadCount:integer = 0; // ODBC is loaded when > 0; modified by TODBCEnvironment.Create/Destroy
-  
+
 { Generic ODBC helper functions }
 
 function ODBCSucces(const Res:SQLRETURN):boolean;
@@ -167,7 +167,7 @@ begin
   CheckSQLGetDiagResult(Res);
   if ODBCSucces(LastReturnCode) then
     Exit; // no error; all is ok
-    
+
   // build TotalMessage for exception to throw
   TotalMessage:=Format('%s ODBC error details:',[ErrorMsg]);
   // retrieve status records
@@ -219,7 +219,7 @@ function TODBCConnection.CreateConnectionString: string;
     else
       Result:=s;
   end;
-  
+
 var
   i: Integer;
   Param: string;
@@ -321,7 +321,9 @@ end;
 function TODBCConnection.GetHandle: pointer;
 begin
   // I'm not sure whether this is correct; perhaps we should return nil
-  Result:=pointer(FDBCHandle); // note that FDBHandle is a LongInt, because ODBC handles are integers, not pointers
+  // note that FDBHandle is a LongInt, because ODBC handles are integers, not pointers
+  // I wonder how this will work on 64 bit platforms then (FK)
+  Result:=pointer(PtrInt(FDBCHandle));
 end;
 
 procedure TODBCConnection.DoInternalConnect;
@@ -333,7 +335,7 @@ var
   ActualLength:SQLSMALLINT;
 begin
   inherited DoInternalConnect;
-  
+
   // make sure we have an environment
   if not Assigned(FEnvironment) then
   begin
@@ -341,7 +343,7 @@ begin
       DefaultEnvironment:=TODBCEnvironment.Create;
     FEnvironment:=DefaultEnvironment;
   end;
-    
+
   // allocate connection handle
   SQLAllocHandle(SQL_HANDLE_DBC,Environment.FENVHandle,FDBCHandle);
   ODBCCheckResult(SQL_HANDLE_ENV,Environment.FENVHandle,'Could not allocate ODBC Connection handle.');
@@ -367,11 +369,11 @@ end;
 procedure TODBCConnection.DoInternalDisconnect;
 begin
   inherited DoInternalDisconnect;
-  
+
   // disconnect
   SQLDisconnect(FDBCHandle);
   ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not disconnect.');
-  
+
   // deallocate connection handle
   if SQLFreeHandle(SQL_HANDLE_DBC, FDBCHandle)=SQL_ERROR then
     ODBCCheckResult(SQL_HANDLE_DBC,FDBCHandle,'Could not free connection handle.');
@@ -414,7 +416,7 @@ var
   NewQueryIndex,BufIndex,CopyLen,i:integer;
 begin
   ODBCCursor:=cursor as TODBCCursor;
-  
+
   // Parameter handling
   // Note: We can only pass ? parameters to ODBC, so we should convert named parameters like :MyID
   //       ODBCCursor.FParamIndex will map th i-th ? token in the (modified) query to an index for AParams
@@ -484,7 +486,7 @@ begin
             SetLength(ParamPart,NewLength);
             SetLength(ODBCCursor.FParamIndex,NewLength);
           end;
-        
+
           if p^=':' then
           begin // find parameter name
             Inc(p);
@@ -499,7 +501,7 @@ begin
             ParamNameStart:=p;
             ParamName:='';
           end;
-          
+
           // find ParameterIndex
           if ParamName<>'' then
           begin
@@ -512,12 +514,12 @@ begin
             ParameterIndex:=QuestionMarkParamCount;
             Inc(QuestionMarkParamCount);
           end;
-          
+
           // store ParameterIndex in FParamIndex, ParamPart data
           ODBCCursor.FParamIndex[ParamCount-1]:=ParameterIndex;
           ParamPart[ParamCount-1].Start:=ParamNameStart-BufStart;
           ParamPart[ParamCount-1].Stop:=p-BufStart+1;
-          
+
           // update NewQueryLength
           Dec(NewQueryLength,p-ParamNameStart);
         end;
@@ -529,7 +531,7 @@ begin
 
   SetLength(ParamPart,ParamCount);
   SetLength(ODBCCursor.FParamIndex,ParamCount);
-  
+
   if ParamCount>0 then
   begin
     // replace :ParamName by ? (using ParamPart array and NewQueryLength)
@@ -550,11 +552,11 @@ begin
   end
   else
     NewQuery:=buf;
-    
+
   // prepare statement
   SQLPrepare(ODBCCursor.FSTMTHandle, PChar(NewQuery), Length(NewQuery));
   ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not prepare statement.');
-  
+
   ODBCCursor.FQuery:=NewQuery;
 end;
 
@@ -599,14 +601,14 @@ var
   Res:SQLRETURN;
 begin
   ODBCCursor:=cursor as TODBCCursor;
-  
+
   // set parameters
   SetParameters(ODBCCursor, AParams);
 
   // execute the statement
   Res:=SQLExecute(ODBCCursor.FSTMTHandle);
   ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not execute statement.');
-  
+
   // free parameter buffers
   FreeParamBuffers(ODBCCursor);
 end;
@@ -617,12 +619,12 @@ var
   Res:SQLRETURN;
 begin
   ODBCCursor:=cursor as TODBCCursor;
-  
+
   // fetch new row
   Res:=SQLFetch(ODBCCursor.FSTMTHandle);
   if Res<>SQL_NO_DATA then
     ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not fetch new row from result set');
-  
+
   // result is true iff a new row was available
   Result:=Res<>SQL_NO_DATA;
 end;
@@ -637,7 +639,7 @@ var
   DateTime:TDateTime;
 begin
   ODBCCursor:=cursor as TODBCCursor;
-  
+
   // load the field using SQLGetData
   // Note: optionally we can implement the use of SQLBindCol later for even more speed
   // TODO: finish this
@@ -716,7 +718,7 @@ var
   FieldSize:word;
 begin
   ODBCCursor:=cursor as TODBCCursor;
-  
+
   // get number of columns in result set
   SQLNumResultCols(ODBCCursor.FSTMTHandle, ColumnCount);
   ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, 'Could not determine number of columns in result set.');
@@ -752,7 +754,7 @@ begin
                       nil);                   // no numerical output
       ODBCCheckResult(SQL_HANDLE_STMT, ODBCCursor.FSTMTHandle, Format('Could not get column name for column %d.',[i]));
     end;
-      
+
     // convert type
     // NOTE: I made some guesses here after I found only limited information about TFieldType; please report any problems
     case DataType of
@@ -826,7 +828,7 @@ begin
   // allocate environment handle
   if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FENVHandle)=SQL_Error then
     raise EODBCException.Create('Could not allocate ODBC Environment handle'); // we can't retrieve any more information, because we don't have a handle for the SQLGetDiag* functions
-  
+
   // set odbc version
   SQLSetEnvAttr(FENVHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0);
   ODBCCheckResult(SQL_HANDLE_ENV, FENVHandle,'Could not set ODBC version to 3.');
@@ -855,7 +857,7 @@ end;
 destructor TODBCCursor.Destroy;
 begin
   inherited Destroy;
-  
+
   // deallocate statement handle
   if SQLFreeHandle(SQL_HANDLE_STMT, FSTMTHandle)=SQL_ERROR then
     ODBCCheckResult(SQL_HANDLE_STMT, FSTMTHandle, 'Could not free ODBC Statement handle.');

rtl/darwin/tthread.inc

@@ -180,7 +180,8 @@ begin
 end;
 
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
@@ -192,7 +193,7 @@ begin
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   WRITE_DEBUG('TThread.Create done');
 end;
 

rtl/inc/graph/gtext.inc

@@ -77,7 +77,7 @@
 
       TStrokes = Array[0..1000] of TStroke;
 
-      opcodes = (_END_OF_CHAR, _DO_SCAN, _MOVE, _DRAW);
+      opcodes = (_END_OF_CHAR, _DO_SCAN, _DRAW := 253, _MOVE := 254 );
 
 
     var

rtl/inc/rtti.inc

@@ -125,7 +125,6 @@ begin
 end;
 
 
-
 Procedure fpc_Initialize (Data,TypeInfo : pointer);[Public,Alias : 'FPC_INITIALIZE'];  compilerproc;
 begin
   case PByte(TypeInfo)^ of
@@ -222,6 +221,78 @@ begin
 end;
 
 
+{
+Procedure fpc_Copy (Src, Dest, TypeInfo : Pointer);[Public,alias : 'FPC_COPY'];  compilerproc;
+var
+  Temp : pbyte;
+  namelen : byte;
+  count,
+  offset,
+  i : longint;
+  info : pointer;
+begin
+  case PByte(TypeInfo)^ of
+    tkAstring:
+      begin
+        fpc_AnsiStr_Incr_Ref(PPointer(Src)^);
+        fpc_AnsiStr_Decr_Ref(PPointer(Dest)^);
+        PPointer(Dest)^:=PPointer(Src)^;
+      end;
+    tkWstring:
+      begin
+        fpc_WideStr_Incr_Ref(PPointer(Src)^);
+        fpc_WideStr_Decr_Ref(PPointer(Dest)^);
+      end;
+    tkArray:
+      begin
+        arrayrtti(data,typeinfo,@fpc_systemDecRef);
+      end;
+    tkobject,
+    tkrecord:
+      begin
+        Temp:=PByte(TypeInfo);
+        inc(Temp);
+        { Skip Name }
+        namelen:=Temp^;
+        inc(temp,namelen+1);
+        temp:=aligntoptr(temp);
+
+        { copy data }
+        move(src^,dest^,plongint(temp)^);
+
+        { Skip size }
+        inc(Temp,4);
+        { Element count }
+        Count:=PLongint(Temp)^;
+        inc(Temp,sizeof(Count));
+        { Process elements }
+        for i:=1 to count Do
+          begin
+            Info:=PPointer(Temp)^;
+            inc(Temp,sizeof(Info));
+            Offset:=PLongint(Temp)^;
+            inc(Temp,sizeof(Offset));
+            fpc_Copy(Src+Offset,Src+Offset,Info);
+	  end;
+    tkDynArray:
+      begin
+        fpc_dynarray_Incr_Ref(PPointer(Src)^);
+        fpc_dynarray_Decr_Ref(PPointer(Dest)^);
+        PPointer(Dest)^:=PPointer(Src)^;
+      end;
+    tkInterface:
+      begin
+        Intf_Incr_Ref(PPointer(Src)^);
+        Intf_Decr_Ref(PPointer(Dest)^);
+        PPointer(Dest)^:=PPointer(Src)^;
+      end;
+    tkVariant:
+      VarCopyProc(pvardata(dest)^,pvardata(src)^);
+  end;
+end;
+}
+
+
 procedure fpc_finalize_array(data,typeinfo : pointer;count,size : longint); [Public,Alias:'FPC_FINALIZEARRAY'];  compilerproc;
   var
      i : longint;

rtl/inc/thread.inc

@@ -62,6 +62,11 @@ Var
         BeginThread:=BeginThread(nil,DefaultStackSize,ThreadFunction,p,0,ThreadId);
       end;
 
+    function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
+                     var ThreadId : TThreadID; const SS: DWord) : TThreadID;
+      begin
+        BeginThread:=BeginThread(nil,SS,ThreadFunction,p,0,ThreadId);
+      end;
 
     procedure EndThread;
       begin

rtl/inc/threadh.inc

@@ -15,8 +15,13 @@
  **********************************************************************}
 
 const
-   DefaultStackSize = 32768; { including 16384 margin for stackchecking }
-
+{$ifdef mswindows}
+  { on windows, use stack size of starting process }
+  DefaultStackSize = 0;
+{$else mswindows}
+  { including 16384 margin for stackchecking }
+  DefaultStackSize = 32768;
+{$endif mswindows}
 
 type
   PEventState = pointer;
@@ -112,6 +117,8 @@ function BeginThread(sa : Pointer;stacksize : dword;
 function BeginThread(ThreadFunction : tthreadfunc) : TThreadID;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer) : TThreadID;
 function BeginThread(ThreadFunction : tthreadfunc;p : pointer; var ThreadId : TThreadID) : TThreadID;
+function BeginThread(ThreadFunction : tthreadfunc;p : pointer;
+                     var ThreadId : TThreadID; const SS: DWord) : TThreadID;
 
 procedure EndThread(ExitCode : DWord);
 procedure EndThread;

rtl/linux/tthread.inc

@@ -185,7 +185,8 @@ begin
 end;
 
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
@@ -197,7 +198,7 @@ begin
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   WRITE_DEBUG('TThread.Create done');
 end;
 

rtl/morphos/tthread.inc

@@ -111,7 +111,8 @@ begin
 }
 end;
 
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 var
   Flags: cardinal;
 begin

rtl/netbsd/tthread.inc

@@ -176,7 +176,8 @@ begin
 end;
 
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
@@ -188,7 +189,7 @@ begin
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   WRITE_DEBUG('creating thread, self = ',longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   WRITE_DEBUG('TThread.Create done');
 end;
 

rtl/netware/tthread.inc

@@ -149,7 +149,8 @@ begin
 end;
 
 
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 var
   Flags: Integer;
 begin

rtl/netwlibc/tthread.inc

@@ -251,7 +251,8 @@ begin
 end;
 
 { TThread }
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 begin
   // lets just hope that the user doesn't create a thread
   // via BeginThread and creates the first TThread Object in there!
@@ -264,7 +265,7 @@ begin
   FInitialSuspended := CreateSuspended;
   FFatalException := nil;
   WRITE_DEBUG('creating thread, self = %d'#13#10,longint(self));
-  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID);
+  FHandle:= BeginThread(@ThreadFunc, Pointer(Self), FThreadID, StackSize);
   WRITE_DEBUG('TThread.Create done'#13#10);
 end;
 

rtl/os2/tthread.inc

@@ -173,7 +173,8 @@ begin
   DosExit (deThread, Result);
 end;
 
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 var
   Flags: cardinal;
 begin

rtl/win32/tthread.inc

@@ -114,7 +114,8 @@ begin
   if FreeThread then Thread.Free;
 end;
 
-constructor TThread.Create(CreateSuspended: Boolean);
+constructor TThread.Create(CreateSuspended: Boolean;
+                           const StackSize: DWord = DefaultStackSize);
 var
   Flags: Integer;
 begin
@@ -123,7 +124,8 @@ begin
   FSuspended := CreateSuspended;
   Flags := 0;
   if CreateSuspended then Flags := CREATE_SUSPENDED;
-  FHandle := BeginThread(nil, 0, @ThreadProc, pointer(self), Flags, FThreadID);
+  FHandle := BeginThread(nil, StackSize, @ThreadProc, pointer(self), Flags,
+                         FThreadID);
   FFatalException := nil;
 end;