Browse Source

+ FCL made compilable under OS/2

Tomas Hajny 24 years ago
parent
commit
ad05477688
5 changed files with 41 additions and 10 deletions
  1. 13 1
      fcl/os2/Makefile
  2. 1 0
      fcl/os2/Makefile.fpc
  3. 5 2
      fcl/os2/classes.pp
  4. 11 1
      fcl/os2/pipes.inc
  5. 11 6
      fcl/os2/thread.inc

+ 13 - 1
fcl/os2/Makefile

@@ -1,5 +1,5 @@
 #
 #
-# Makefile generated by fpcmake v1.00 [2000/10/27]
+# Makefile generated by fpcmake v1.00 [2000/12/15]
 #
 #
 
 
 defaultrule: all
 defaultrule: all
@@ -24,6 +24,7 @@ nopwd:
 	@exit
 	@exit
 else
 else
 inUnix=1
 inUnix=1
+PWD:=$(firstword $(PWD))
 endif
 endif
 else
 else
 PWD:=$(firstword $(PWD))
 PWD:=$(firstword $(PWD))
@@ -194,6 +195,7 @@ endif
 
 
 override DIROBJECTS+=$(wildcard ../xml ../shedit)
 override DIROBJECTS+=$(wildcard ../xml ../shedit)
 override UNITOBJECTS+=classes $(INCUNITS)
 override UNITOBJECTS+=classes $(INCUNITS)
+override RSTOBJECTS+=classes cachecls
 
 
 # Clean
 # Clean
 
 
@@ -921,6 +923,16 @@ override CLEANPPUFILES+=$(UNITPPUFILES)
 
 
 fpc_units: $(UNITPPUFILES)
 fpc_units: $(UNITPPUFILES)
 
 
+#####################################################################
+# Resource strings
+#####################################################################
+
+ifdef RSTOBJECTS
+override RSTFILES=$(addsuffix $(RSTEXT),$(RSTOBJECTS))
+
+override CLEANRSTFILES+=$(RSTFILES)
+endif
+
 #####################################################################
 #####################################################################
 # General compile rules
 # General compile rules
 #####################################################################
 #####################################################################

+ 1 - 0
fcl/os2/Makefile.fpc

@@ -5,6 +5,7 @@
 [targets]
 [targets]
 dirs=../xml ../shedit
 dirs=../xml ../shedit
 units=classes $(INCUNITS)
 units=classes $(INCUNITS)
+rst=classes cachecls
 
 
 [defaults]
 [defaults]
 defaulttarget=os2
 defaulttarget=os2

+ 5 - 2
fcl/os2/classes.pp

@@ -24,6 +24,7 @@ unit Classes;
 interface
 interface
 
 
 uses
 uses
+  DosCalls, (* Needed here (i.e. before SysUtils) to avoid type clashes. *)
   strings,
   strings,
   sysutils;
   sysutils;
 
 
@@ -32,7 +33,6 @@ uses
 implementation
 implementation
 
 
 uses
 uses
-  doscalls,
   typinfo;
   typinfo;
 
 
 { OS - independent class implementations are in /inc directory. }
 { OS - independent class implementations are in /inc directory. }
@@ -47,7 +47,10 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2000-08-25 17:32:16  hajny
+  Revision 1.4  2000-12-19 00:43:07  hajny
+    + FCL made compilable under OS/2
+
+  Revision 1.3  2000/08/25 17:32:16  hajny
     * Cosmetic change (OS/2 instead of win32 in header)
     * Cosmetic change (OS/2 instead of win32 in header)
 
 
   Revision 1.2  2000/07/13 11:33:01  michael
   Revision 1.2  2000/07/13 11:33:01  michael

+ 11 - 1
fcl/os2/pipes.inc

@@ -1,4 +1,5 @@
 {
 {
+    $Id$
     $Id$
     $Id$
     This file is part of the Free Pascal run time library.
     This file is part of the Free Pascal run time library.
     Copyright (c) 1999-2000 by Michael Van Canneyt
     Copyright (c) 1999-2000 by Michael Van Canneyt
@@ -14,6 +15,12 @@
 
 
  **********************************************************************}
  **********************************************************************}
 
 
+uses
+ DosCalls;
+
+const
+ PipeBufSize = 1024;
+
 Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
 Function CreatePipeHandles (Var Inhandle,OutHandle : Longint) : Boolean;
 
 
 begin
 begin
@@ -21,7 +28,10 @@ begin
 end;
 end;
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2000-08-25 17:33:44  hajny
+  Revision 1.4  2000-12-19 00:43:07  hajny
+    + FCL made compilable under OS/2
+
+  Revision 1.3  2000/08/25 17:33:44  hajny
     * Made compilable again (missing bracket at the begin of logs)
     * Made compilable again (missing bracket at the begin of logs)
 
 
   Revision 1.2  2000/07/13 11:33:01  michael
   Revision 1.2  2000/07/13 11:33:01  michael

+ 11 - 6
fcl/os2/thread.inc

@@ -16,17 +16,18 @@
 {****************************************************************************}
 {****************************************************************************}
 
 
 const
 const
- Priorities: array [TThreadPriority] of word = ($100, $200, $207, $20F, $217
+ Priorities: array [TThreadPriority] of word = ($100, $200, $207, $20F, $217,
   $21F, $300);
   $21F, $300);
+ ThreadCount: longint = 0;
 
 
 
 
-procedure AddThread;
+procedure AddThread (T: TThread);
 begin
 begin
  Inc (ThreadCount);
  Inc (ThreadCount);
 end;
 end;
 
 
 
 
-procedure RemoveThread;
+procedure RemoveThread (T: TThread);
 begin
 begin
  Dec (ThreadCount);
  Dec (ThreadCount);
 end;
 end;
@@ -89,9 +90,10 @@ begin
 end;
 end;
 
 
 
 
-function ThreadProc(Thread: TThread): Integer; cdecl;
+function ThreadProc(Args: pointer): Integer; cdecl;
 var
 var
   FreeThread: Boolean;
   FreeThread: Boolean;
+  Thread: TThread absolute Args;
 begin
 begin
   Thread.Execute;
   Thread.Execute;
   FreeThread := Thread.FFreeOnTerminate;
   FreeThread := Thread.FFreeOnTerminate;
@@ -109,7 +111,7 @@ begin
   inherited Create;
   inherited Create;
   AddThread (Self);
   AddThread (Self);
   FSuspended := CreateSuspended;
   FSuspended := CreateSuspended;
-  Flags := dtStack_Committed;
+  Flags := dtStack_Commited;
   if FSuspended then Flags := Flags or dtSuspended;
   if FSuspended then Flags := Flags or dtSuspended;
   if DosCreateThread (FThreadID, @ThreadProc, pointer (Self), Flags, 16384)
   if DosCreateThread (FThreadID, @ThreadProc, pointer (Self), Flags, 16384)
                                                                       <> 0 then
                                                                       <> 0 then
@@ -159,7 +161,10 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.2  2000-07-13 11:33:02  michael
+  Revision 1.3  2000-12-19 00:43:07  hajny
+    + FCL made compilable under OS/2
+
+  Revision 1.2  2000/07/13 11:33:02  michael
   + removed logs
   + removed logs
  
  
 }
 }