paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-10 07:26:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* split the routines with asm versions into strict pascal and strict asm versions

Browse Source 
git-svn-id: trunk@41153 -
This commit is contained in:
nickysn 2019-01-31 15:19:45 +00:00
parent 74b897b875
commit c5331d425a
1 changed files with 75 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
packages/graph/src/go32v2/graph.pp
View File

@ -1676,11 +1676,10 @@ end;
Procedure PutPixel16(X,Y : smallint; Pixel: Word);
{$ifndef asmgraph} {$ifndef asmgraph}
Procedure PutPixel16(X,Y : smallint; Pixel: Word);
var offset: word; var offset: word;
dummy: byte; dummy: byte;
{$endif asmgraph}
Begin Begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
@ -1692,7 +1691,6 @@ end;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
exit; exit;
end; end;
{$ifndef asmgraph}
offset := y * 80 + (x shr 3) + VideoOfs; offset := y * 80 + (x shr 3) + VideoOfs;
PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes } PortW[$3ce] := $0f01; { Index 01 : Enable ops on all 4 planes }
PortW[$3ce] := (Pixel and $ff) shl 8; { Index 00 : Enable correct plane and write color } PortW[$3ce] := (Pixel and $ff) shl 8; { Index 00 : Enable correct plane and write color }
@ -1702,7 +1700,20 @@ end;
Mem[Sega000: offset] := dummy; { Write the data into video memory } Mem[Sega000: offset] := dummy; { Write the data into video memory }
PortW[$3ce] := $ff08; { Enable all bit planes. } PortW[$3ce] := $ff08; { Enable all bit planes. }
PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. } PortW[$3ce] := $0001; { Index 01 : Disable ops on all four planes. }
end;
{$else asmgraph} {$else asmgraph}
Procedure PutPixel16(X,Y : smallint; Pixel: Word);
Begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then
Begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
exit;
end;
asm asm
push eax push eax
push ebx push ebx
@ -1757,19 +1768,17 @@ end;
pop ebx pop ebx
pop eax pop eax
end; end;
{$endif asmgraph}
end; end;
{$endif asmgraph}
Function GetPixel16(X,Y: smallint):word;
{$ifndef asmgraph} {$ifndef asmgraph}
Function GetPixel16(X,Y: smallint):word;
Var dummy, offset: Word; Var dummy, offset: Word;
shift: byte; shift: byte;
{$endif asmgraph}
Begin Begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
{$ifndef asmgraph}
offset := Y * 80 + (x shr 3) + VideoOfs; offset := Y * 80 + (x shr 3) + VideoOfs;
PortW[$3ce] := $0004; PortW[$3ce] := $0004;
shift := 7 - (X and 7); shift := 7 - (X and 7);
@ -1781,7 +1790,12 @@ end;
Port[$3cf] := 3; Port[$3cf] := 3;
dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 3); dummy := dummy or (((Mem[Sega000:offset] shr shift) and 1) shl 3);
GetPixel16 := dummy; GetPixel16 := dummy;
end;
{$else asmgraph} {$else asmgraph}
Function GetPixel16(X,Y: smallint):word;
Begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
asm asm
push eax push eax
push ebx push ebx
@ -1857,8 +1871,8 @@ end;
pop ebx pop ebx
pop eax pop eax
end; end;
{$endif asmgraph}
end; end;
{$endif asmgraph}
Procedure GetScanLine16(x1, x2, y: smallint; var data); Procedure GetScanLine16(x1, x2, y: smallint; var data);
@ -1987,14 +2001,13 @@ Begin
{$Endif logging} {$Endif logging}
End; End;
{$ifndef asmgraph}
Procedure DirectPutPixel16(X,Y : smallint); Procedure DirectPutPixel16(X,Y : smallint);
{ x,y -> must be in global coordinates. No clipping. } { x,y -> must be in global coordinates. No clipping. }
var var
color: word; color: word;
{$ifndef asmgraph}
offset: word; offset: word;
dummy: byte; dummy: byte;
{$endif asmgraph}
begin begin
If CurrentWriteMode <> NotPut Then If CurrentWriteMode <> NotPut Then
Color := CurrentColor Color := CurrentColor
@ -2013,7 +2026,6 @@ End;
else else
PortW[$3ce]:=$0003} PortW[$3ce]:=$0003}
end; end;
{$ifndef asmgraph}
offset := Y * 80 + (X shr 3) + VideoOfs; offset := Y * 80 + (X shr 3) + VideoOfs;
PortW[$3ce] := $f01; PortW[$3ce] := $f01;
PortW[$3ce] := Color shl 8; PortW[$3ce] := Color shl 8;
@ -2026,7 +2038,30 @@ End;
(CurrentWriteMode = ANDPut) or (CurrentWriteMode = ANDPut) or
(CurrentWriteMode = ORPut) then (CurrentWriteMode = ORPut) then
PortW[$3ce] := $0003; PortW[$3ce] := $0003;
end;
{$else asmgraph} {$else asmgraph}
Procedure DirectPutPixel16(X,Y : smallint);
{ x,y -> must be in global coordinates. No clipping. }
var
color: word;
begin
If CurrentWriteMode <> NotPut Then
Color := CurrentColor
else Color := not CurrentColor;
case CurrentWriteMode of
XORPut:
PortW[$3ce]:=((3 shl 3) shl 8) or 3;
ANDPut:
PortW[$3ce]:=((1 shl 3) shl 8) or 3;
ORPut:
PortW[$3ce]:=((2 shl 3) shl 8) or 3;
{not needed, this is the default state (e.g. PutPixel16 requires it)}
{NormalPut, NotPut:
PortW[$3ce]:=$0003
else
PortW[$3ce]:=$0003}
end;
{ note: still needs xor/or/and/notput support !!!!! (JM) } { note: still needs xor/or/and/notput support !!!!! (JM) }
asm asm
push eax push eax
@ -2082,8 +2117,8 @@ End;
pop ebx pop ebx
pop eax pop eax
end; end;
{$endif asmgraph}
end; end;
{$endif asmgraph}
procedure HLine16(x,x2,y: smallint); procedure HLine16(x,x2,y: smallint);
@ -2326,9 +2361,9 @@ End;
end; end;
{$ifndef asmgraph}
Procedure DirectPutPixel320(X,Y : smallint); Procedure DirectPutPixel320(X,Y : smallint);
{ x,y -> must be in global coordinates. No clipping. } { x,y -> must be in global coordinates. No clipping. }
{$ifndef asmgraph}
var offset: word; var offset: word;
dummy: Byte; dummy: Byte;
begin begin
@ -2343,8 +2378,9 @@ End;
Mem[SegA000:offset] := dummy; Mem[SegA000:offset] := dummy;
end; end;
{$else asmgraph} {$else asmgraph}
Procedure DirectPutPixel320(X,Y : smallint); assembler;
{ x,y -> must be in global coordinates. No clipping. }
{ note: still needs or/and/notput support !!!!! (JM) } { note: still needs or/and/notput support !!!!! (JM) }
assembler;
asm asm
push eax push eax
push ebx push ebx
@ -2463,18 +2499,21 @@ const
end; end;
Function GetPixelX(X,Y: smallint): word;
{$ifndef asmgraph} {$ifndef asmgraph}
Function GetPixelX(X,Y: smallint): word;
var offset: word; var offset: word;
{$endif asmgraph}
begin begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
{$ifndef asmgraph}
offset := y * 80 + x shr 2 + VideoOfs; offset := y * 80 + x shr 2 + VideoOfs;
PortW[$3ce] := ((x and 3) shl 8) + 4; PortW[$3ce] := ((x and 3) shl 8) + 4;
GetPixelX := Mem[SegA000:offset]; GetPixelX := Mem[SegA000:offset];
end;
{$else asmgraph} {$else asmgraph}
Function GetPixelX(X,Y: smallint): word;
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
asm asm
push eax push eax
push ebx push ebx
@ -2509,8 +2548,8 @@ const
pop ebx pop ebx
pop eax pop eax
end; end;
{$endif asmgraph}
end; end;
{$endif asmgraph}
procedure SetVisualX(page: word); procedure SetVisualX(page: word);
{ 4 page support... } { 4 page support... }
@ -2581,10 +2620,9 @@ const
VideoOfs := 0; VideoOfs := 0;
end; end;
Procedure PutPixelX(X,Y: smallint; color:word);
{$ifndef asmgraph} {$ifndef asmgraph}
Procedure PutPixelX(X,Y: smallint; color:word);
var offset: word; var offset: word;
{$endif asmgraph}
begin begin
X:= X + StartXViewPort; X:= X + StartXViewPort;
Y:= Y + StartYViewPort; Y:= Y + StartYViewPort;
@ -2596,11 +2634,23 @@ const
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
exit; exit;
end; end;
{$ifndef asmgraph}
offset := y * 80 + x shr 2 + VideoOfs; offset := y * 80 + x shr 2 + VideoOfs;
PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane)); PortW[$3c4] := (hi(word(FirstPlane)) shl 8) shl (x and 3)+ lo(word(FirstPlane));
Mem[SegA000:offset] := color; Mem[SegA000:offset] := color;
end;
{$else asmgraph} {$else asmgraph}
Procedure PutPixelX(X,Y: smallint; color:word);
begin
X:= X + StartXViewPort;
Y:= Y + StartYViewPort;
{ convert to absolute coordinates and then verify clipping...}
if ClipPixels then
Begin
if (X < StartXViewPort) or (X > (StartXViewPort + ViewWidth)) then
exit;
if (Y < StartYViewPort) or (Y > (StartYViewPort + ViewHeight)) then
exit;
end;
asm asm
push ax push ax
push bx push bx
@ -2643,13 +2693,13 @@ const
pop bx pop bx
pop ax pop ax
end; end;
{$endif asmgraph}
end; end;
{$endif asmgraph}
{$ifndef asmgraph}
Procedure DirectPutPixelX(X,Y: smallint); Procedure DirectPutPixelX(X,Y: smallint);
{ x,y -> must be in global coordinates. No clipping. } { x,y -> must be in global coordinates. No clipping. }
{$ifndef asmgraph}
Var offset: Word; Var offset: Word;
dummy: Byte; dummy: Byte;
begin begin
@ -2677,8 +2727,9 @@ const
Mem[Sega000: offset] := Dummy; Mem[Sega000: offset] := Dummy;
end; end;
{$else asmgraph} {$else asmgraph}
Procedure DirectPutPixelX(X,Y: smallint); Assembler;
{ x,y -> must be in global coordinates. No clipping. }
{ note: still needs or/and/notput support !!!!! (JM) } { note: still needs or/and/notput support !!!!! (JM) }
Assembler;
asm asm
push ax push ax
push bx push bx