+ added Log and Id tags

  * added first FPC support, only VGA works to some extend for now
  * use -dasmgraph to use assembler routines, otherwise Pascal
    equivalents are used
  * use -dsupportVESA to support VESA (crashes under FPC for now)
  * only dispose vesainfo at closegrph if a vesa card was detected
  * changed int32 to longint (int32 is not declared under FPC)
  * changed the declaration of almost every procedure in graph.inc to
    "far;" becquse otherwise you can't assign them to procvars under TP
    real mode (but unexplainable "data segnment too large" errors prevent
    it from working under real mode anyway)

rtl/inc/graph/clip.inc

@@ -1,4 +1,5 @@
 {
+    $Id$
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,99 by the Free Pascal development team
 
@@ -140,4 +141,19 @@ const
   LineClipped:=FALSE;
 end;
 
-
+{
+$Log$
+Revision 1.3  1999-07-12 13:27:09  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
+
+}

rtl/inc/graph/dpmi.inc

@@ -1,4 +1,6 @@
 {
+    $Id$
+
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,99 by the Free Pascal development team
 
@@ -40,3 +42,20 @@ asm
     @Exit:                                                      { Exit label }
     POP BP                                                      { Restore BP }
   end;
+
+{
+$Log$
+Revision 1.2  1999-07-12 13:27:10  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
+
+}

rtl/inc/graph/fills.inc

@@ -1,4 +1,6 @@
 {
+    $Id$
+
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,99 by Thomas Schatzl and Carl Eric Codere
 
@@ -16,44 +18,44 @@
 
 type
 {$IFDEF FPC}
-	graph_int = int32;  	{ platform specific integer used for indexes;
-							  should be 16 bits on TP/BP and 32 bits on every-
-							  thing else for speed reasons }
-	graph_float = double;	{ the platform's preferred floating point size }
+        graph_int = longint;      { platform specific integer used for indexes;
+                                                          should be 16 bits on TP/BP and 32 bits on every-
+                                                          thing else for speed reasons }
+        graph_float = double;   { the platform's preferred floating point size }
 {$ELSE}
-	graph_int = integer;	{ platform specific integer used for indexes;
-							  should be 16 bits on TP/BP and 32 bits on every-
-							  thing else for speed reasons }
-	graph_float = real;  	{ the platform's preferred floating point size }
+        graph_int = integer;    { platform specific integer used for indexes;
+                                                          should be 16 bits on TP/BP and 32 bits on every-
+                                                          thing else for speed reasons }
+        graph_float = real;     { the platform's preferred floating point size }
 {$ENDIF}
 
-	pedge = ^edge;
-	edge = packed record	{ an edge structure }
-		x,					{ current x-coordinate on the edge }
-		dx : graph_float;	{ deltax of the edge }
-		i : graph_int;		{ index to which points this edge belongs to
-							  always [i] and [i+1] }
-	end;
+        pedge = ^edge;
+        edge = packed record    { an edge structure }
+                x,                                      { current x-coordinate on the edge }
+                dx : graph_float;       { deltax of the edge }
+                i : graph_int;          { index to which points this edge belongs to
+                                                          always [i] and [i+1] }
+        end;
 
-	{ used for typecasting because TP/BP is more strict here than FPC }
-	pedgearray = ^edgearray;
+        { used for typecasting because TP/BP is more strict here than FPC }
+        pedgearray = ^edgearray;
     { 0..0 }
-	edgearray = array[0..0] of edge;
+        edgearray = array[0..0] of edge;
 
-	pint = ^graph_int;
+        pint = ^graph_int;
 
-	pintarray = ^intarray;
+        pintarray = ^intarray;
     { 0..0 }
-	intarray = array[0..0] of graph_int;
+        intarray = array[0..0] of graph_int;
 
-	ppointtype = ^pointtype;
-	ppointarray = ^pointarray;
-	pointarray = array[0..0] of pointtype;
+        ppointtype = ^pointtype;
+        ppointarray = ^pointarray;
+        pointarray = array[0..0] of pointtype;
 
 { definition of the called compare routine for the sort process. Returns -1 if
  the two parameters should be swapped }
 type
-	compareproc = function (a, b : pointer) : graph_int;
+        compareproc = function (a, b : pointer) : graph_int;
 
 { simple bubblesort, since it is expected that the edges themselves are not
   too mixed, it is fastest (?). Rather than sorting the active edge table
@@ -62,210 +64,212 @@ type
    procedure bsort(p : pointer; number : integer; sizeelem :
       integer; c : compareproc);
    var    i : graph_int;
-	   swap : boolean;
+           swap : boolean;
        temp : pointer;
 
-	   curp, nextp : pointer;
+           curp, nextp : pointer;
    begin
      getmem(temp, sizeelem);
-	 repeat
-	    curp := p;
-		nextp := pointer(longint(p) + sizeelem);
-		swap := false;
-		for i := 0 to (number-2) do begin
-			if (c(curp, nextp)=1) then begin
-				{ swap elements, you can't do it slower ;( }
-				move(curp^, temp^, sizeelem);
-				move(nextp^, curp^, sizeelem);
-				move(temp^, nextp^, sizeelem);
-				swap := true;
-			end;
-			inc(longint(curp), sizeelem);
-			inc(longint(nextp), sizeelem);
-		end;
-	 until swap = false;
-	 freemem(temp, sizeelem);
+         repeat
+            curp := p;
+                nextp := pointer(longint(p) + sizeelem);
+                swap := false;
+                for i := 0 to (number-2) do begin
+                        if (c(curp, nextp)=1) then begin
+                                { swap elements, you can't do it slower ;( }
+                                move(curp^, temp^, sizeelem);
+                                move(nextp^, curp^, sizeelem);
+                                move(temp^, nextp^, sizeelem);
+                                swap := true;
+                        end;
+                        inc(longint(curp), sizeelem);
+                        inc(longint(nextp), sizeelem);
+                end;
+         until swap = false;
+         freemem(temp, sizeelem);
    end;
 
   { guess what this does }
   function ceil(x : graph_float) : graph_int;
     var t : graph_int;
   begin
-	t:=Trunc(x);
-	If frac(x)>0 then inc(t);
-	ceil := t;
+        t:=Trunc(x);
+        If frac(x)>0 then inc(t);
+        ceil := t;
   end;
 
   { guess what this does too }
   function floor(x : graph_float) : graph_int;
    var t : graph_int;
   begin
-	t:=Trunc(x);
-	If frac(x)<0 then dec(t);
-	floor := t;
+        t:=Trunc(x);
+        If frac(x)<0 then dec(t);
+        floor := t;
   end;
 
   { simple descriptive name }
   function max(a, b : graph_int) : graph_int;
   begin
-   	 if (a > b) then max := a
-	  else max := b;
+         if (a > b) then max := a
+          else max := b;
   end;
 
   { here too }
   function min(a, b : graph_int) : graph_int;
   begin
-	if (a < b) then min := a
-	else min := b;
+        if (a < b) then min := a
+        else min := b;
   end;
 
   { needed for the compare functions; should NOT be used for anything else }
 var
-	ptable : ppointarray; { pointer to points list }
+        ptable : ppointarray; { pointer to points list }
 
 function compare_ind(u, v : pointer) : graph_int; far;
 begin
-	if (ptable^[pint(u)^].y <= ptable^[pint(v)^].y) then compare_ind := -1
-	else compare_ind := 1;
+        if (ptable^[pint(u)^].y <= ptable^[pint(v)^].y) then compare_ind := -1
+        else compare_ind := 1;
 end;
 
 function compare_active(u, v : pointer) : graph_int; far;
 begin
-	if (pedge(u)^.x <= pedge(v)^.x) then compare_active := -1
-	else compare_active := 1;
+        if (pedge(u)^.x <= pedge(v)^.x) then compare_active := -1
+        else compare_active := 1;
 end;
 
 procedure fillpoly(numpoints : word; var PolyPoints);
 { variables needed within the helper procedures too }
 var
-	activetable : pedgearray; { active edge table, e.g. edges crossing current scanline }
-	activepoints : graph_int; { number of points in active edge table }
+        activetable : pedgearray; { active edge table, e.g. edges crossing current scanline }
+        activepoints : graph_int; { number of points in active edge table }
 
 { remove edge i from active edge table }
 procedure cdelete(index : graph_int);
 var
-	j : graph_int;
+        j : graph_int;
 begin
-	j := 0;
-	while (j < activepoints) and (pedgearray(activetable)^[j].i <> index) do inc(j);
-	if (j >= activepoints) then exit;
-	dec(activepoints);
-	move(pedgearray(activetable)^[j+1], pedgearray(activetable)^[j],
-		(activepoints-j) * sizeof(edge));
+        j := 0;
+        while (j < activepoints) and (pedgearray(activetable)^[j].i <> index) do inc(j);
+        if (j >= activepoints) then exit;
+        dec(activepoints);
+        move(pedgearray(activetable)^[j+1], pedgearray(activetable)^[j],
+                (activepoints-j) * sizeof(edge));
 end;
 
 { insert edge index into active edge table (at the last position) }
 procedure cinsert(index, y : graph_int);
 var
-	j : graph_int;
-	deltax : graph_float;
-	p, q : ppointtype;
+        j : graph_int;
+        deltax : graph_float;
+        p, q : ppointtype;
 begin
-	if (index < (numpoints-1)) then j := index + 1 else j := 0;
-
-	if (ptable^[index].y < ptable^[j].y) then begin
-		p := @ptable^[index];
-		q := @ptable^[j];
-	end else begin
-		p := @ptable^[j];
-		q := @ptable^[index];
-	end;
-	deltax := (q^.x-p^.x)/(q^.y-p^.y);
-	with activetable^[activepoints] do begin
-		dx := deltax;
-		x := dx * (y { + 0.5} - p^.y) + p^.x;
-		i := index;
-	end;
-	inc(activepoints);
+        if (index < (numpoints-1)) then j := index + 1 else j := 0;
+
+        if (ptable^[index].y < ptable^[j].y) then begin
+                p := @ptable^[index];
+                q := @ptable^[j];
+        end else begin
+                p := @ptable^[j];
+                q := @ptable^[index];
+        end;
+        deltax := (q^.x-p^.x)/(q^.y-p^.y);
+        with activetable^[activepoints] do begin
+                dx := deltax;
+                x := dx * (y { + 0.5} - p^.y) + p^.x;
+                i := index;
+        end;
+        inc(activepoints);
 end;
 
 { variables for the main procedure }
 var
-	k, i, j : graph_int;
-	starty, endy, y, xl, xr : graph_int;
+        k, i, j : graph_int;
+        starty, endy, y, xl, xr : graph_int;
     oldcolor : word;
 var
-	indextable : pintarray; { list of vertex indices, sorted by y }
+        indextable : pintarray; { list of vertex indices, sorted by y }
 
 begin
     oldcolor := CurrentColor;
     CurrentColor := FillSettings.Color;
-	ptable := @PolyPoints;
-	if (numpoints<=0) then exit;
+        ptable := @PolyPoints;
+        if (numpoints<=0) then exit;
 
-	getmem(indextable, sizeof(graph_int) * numpoints);
-	getmem(activetable, sizeof(edge) * numpoints);
+        getmem(indextable, sizeof(graph_int) * numpoints);
+        getmem(activetable, sizeof(edge) * numpoints);
     if (not assigned(activetable)) or (not assigned(indextable)) then
       begin
         _GraphResult := grNoScanMem;
         exit;
       end;
 {$R-}
-	{ create y-sorted array of indices indextable[k] into vertex list }
-	for k := 0 to (numpoints-1) do
-		indextable^[k] := k;
-	{ sort the indextable by points[indextable[k]].y }
-	bsort(indextable, numpoints, sizeof(graph_int), compare_ind);
-	{ start with empty active edge table }
-	activepoints := 0;
-	{ indextable[k] is the next vertex to process }
-	k := 0;
-	{ ymin of polygon }
-	starty := ceil(pointarray(polypoints)[indextable^[0]].y-0.5);
-	{ ymax of polygon }
-	endy := floor(pointarray(polypoints)[indextable^[numpoints-1]].y-0.5);
-
-	{ step through scanlines }
-	for y := starty to endy do begin
-		{ check vertices between previous scanline and current one, if any }
-		while (k < numpoints) and
+        { create y-sorted array of indices indextable[k] into vertex list }
+        for k := 0 to (numpoints-1) do
+                indextable^[k] := k;
+        { sort the indextable by points[indextable[k]].y }
+        bsort(indextable, numpoints, sizeof(graph_int), compare_ind);
+        { start with empty active edge table }
+        activepoints := 0;
+        { indextable[k] is the next vertex to process }
+        k := 0;
+        { ymin of polygon }
+        starty := ceil(pointarray(polypoints)[indextable^[0]].y-0.5);
+        { ymax of polygon }
+        endy := floor(pointarray(polypoints)[indextable^[numpoints-1]].y-0.5);
+
+        { step through scanlines }
+        for y := starty to endy do begin
+                { check vertices between previous scanline and current one, if any }
+                while (k < numpoints) and
            (pointarray(polypoints)[indextable^[k]].y<=(y+0.5)) do begin
-			i := indextable^[k];
-			{ insert or delete edges before and after points[i] ((i-1) to i and
-			  i to (i+1)) from active edge table if they cross scanline y }
-			{ point previous to i }
-			if (i > 0) then j := i-1 else j := numpoints-1;
-			{ old edge, remove from list }
-			if (pointarray(polypoints)[j].y <= (y-0.5)) then cdelete(j)
-			{ new edge, add to active edges }
-			else if (pointarray(polypoints)[j].y > (y + 0.5)) then cinsert(j, y);
-
-			{ point next after i }
-			if (i < (numpoints-1)) then j := i+1 else j := 0;
-			{ old edge, remove from active edge table }
-			if (pointarray(polypoints)[j].y <= (y - 0.5)) then cdelete(i)
-			{ new edge, add to active edges }
-			else if (pointarray(polypoints)[j].y > (y + 0.5)) then cinsert(i, y);
-			inc(k);
-		end;
-		{ sort active edges list by active[j].x }
-		bsort(activetable, activepoints, sizeof(edge), compare_active);
-		j := 0;
-		{ draw horizontal segments for scanline y }
-		while (j < activepoints) do begin
-			{xl := ceil(activetable^[j].x-0.5);}
-			xl := trunc(activetable^[j].x-0.5);
-			if frac(activetable^[j].x-0.5)>0 then inc(xl);
-
-			xr := trunc(activetable^[j+1].x-0.5);
-			if frac(activetable^[j+1].x-0.5)<0 then dec(xr);
-
-			if (xl <= xr) then
+                        i := indextable^[k];
+                        { insert or delete edges before and after points[i] ((i-1) to i and
+                          i to (i+1)) from active edge table if they cross scanline y }
+                        { point previous to i }
+                        if (i > 0) then j := i-1 else j := numpoints-1;
+                        { old edge, remove from list }
+                        if (pointarray(polypoints)[j].y <= (y-0.5)) then cdelete(j)
+                        { new edge, add to active edges }
+                        else if (pointarray(polypoints)[j].y > (y + 0.5)) then cinsert(j, y);
+
+                        { point next after i }
+                        if (i < (numpoints-1)) then j := i+1 else j := 0;
+                        { old edge, remove from active edge table }
+                        if (pointarray(polypoints)[j].y <= (y - 0.5)) then cdelete(i)
+                        { new edge, add to active edges }
+                        else if (pointarray(polypoints)[j].y > (y + 0.5)) then cinsert(i, y);
+                        inc(k);
+                end;
+                { sort active edges list by active[j].x }
+                bsort(activetable, activepoints, sizeof(edge), compare_active);
+                j := 0;
+                { draw horizontal segments for scanline y }
+                while (j < activepoints) do begin
+                        {xl := ceil(activetable^[j].x-0.5);}
+                        xl := trunc(activetable^[j].x-0.5);
+                        if frac(activetable^[j].x-0.5)>0 then inc(xl);
+
+                        xr := trunc(activetable^[j+1].x-0.5);
+                        if frac(activetable^[j+1].x-0.5)<0 then dec(xr);
+
+                        if (xl <= xr) then
                 PatternLine(xl,xr,y);
-{				line(xl, y, xr+1, y);}
-			{ increment both edges' coordinates }
-			with activetable^[j] do begin
-				x := x + dx;
-			end;
-			with activetable^[j+1] do begin
-				x := x + dx;
-			end;
-			inc(j, 2);
-		end;
-	end;
+{                               line(xl, y, xr+1, y);}
+                        { increment both edges' coordinates }
+                        with activetable^[j] do begin
+                                x := x + dx;
+                        end;
+                        with activetable^[j+1] do begin
+                                x := x + dx;
+                        end;
+                        inc(j, 2);
+                end;
+        end;
+{$ifdef debug}
 {$R+}
-	freemem(activetable, sizeof(edge) * numpoints);
-	freemem(indextable, sizeof(graph_int) * numpoints);
+{$endif debug}
+        freemem(activetable, sizeof(edge) * numpoints);
+        freemem(indextable, sizeof(graph_int) * numpoints);
     { restore the old color }
     CurrentColor := OldColor;
     { now let's draw the outline of this polygon }
@@ -488,7 +492,19 @@ var
     CurrentColor := BackUpColor;
   End;
 
-
-
-
-
+{
+$Log$
+Revision 1.3  1999-07-12 13:27:11  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
+
+}

rtl/inc/graph/fontdata.inc

@@ -1,3 +1,7 @@
+{
+$Id$
+}
+
 {******************************************}
 {  Bitmapped font data - unrolled for      }
 {  faster access. Each character is an     }
@@ -2315,3 +2319,20 @@ CONST
 (0,0,0,0,0,0,0,0),
 (0,0,0,0,0,0,0,0),
 (0,0,0,0,0,0,0,0)));
+
+{
+$Log$
+Revision 1.2  1999-07-12 13:27:12  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
+
+}

rtl/inc/graph/modes.inc

@@ -1,4 +1,6 @@
 {
+    $Id$
+
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,99 by the Free Pascal development team
 
@@ -313,5 +315,19 @@
        RestoreVideoState;
      end;
 
-
-
+{
+$Log$
+Revision 1.7  1999-07-12 13:27:14  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
+
+}

rtl/inc/graph/palette.inc

@@ -1,4 +1,6 @@
 {
+    $Id$
+
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,99 by the Free Pascal development team
 
@@ -378,5 +380,19 @@ CONST
         if PaletteSize > 256 then Palette.Size := 256;
       end;
 
+{
+$Log$
+Revision 1.4  1999-07-12 13:27:15  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
 
-
+}

rtl/inc/graph/text.inc

@@ -29,12 +29,12 @@
       { Prefix header of Font file }
       PFHeader = ^TFHeader;
       TFHeader = packed record
-         header_size: word;    {* Version 2.0 Header Format	   *}
+         header_size: word;    {* Version 2.0 Header Format        *}
          font_name: array[1..4] of char;
-         font_size: word;      {* Size in byte of file 	      *}
-         font_major: byte;     {* Driver Version Information	*}
+         font_size: word;      {* Size in byte of file        *}
+         font_major: byte;     {* Driver Version Information    *}
          font_minor: byte;
-         min_major: byte;      {* BGI Revision Information	   *}
+         min_major: byte;      {* BGI Revision Information         *}
          min_minor: byte;
       end;
 
@@ -49,7 +49,7 @@
         cdefs :     integer;  { offset to character definitions       }
         scan_flag:  byte;     { TRUE if char is scanable              }
         org_to_cap: byte;     { Height from origin to top of capitol  }
-        org_to_base:byte;     { Height from origin to baseline	      }
+        org_to_base:byte;     { Height from origin to baseline        }
         org_to_dec: byte;     { Height from origin to bot of decender }
         _reserved: array[1..4] of char;
         Unused: byte;
@@ -85,7 +85,7 @@
 
     var
        fonts : array[1..maxfonts] of tfontrec;
-       Strokes: TStrokes; {* Stroke Data Base		*}
+       Strokes: TStrokes; {* Stroke Data Base           *}
        Stroke_count: Array[0..MaxChars] of integer; {* Stroke Count Table *}
 
 {***************************************************************************}
@@ -143,7 +143,9 @@
        if (b2 and $40)<>0 then b2:=b2 or $80;
        x:=integer(b1);
        y:=integer(b2);
+{$ifdef debug}
 {$R+}
+{$endif debug}
      end;
 
 
@@ -163,25 +165,25 @@
        lindex :=0;
 
 
-       while TRUE do	{* For each byte in buffer	*}
+       while TRUE do    {* For each byte in buffer      *}
          Begin
-           Inc(num_ops);  {* Count the operation		*}
+           Inc(num_ops);  {* Count the operation                *}
            opcode := decode( buf[counter], buf[counter+1] ,jx, jy );
            Inc(counter,2);
-           if( opcode = ord(_END_OF_CHAR) ) then break;	{* Exit loop at end of char	*}
+           if( opcode = ord(_END_OF_CHAR) ) then break; {* Exit loop at end of char     *}
          end;
 
        counter:=index;
 
-       for i:=0 to num_ops-1 do    { 	/* For each opcode in buffer	*/ }
+       for i:=0 to num_ops-1 do    {    /* For each opcode in buffer    */ }
          Begin
-           opc := decode(buf[counter], buf[counter+1], po[lindex].x, po[lindex].y);  {* Decode the data field	*}
+           opc := decode(buf[counter], buf[counter+1], po[lindex].x, po[lindex].y);  {* Decode the data field   *}
            inc(counter,2);
-           po[lindex].opcode := opc;      {* Save the opcode		*}
+           po[lindex].opcode := opc;      {* Save the opcode            *}
            Inc(lindex);
          end;
        Stroke:=po;
-       unpack := num_ops;       {* return OPS count		*}
+       unpack := num_ops;       {* return OPS count             *}
      end;
 
 
@@ -584,7 +586,7 @@
 
       var
          f : file;
-         Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder		*}
+         Prefix: array[0..Prefix_Size-1] of char; {* File Prefix Holder         *}
          Length, Current: longint;
          FontData: Pchar;
          Base: longint;
@@ -626,7 +628,7 @@
                    Currenttextinfo.font:=DefaultFont;
                    exit;
                 end;
-              {* Read in the file prefix	*}
+              {* Read in the file prefix        *}
               BlockRead(F, Prefix, Prefix_Size);
               hp:=Prefix;
               i:=0;
@@ -638,23 +640,23 @@
 
               BlockRead(F,Fonts[font].Offsets[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(integer));
 
-              {*	Load the character width table into memory.			*}
+              {*        Load the character width table into memory.                     *}
 
               base := filePos( f );
               BlockRead(F,Fonts[font].Widths[Fonts[font].Header.First_Char],Fonts[font].Header.Nr_chars*sizeof(byte));
 
-              {*	Determine the length of the stroke database.			*}
+              {*        Determine the length of the stroke database.                    *}
 
-              current := FilePos( f );		{* Current file location	*}
-              Seek( f, FileSize(F));		{* Go to the end of the file	*}
-              length := FilePos( f );		{* Get the file length		*}
-              Seek( f, current);	{* Restore old file location	*}
+              current := FilePos( f );          {* Current file location        *}
+              Seek( f, FileSize(F));            {* Go to the end of the file    *}
+              length := FilePos( f );           {* Get the file length          *}
+              Seek( f, current);        {* Restore old file location    *}
 
-              {*	Load the stroke database.					*}
+              {*        Load the stroke database.                                       *}
               { also allocate space for Null character   }
-              Getmem(FontData, Length+1);          {* Create space for font data	*}
+              Getmem(FontData, Length+1);          {* Create space for font data        *}
 
-              BlockRead(F, FontData^, length-current);        {* Load the stroke data	*}
+              BlockRead(F, FontData^, length-current);        {* Load the stroke data   *}
               FontData[length-current+1] := #0;
 
              if fonts[font].header.Signature<> SIGNATURE then
@@ -683,4 +685,19 @@
          CurrentYRatio := MultY / DivY;
       end;
 
-
+{
+$Log$
+Revision 1.4  1999-07-12 13:27:16  jonas
+  + added Log and Id tags
+  * added first FPC support, only VGA works to some extend for now
+  * use -dasmgraph to use assembler routines, otherwise Pascal
+    equivalents are used
+  * use -dsupportVESA to support VESA (crashes under FPC for now)
+  * only dispose vesainfo at closegrph if a vesa card was detected
+  * changed int32 to longint (int32 is not declared under FPC)
+  * changed the declaration of almost every procedure in graph.inc to
+    "far;" becquse otherwise you can't assign them to procvars under TP
+    real mode (but unexplainable "data segnment too large" errors prevent
+    it from working under real mode anyway)
+
+}

rtl/inc/graph/vesa.inc

@@ -1,4 +1,5 @@
 {
+    $Id$
     This file is part of the Free Pascal run time library.
     Copyright (c) 1993,99 by Carl Eric Codere
 
@@ -111,8 +112,9 @@ var
   CurrentWriteBank: integer; { active write bank         }
 
   BankShift : word;       { address to shift by when switching banks. }
-  funct      : procedure;
 
+  hasVesa: Boolean;       { true if we have a VESA compatible graphics card}
+                          { initialized in QueryAdapterInfo in graph.inc }
 
 function hexstr(val : longint;cnt : byte) : string;
 const
@@ -145,11 +147,16 @@ end;
     RealSeg : word;
    begin
     { Allocate real mode buffer }
+{$ifndef fpc}
     Ptrlong:=GlobalDosAlloc(sizeof(TVESAInfo));
     { Get selector value }
-    VESAPtr := pointer(longint(Ptrlong and $0000ffff) shl 16);
+    VESAPtr := pointer(Ptrlong shl 16);
+{$else fpc}
+    Ptrlong:=Global_Dos_Alloc(sizeof(TVESAInfo));
+    Getmem(VESAPtr,SizeOf(TVESAInfo));
+{$endif fpc}
     { Get segment value }
-    RealSeg := word((Ptrlong and $ffff0000) shr 16);
+    RealSeg := word(Ptrlong shr 16);
     if not assigned(VESAPtr) then
       RunError(203);
     FillChar(regs, sizeof(TDPMIRegisters), #0);
@@ -159,14 +166,27 @@ end;
     regs.es := RealSeg;
     regs.edi := $00;
     RealIntr($10, regs);
+{$ifdef fpc}
+   { no far pointer support in FPC yet, so move the vesa info into a memory }
+   { block in the DS slector space (JM)                                     }
+    dosmemget(RealSeg,0,VesaPtr^,SizeOf(TVESAInfo));
+{$endif fpc}
     if VESAPtr^.Signature <> 'VESA' then
      begin
          getVesaInfo := FALSE;
-         GlobalDosFree(word(longint(VESAPtr) shr 16));
+{$ifndef fpc}
+         GlobalDosFree(word(PtrLong and $ffff));
+{$else fpc}
+         Global_Dos_Free(word(PtrLong and $ffff));
+         { also free the extra allocated buffer }
+         Freemem(VESAPtr,SizeOf(TVESAInfo));
+{$endif fpc}
          exit;
      end
     else
       getVesaInfo := TRUE;
+
+{$ifndef fpc}
     { The mode pointer buffer points to a real mode memory }
     { Therefore steps to get the modes:                    }
     {  1. Allocate Selector and SetLimit to max number of  }
@@ -176,19 +196,39 @@ end;
 
     {  2. Set Selector linear address to the real mode pointer }
     {     returned.                                            }
-    offs := longint((longint(VESAPtr^.ModeList) and $ffff0000) shr 16) shl 4;
-    offs:=  offs OR word(VESAPtr^.ModeList);
+    offs := longint(longint(VESAPtr^.ModeList) shr 16) shl 4;
+   {shouldn't the OR in the next line be a + ?? (JM)}
+    offs :=  offs OR (Longint(VESAPtr^.ModeList) and $ffff);
     SetSelectorBase(ModeSel, offs);
 
-
-    { copy VESA mode information to a protected mode buffer and }
-    { then free the real mode buffer...                         }
-    Move(VESAPtr^, VESAInfo, sizeof(TVESAInfo));
-    GlobalDosFree(word(longint(VESAPtr) shr 16));
+     { copy VESA mode information to a protected mode buffer and }
+     { then free the real mode buffer...                         }
+     Move(VESAPtr^, VESAInfo, sizeof(TVESAInfo));
+     GlobalDosFree(word(PtrLong and $ffff));
 
     { ModeList points to the mode list     }
     { We must copy it somewhere...         }
     ModeList := Ptr(ModeSel, 0);
+
+{$else fpc}
+    { No far pointer support, so the Ptr(ModeSel, 0) doesn't work.     }
+    { Immediately copy everything to a buffer in the DS selector space }
+     New(ModeList);
+    { The following may copy data from outside the VESA buffer, but it   }
+    { shouldn't get past the 1MB limit, since that would mean the buffer }
+    { has been allocated in the BIOS or high memory region, which seems  }
+    { impossible to me (JM)}
+     DosMemGet(word(longint(VESAPtr^.ModeList) shr 16),
+        word(longint(VESAPtr^.ModeList) and $ffff), ModeList^,256*sizeof(word));
+
+     { copy VESA mode information to a protected mode buffer and }
+     { then free the real mode buffer...                         }
+     Move(VESAPtr^, VESAInfo, sizeof(TVESAInfo));
+     Global_Dos_Free(word(PtrLong and $ffff));
+     Freemem(VESAPtr,SizeOf(TVESAInfo));
+
+{$endif fpc}
+
     i:=0;
     new(VESAInfo.ModeList);
     while ModeList^[i]<> $ffff do
@@ -198,23 +238,34 @@ end;
      end;
     VESAInfo.ModeList^[i]:=$ffff;
     { Free the temporary selector used to get mode information }
+{$ifndef fpc}
     FreeSelector(ModeSel);
+{$else fpc}
+    Dispose(ModeList);
+{$endif fpc}
    end;
 
   function getModeInfo(var ModeInfo: TVESAModeInfo;mode:word):boolean;
    var
     Ptr: longint;
+{$ifndef fpc}
     VESAPtr : ^TModeInfo;
+{$endif fpc}
     regs : TDPMIRegisters;
     RealSeg: word;
    begin
     { Alllocate real mode buffer }
+{$ifndef fpc}
     Ptr:=GlobalDosAlloc(sizeof(TModeInfo));
-    { get the selector and segment values }
-    VESAPtr := pointer(longint(Ptr and $0000ffff) shl 16);
-    RealSeg := word((Ptr and $ffff0000) shr 16);
+    { get the selector value }
+    VESAPtr := pointer(longint(Ptr shl 16));
     if not assigned(VESAPtr) then
       RunError(203);
+{$else fpc}
+    Ptr:=Global_Dos_Alloc(sizeof(TModeInfo));
+{$endif fpc}
+    { get the segment value }
+    RealSeg := word(Ptr shr 16);
     { setup interrupt registers }
     FillChar(regs, sizeof(TDPMIRegisters), #0);
     { call VESA mode information...}
@@ -228,9 +279,17 @@ end;
     else
       getModeInfo := TRUE;
     { copy to protected mode buffer ... }
+{$ifndef fpc}
     Move(VESAPtr^, ModeInfo, sizeof(TModeInfo));
+{$else fpc}
+    DosMemGet(RealSeg,0,ModeInfo,sizeof(TModeInfo));
+{$endif fpc}
     { free real mode memory  }
-    GlobalDosFree(word(longint(VESAPtr) shr 16));
+{$ifndef fpc}
+    GlobalDosFree(Word(Ptr and $ffff));
+{$else fpc}
+    Global_Dos_Free(Word(Ptr and $ffff));
+{$endif fpc}
    end;
 
 {$ELSE}
@@ -312,7 +371,13 @@ end;
      mov  bh,00h
      mov  bl,[Win]
      mov  dx,[BankNr]
+{$ifdef fpc}
+     push ebp
+{$endif fpc}
      int  10h
+{$ifdef fpc}
+     pop ebp
+{$endif fpc}
    end;
 
   {********************************************************}
@@ -352,10 +417,10 @@ end;
    end;
 
  {************************************************************************}
- {*                     8-bit pixels VESA mode routines                  *)
+ {*                     8-bit pixels VESA mode routines                  *}
  {************************************************************************}
 
-  procedure PutPixVESA256(x, y : integer; color : word);
+  procedure PutPixVESA256(x, y : integer; color : word); far;
   var
      bank : word;
      offs : longint;
@@ -375,7 +440,7 @@ end;
      mem[WinWriteSeg : word(offs)] := byte(color);
   end;
 
-  procedure DirectPutPixVESA256(x, y : integer);
+  procedure DirectPutPixVESA256(x, y : integer); far;
   var
      bank : word;
      offs : longint;
@@ -385,7 +450,7 @@ end;
      mem[WinWriteSeg : word(offs)] := byte(CurrentColor);
   end;
 
-  function GetPixVESA256(x, y : integer): word;
+  function GetPixVESA256(x, y : integer): word; far;
   var
      bank : word;
      offs : longint;
@@ -398,10 +463,10 @@ end;
   end;
 
  {************************************************************************}
- {*                    15/16bit pixels VESA mode routines                *)
+ {*                    15/16bit pixels VESA mode routines                *}
  {************************************************************************}
 
-  procedure PutPixVESA32k(x, y : integer; color : word);
+  procedure PutPixVESA32k(x, y : integer; color : word); far;
   var
      bank : word;
      offs : longint;
@@ -421,7 +486,7 @@ end;
      memW[WinWriteSeg : word(offs)] := color;
   end;
 
-  procedure PutPixVESA64k(x, y : integer; color : word);
+  procedure PutPixVESA64k(x, y : integer; color : word); far;
   var
      bank : word;
      offs : longint;
@@ -441,7 +506,7 @@ end;
     memW[WinWriteSeg : word(offs)] := color;
   end;
 
-  function GetPixVESA32k(x, y : integer): word;
+  function GetPixVESA32k(x, y : integer): word; far;
   var
      bank : word;
      offs : longint;
@@ -453,7 +518,7 @@ end;
      GetPixVESA32k:=memW[WinWriteSeg : word(offs)];
   end;
 
-  function GetPixVESA64k(x, y : integer): word;
+  function GetPixVESA64k(x, y : integer): word; far;
   var
      bank : word;
      offs : longint;
@@ -465,7 +530,7 @@ end;
      GetPixVESA64k:=memW[WinWriteSeg : word(offs)];
   end;
 
-  procedure DirectPutPixVESA32k(x, y : integer);
+  procedure DirectPutPixVESA32k(x, y : integer); far;
   var
      bank : word;
      offs : longint;
@@ -475,7 +540,7 @@ end;
      memW[WinWriteSeg : word(offs)] := CurrentColor;
   end;
 
-  procedure DirectPutPixVESA64k(x, y : integer);
+  procedure DirectPutPixVESA64k(x, y : integer); far;
   var
      bank : word;
      offs : longint;
@@ -486,10 +551,10 @@ end;
   end;
 
  {************************************************************************}
- {*                     4-bit pixels VESA mode routines                  *)
+ {*                     4-bit pixels VESA mode routines                  *}
  {************************************************************************}
 
-  procedure PutPixVESA16(x, y : integer; color : word);
+  procedure PutPixVESA16(x, y : integer; color : word); far;
     var
      bank : word;
      offs : longint;
@@ -522,7 +587,7 @@ end;
      { }
   end;
 
-  procedure DirectPutPixVESA16(x, y : integer);
+  procedure DirectPutPixVESA16(x, y : integer); far;
     var
      bank : word;
      offs : longint;
@@ -547,7 +612,7 @@ end;
 
 
  {************************************************************************}
- {*                     VESA Palette entries                             *)
+ {*                     VESA Palette entries                             *}
  {************************************************************************}
 
 
@@ -560,7 +625,9 @@ end;
      Error : boolean;     { VBE call error                             }
      regs: TDPMIRegisters;
      Ptr: longint;
+{$ifndef fpc}
      PalPtr : ^PalRec;
+{$endif fpc}
      RealSeg: word;
     begin
       if DirectColor then
@@ -584,17 +651,25 @@ end;
               FunctionNr := $00;
 
             { Alllocate real mode buffer }
+{$ifndef fpc}
             Ptr:=GlobalDosAlloc(sizeof(palrec));
-            { get the selector and segment values }
-            PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
-            RealSeg := word((Ptr and $ffff0000) shr 16);
+            { get the selector values }
+            PalPtr := pointer(Ptr shl 16);
             if not assigned(PalPtr) then
                RunError(203);
+{$else fpc}
+            Ptr:=Global_Dos_Alloc(sizeof(palrec));
+{$endif fpc}
+            {get the segment value}
+            RealSeg := word(Ptr shr 16);
             { setup interrupt registers }
             FillChar(regs, sizeof(TDPMIRegisters), #0);
             { copy palette values to real mode buffer }
+{$ifndef fpc}
             move(pal, palptr^, sizeof(palrec));
-
+{$else fpc}
+            DosMemPut(RealSeg,0,pal,sizeof(palrec));
+{$endif fpc}
             regs.eax := $4F09;
             regs.ebx := FunctionNr;
             regs.ecx := $01;
@@ -604,7 +679,11 @@ end;
             RealIntr($10, regs);
 
             { free real mode memory  }
-            GlobalDosFree(word(longint(PalPtr) shr 16));
+{$ifndef fpc}
+            GlobalDosFree(word(Ptr and $ffff));
+{$else fpc}
+            Global_Dos_Free(word(Ptr and $ffff));
+{$endif fpc}
 
             if word(regs.eax) <> $004F then
               begin
@@ -639,16 +718,20 @@ end;
         if VESAInfo.Version >= $0200 then
           Begin
             { Alllocate real mode buffer }
+{$ifndef fpc}
             Ptr:=GlobalDosAlloc(sizeof(palrec));
-            { get the selector and segment values }
+            { get the selector value }
             PalPtr := pointer(longint(Ptr and $0000ffff) shl 16);
-            RealSeg := word((Ptr and $ffff0000) shr 16);
             if not assigned(PalPtr) then
                RunError(203);
+{$else fpc}
+            Ptr:=Global_Dos_Alloc(sizeof(palrec));
+{$endif fpc}
+            { get the segment value }
+            RealSeg := word(Ptr shr 16);
             { setup interrupt registers }
             FillChar(regs, sizeof(TDPMIRegisters), #0);
 
-
             regs.eax := $4F09;
             regs.ebx := $01;       { get palette data      }
             regs.ecx := $01;
@@ -658,9 +741,17 @@ end;
             RealIntr($10, regs);
 
            { copy to protected mode buffer ... }
+{$ifndef fpc}
            Move(PalPtr^, Pal, sizeof(palrec));
+{$else fpc}
+           DosMemGet(RealSeg,0,Pal,sizeof(palrec));
+{$endif fpc}
            { free real mode memory  }
-           GlobalDosFree(word(longint(PalPtr) shr 16));
+{$ifndef fpc}
+           GlobalDosFree(word(Ptr and $ffff));
+{$else fpc}
+           Global_Dos_Free(word(Ptr and $ffff));
+{$endif fpc}
 
             if word(regs.eax) <> $004F then
               begin
@@ -680,7 +771,7 @@ end;
 {$ELSE}
 
    Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
-      BlueValue : Integer);
+      BlueValue : Integer); far;
     var
      FunctionNr : byte;   { use blankbit or normal RAMDAC programming? }
      pal: ^palrec;
@@ -738,7 +829,7 @@ end;
 
 
   Procedure GetVESARGBPalette(ColorNum: integer; Var
-      RedValue, GreenValue, BlueValue : integer);
+      RedValue, GreenValue, BlueValue : integer); far;
    var
     Error: boolean;
     pal: ^palrec;
@@ -963,7 +1054,13 @@ end;
    asm
     mov ax,4F02h
     mov bx,mode
+{$ifdef fpc}
+    push ebp
+{$endif fpc}
     int 10h
+{$ifdef fpc}
+    pop ebp
+{$endif fpc}
     sub ax,004Fh
     cmp ax,1
     sbb al,al
@@ -976,7 +1073,13 @@ end;
  function getVESAMode:word;assembler;
    asm  {return -1 if error}
     mov ax,4F03h
+{$ifdef fpc}
+    push ebp
+{$endif fpc}
     int 10h
+{$ifdef fpc}
+    pop ebp
+{$endif fpc}
     cmp ax,004Fh
     je @@OK
     mov ax,-1
@@ -990,92 +1093,92 @@ end;
 
 
  {************************************************************************}
- {*                     VESA Modes inits                                 *)
+ {*                     VESA Modes inits                                 *}
  {************************************************************************}
 
- procedure Init1280x1024x64k;
+ procedure Init1280x1024x64k; far;
   begin
     SetVesaMode(m1280x1024x64k);
   end;
 
- procedure Init1280x1024x32k;
+ procedure Init1280x1024x32k; far;
   begin
     SetVESAMode(m1280x1024x32k);
   end;
 
- procedure Init1280x1024x256;
+ procedure Init1280x1024x256; far;
   begin
     SetVESAMode(m1280x1024x256);
   end;
 
 
- procedure Init1280x1024x16;
+ procedure Init1280x1024x16; far;
   begin
     SetVESAMode(m1280x1024x16);
   end;
 
- procedure Init1024x768x64k;
+ procedure Init1024x768x64k; far;
   begin
     SetVESAMode(m1024x768x64k);
   end;
 
- procedure Init640x480x32k;
+ procedure Init640x480x32k; far;
   begin
     SetVESAMode(m640x480x32k);
   end;
 
- procedure Init1024x768x256;
+ procedure Init1024x768x256; far;
   begin
     SetVESAMode(m1024x768x256);
   end;
 
- procedure Init1024x768x16;
+ procedure Init1024x768x16; far;
   begin
     SetVESAMode(m1024x768x16);
   end;
 
- procedure Init800x600x64k;
+ procedure Init800x600x64k; far;
   begin
     SetVESAMode(m800x600x64k);
   end;
 
- procedure Init800x600x32k;
+ procedure Init800x600x32k; far;
   begin
     SetVESAMode(m800x600x32k);
   end;
 
- procedure Init800x600x256;
+ procedure Init800x600x256; far;
   begin
     SetVESAMode(m800x600x256);
   end;
 
- procedure Init800x600x16;
+ procedure Init800x600x16; far;
   begin
     SetVesaMode(m800x600x16);
   end;
 
- procedure Init640x480x64k;
+ procedure Init640x480x64k; far;
   begin
     SetVESAMode(m640x480x64k);
   end;
 
 
- procedure Init640x480x256;
+ procedure Init640x480x256; far;
   begin
     SetVESAMode(m640x480x256);
   end;
 
- procedure Init640x400x256;
+ procedure Init640x400x256; far;
   begin
     SetVESAMode(m640x400x256);
   end;
 
- procedure Init320x200x64k;
+ procedure Init320x200x64k; far;
   begin
     SetVESAMode(m320x200x64k);
   end;
 
- procedure Init320x200x32k;
+ procedure Init320x200x32k; far;
   begin
     SetVESAMode(m320x200x32k);
   end;
@@ -1093,7 +1196,13 @@ end;
     { Get the video mode }
     asm
       mov  ah,0fh
+{$ifdef fpc}
+      push ebp
+{$endif fpc}
       int  10h
+{$ifdef fpc}
+      pop ebp
+{$endif fpc}
       mov  [VideoMode], al
     end;
     { Prepare to save video state...}
@@ -1101,7 +1210,13 @@ end;
       mov  ax, 4F04h       { get buffer size to save state }
       mov  dx, 00h
       mov  cx, 00001111b   { Save DAC / Data areas / Hardware states }
+{$ifdef fpc}
+      push ebp
+{$endif fpc}
       int  10h
+{$ifdef fpc}
+      pop ebp
+{$endif fpc}
       mov  [StateSize], bx
       cmp  al,04fh
       jnz  @notok
@@ -1110,13 +1225,23 @@ end;
     end;
     if SaveSupported then
       begin
+{$ifndef fpc}
         PtrLong:=GlobalDosAlloc(64*StateSize);  { values returned in 64-byte blocks }
+{$else fpc}
+        PtrLong:=Global_Dos_Alloc(64*StateSize);  { values returned in 64-byte blocks }
+{$endif fpc}
         if PtrLong = 0 then
            RunError(203);
         SavePtr := pointer(longint(PtrLong and $0000ffff) shl 16);
-        RealStateSeg := word((PtrLong and $ffff0000) shr 16);
+{$ifndef fpc}
+        { In FPC mode, we can't do anything with this (no far pointers)  }
+        { However, we still need to keep it to be able to free the       }
+        { memory afterwards. Since this data is not accessed in PM code, }
+        { there's no need to save it in a seperate buffer (JM)           }
         if not assigned(SavePtr) then
            RunError(203);
+{$endif fpc}
+        RealStateSeg := word(PtrLong shr 16);
 
         FillChar(regs, sizeof(regs), #0);
         { call the real mode interrupt ... }
@@ -1146,10 +1271,22 @@ end;
      asm
       mov  ah,00
       mov  al,[VideoMode]
+{$ifdef fpc}
+      push ebp
+{$endif fpc}
       int  10h
+{$ifdef fpc}
+      pop ebp
+{$endif fpc}
      end;
      { then restore all state information }
+{$ifndef fpc}
      if assigned(SavePtr) and (SaveSupported=TRUE) then
+{$else fpc}
+     { No far pointer support, so it's possible that that assigned(SavePtr) }
+     { would return false under FPC. Just check if it's different from nil. }
+     if (SavePtr <> nil) and (SaveSupported=TRUE) then
+{$endif fpc}
        begin
         FillChar(regs, sizeof(regs), #0);
         { restore state, according to Ralph Brown Interrupt list }
@@ -1160,9 +1297,12 @@ end;
          regs.es := RealStateSeg;
          regs.ebx := 0;
          RealIntr($10,regs);
+{$ifndef fpc}
          if GlobalDosFree(longint(SavePtr) shr 16)<>0 then
+{$else fpc}
+         if Not(Global_Dos_Free(longint(SavePtr) shr 16)) then
+{$endif fpc}
           RunError(216);
-
          SavePtr := nil;
        end;
   end;
@@ -1173,7 +1313,7 @@ end;
       {*                     Real mode routines                     *}
       {**************************************************************}
 
- Procedure SaveStateVESA;
+ Procedure SaveStateVESA; far;
   begin
     SavePtr := nil;
     SaveSupported := FALSE;
@@ -1220,7 +1360,7 @@ end;
       end;
   end;
 
- procedure RestoreStateVESA;
+ procedure RestoreStateVESA; far;
   begin
      { go back to the old video mode...}
      asm
@@ -1248,18 +1388,18 @@ end;
 {$ENDIF DPMI}
 
  {************************************************************************}
- {*                     VESA Page flipping routines                      *)
+ {*                     VESA Page flipping routines                      *}
  {************************************************************************}
  { Note: These routines, according  to the VBE3 specification, will NOT   }
  { work with the 24 bpp modes, because of the alignment.                  }
  {************************************************************************}
- procedure SetVisualVESA(page: word);
+ procedure SetVisualVESA(page: word); far;
   { two page support... }
   begin
     if page > HardwarePages then exit;
   end;
 
- procedure SetActiveVESA(page: word);
+ procedure SetActiveVESA(page: word); far;
   { two page support... }
   begin
   end;