Browse Source

* fixed wrong typed constant procvars in preparation of my fix which will
disallow them in FPC mode (plus some other unmerged changes since
LAST_MERGE)

Jonas Maebe 24 years ago
parent
commit
cbc6756190
7 changed files with 91 additions and 42 deletions
  1. 16 11
      compiler/comphook.pas
  2. 15 6
      rtl/go32v2/go32.pp
  3. 10 1
      rtl/go32v2/graph.pp
  4. 15 10
      rtl/inc/heap.inc
  5. 16 11
      rtl/inc/heaptrc.pp
  6. 7 2
      rtl/inc/videoh.inc
  7. 12 1
      rtl/win32/graph.pp

+ 16 - 11
compiler/comphook.pas

@@ -122,18 +122,18 @@ type
   tgetnamedfiletimefunc = function(const filename: string): longint;
   tgetnamedfiletimefunc = function(const filename: string): longint;
 
 
 const
 const
-  do_stop          : tstopprocedure   = def_stop;
-  do_halt          : thaltprocedure   = def_halt;
-  do_status        : tstatusfunction  = def_status;
-  do_comment       : tcommentfunction = def_comment;
-  do_internalerror : tinternalerrorfunction = def_internalerror;
+  do_stop          : tstopprocedure   = {$ifndef tp}@{$endif}def_stop;
+  do_halt          : thaltprocedure   = {$ifndef tp}@{$endif}def_halt;
+  do_status        : tstatusfunction  = {$ifndef tp}@{$endif}def_status;
+  do_comment       : tcommentfunction = {$ifndef tp}@{$endif}def_comment;
+  do_internalerror : tinternalerrorfunction = {$ifndef tp}@{$endif}def_internalerror;
 
 
-  do_initsymbolinfo : tinitsymbolinfoproc = def_initsymbolinfo;
-  do_donesymbolinfo : tdonesymbolinfoproc = def_donesymbolinfo;
-  do_extractsymbolinfo : textractsymbolinfoproc = def_extractsymbolinfo;
+  do_initsymbolinfo : tinitsymbolinfoproc = {$ifndef tp}@{$endif}def_initsymbolinfo;
+  do_donesymbolinfo : tdonesymbolinfoproc = {$ifndef tp}@{$endif}def_donesymbolinfo;
+  do_extractsymbolinfo : textractsymbolinfoproc = {$ifndef tp}@{$endif}def_extractsymbolinfo;
 
 
-  do_openinputfile : topeninputfilefunc = def_openinputfile;
-  do_getnamedfiletime : tgetnamedfiletimefunc = def_getnamedfiletime;
+  do_openinputfile : topeninputfilefunc = {$ifndef tp}@{$endif}def_openinputfile;
+  do_getnamedfiletime : tgetnamedfiletimefunc = {$ifndef tp}@{$endif}def_getnamedfiletime;
 
 
 implementation
 implementation
 
 
@@ -351,7 +351,12 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  2001-02-05 20:47:00  peter
+  Revision 1.14  2001-06-06 17:20:21  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.13  2001/02/05 20:47:00  peter
     * support linux unit for ver1_0 compilers
     * support linux unit for ver1_0 compilers
 
 
   Revision 1.12  2001/01/21 20:32:45  marco
   Revision 1.12  2001/01/21 20:32:45  marco

+ 15 - 6
rtl/go32v2/go32.pp

@@ -207,11 +207,11 @@ var
        { this procedures are assigned to the procedure which are needed }
        { this procedures are assigned to the procedure which are needed }
        { for the current mode to access DOS memory                      }
        { for the current mode to access DOS memory                      }
        { It's strongly recommended to use this procedures!              }
        { It's strongly recommended to use this procedures!              }
-       dosmemput      : procedure(seg : word;ofs : word;var data;count : longint)=dpmi_dosmemput;
-       dosmemget      : procedure(seg : word;ofs : word;var data;count : longint)=dpmi_dosmemget;
-       dosmemmove     : procedure(sseg,sofs,dseg,dofs : word;count : longint)=dpmi_dosmemmove;
-       dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=dpmi_dosmemfillchar;
-       dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=dpmi_dosmemfillword;
+       dosmemput      : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemput;
+       dosmemget      : procedure(seg : word;ofs : word;var data;count : longint)=@dpmi_dosmemget;
+       dosmemmove     : procedure(sseg,sofs,dseg,dofs : word;count : longint)=@dpmi_dosmemmove;
+       dosmemfillchar : procedure(seg,ofs : word;count : longint;c : char)=@dpmi_dosmemfillchar;
+       dosmemfillword : procedure(seg,ofs : word;count : longint;w : word)=@dpmi_dosmemfillword;
 
 
   implementation
   implementation
 
 
@@ -307,12 +307,16 @@ var
          regs.realsp:=0;
          regs.realsp:=0;
          regs.realss:=0;
          regs.realss:=0;
          asm
          asm
+            { save all used registers to avoid crash under NTVDM }
+            { when spawning a 32-bit DPMI application            }
+            pushw %fs
             movw  intnr,%bx
             movw  intnr,%bx
             xorl  %ecx,%ecx
             xorl  %ecx,%ecx
             movl  regs,%edi
             movl  regs,%edi
             { es is always equal ds }
             { es is always equal ds }
             movl  $0x300,%eax
             movl  $0x300,%eax
             int   $0x31
             int   $0x31
+            popw  %fs
             setnc %al
             setnc %al
             movb  %al,__RESULT
             movb  %al,__RESULT
          end;
          end;
@@ -1171,7 +1175,12 @@ end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.3  2000-12-30 22:42:30  peter
+  Revision 1.4  2001-06-06 17:20:21  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.3  2000/12/30 22:42:30  peter
     * fixed map_device_in_memory (from bug report)
     * fixed map_device_in_memory (from bug report)
 
 
   Revision 1.2  2000/07/13 11:33:40  michael
   Revision 1.2  2000/07/13 11:33:40  michael

+ 10 - 1
rtl/go32v2/graph.pp

@@ -2117,6 +2117,10 @@ const CrtAddress: word = 0;
      { check if VESA adapter supPorted...      }
      { check if VESA adapter supPorted...      }
 {$ifndef noSupPortVESA}
 {$ifndef noSupPortVESA}
      hasVesa := getVesaInfo(VESAInfo);
      hasVesa := getVesaInfo(VESAInfo);
+     { VBE Version v1.00 is unstable, therefore }
+     { only VBE v1.1 and later are supported.   }
+     if (hasVESA=TRUE) and (VESAInfo.Version <= $0100) then
+       hasVESA := False;
 {$else noSupPortVESA}
 {$else noSupPortVESA}
      hasVESA := false;
      hasVESA := false;
 {$endif noSupPortVESA}
 {$endif noSupPortVESA}
@@ -2653,7 +2657,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2001-04-14 14:05:42  peter
+  Revision 1.7  2001-06-06 17:20:22  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.6  2001/04/14 14:05:42  peter
     * fixed for stricter checking
     * fixed for stricter checking
 
 
   Revision 1.5  2000/12/16 15:57:17  jonas
   Revision 1.5  2000/12/16 15:57:17  jonas

+ 15 - 10
rtl/inc/heap.inc

@@ -62,15 +62,15 @@ const
 { Memory manager }
 { Memory manager }
 const
 const
   MemoryManager: TMemoryManager = (
   MemoryManager: TMemoryManager = (
-    GetMem: SysGetMem;
-    FreeMem: SysFreeMem;
-    FreeMemSize: SysFreeMemSize;
-    AllocMem: SysAllocMem;
-    ReAllocMem: SysReAllocMem;
-    MemSize: SysMemSize;
-    MemAvail: SysMemAvail;
-    MaxAvail: SysMaxAvail;
-    HeapSize: SysHeapSize;
+    GetMem: @SysGetMem;
+    FreeMem: @SysFreeMem;
+    FreeMemSize: @SysFreeMemSize;
+    AllocMem: @SysAllocMem;
+    ReAllocMem: @SysReAllocMem;
+    MemSize: @SysMemSize;
+    MemAvail: @SysMemAvail;
+    MaxAvail: @SysMaxAvail;
+    HeapSize: @SysHeapSize;
   );
   );
 
 
 type
 type
@@ -1125,7 +1125,12 @@ end;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.5  2001-01-24 21:47:18  florian
+  Revision 1.6  2001-06-06 17:20:22  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.5  2001/01/24 21:47:18  florian
     + more MT stuff added
     + more MT stuff added
 
 
   Revision 1.4  2000/08/08 19:22:46  peter
   Revision 1.4  2000/08/08 19:22:46  peter

+ 16 - 11
rtl/inc/heaptrc.pp

@@ -719,7 +719,7 @@ var
    data_end : cardinal;external name '__data_end__';
    data_end : cardinal;external name '__data_end__';
 {$endif}
 {$endif}
 
 
-procedure CheckPointer(p : pointer);[saveregisters, public, alias : 'FPC_CHECKPOINTER'];
+procedure CheckPointer(p : pointer);[saveregisters,public, alias : 'FPC_CHECKPOINTER'];
 var
 var
   i  : longint;
   i  : longint;
   pp : pheap_mem_info;
   pp : pheap_mem_info;
@@ -982,15 +982,15 @@ end;
 
 
 const
 const
   TraceManager:TMemoryManager=(
   TraceManager:TMemoryManager=(
-    Getmem  : TraceGetMem;
-    Freemem : TraceFreeMem;
-    FreememSize : TraceFreeMemSize;
-    AllocMem : TraceAllocMem;
-    ReAllocMem : TraceReAllocMem;
-    MemSize : TraceMemSize;
-    MemAvail : TraceMemAvail;
-    MaxAvail : TraceMaxAvail;
-    HeapSize : TraceHeapsize;
+    Getmem  : @TraceGetMem;
+    Freemem : @TraceFreeMem;
+    FreememSize : @TraceFreeMemSize;
+    AllocMem : @TraceAllocMem;
+    ReAllocMem : @TraceReAllocMem;
+    MemSize : @TraceMemSize;
+    MemAvail : @TraceMemAvail;
+    MaxAvail : @TraceMaxAvail;
+    HeapSize : @TraceHeapsize;
   );
   );
 
 
 
 
@@ -1146,7 +1146,12 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.13  2001-04-23 18:25:44  peter
+  Revision 1.14  2001-06-06 17:20:22  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.13  2001/04/23 18:25:44  peter
     * m68k updates
     * m68k updates
 
 
   Revision 1.12  2001/04/21 12:18:09  peter
   Revision 1.12  2001/04/21 12:18:09  peter

+ 7 - 2
rtl/inc/videoh.inc

@@ -148,11 +148,16 @@ const
   errOk              = 0;
   errOk              = 0;
   ErrorCode: Longint = ErrOK;
   ErrorCode: Longint = ErrOK;
   ErrorInfo: Pointer = nil;
   ErrorInfo: Pointer = nil;
-  ErrorHandler: TErrorHandler = DefaultErrorHandler;
+  ErrorHandler: TErrorHandler = @DefaultErrorHandler;
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.1  2001-01-13 11:13:12  peter
+  Revision 1.2  2001-06-06 17:20:22  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.1  2001/01/13 11:13:12  peter
     * API 2 RTL
     * API 2 RTL
 
 
 }
 }

+ 12 - 1
rtl/win32/graph.pp

@@ -2222,7 +2222,12 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.6  2001-04-16 10:57:05  peter
+  Revision 1.7  2001-06-06 17:20:22  jonas
+    * fixed wrong typed constant procvars in preparation of my fix which will
+      disallow them in FPC mode (plus some other unmerged changes since
+      LAST_MERGE)
+
+  Revision 1.6  2001/04/16 10:57:05  peter
     * stricter compiler fixes
     * stricter compiler fixes
 
 
   Revision 1.5  2000/12/19 11:59:12  michael
   Revision 1.5  2000/12/19 11:59:12  michael
@@ -2240,4 +2245,10 @@ end.
   Revision 1.2  2000/07/13 11:33:57  michael
   Revision 1.2  2000/07/13 11:33:57  michael
   + removed logs
   + removed logs
 
 
+<<<<<<< graph.pp
+}
+=======
+  Revision 1.1  1999/11/03 20:23:02  florian
+    + first release of win32 gui support
 }
 }
+>>>>>>> 1.1.2.1