paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 09:49:35 +02:00
Code Issues Packages Projects Releases Wiki Activity

* updates

Browse Source
This commit is contained in:
peter 2000-09-10 21:18:40 +00:00
parent 9587e696f4
commit 824186ff92
4 changed files with 131 additions and 120 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
tests/tbs/tbs0348.pp
View File

@ -5,7 +5,8 @@ type fluparr=array[0..1000] of longint;
var flup : Flupptr;
Flupresult : longint;
flupa : fluparr;
begin
flup:=@flupa;
flupresult:=flup[5];
end.

119
tests/webtbs/tbug1066a.pp Normal file
View File

@ -0,0 +1,119 @@
{ Source provided for Free Pascal Bug Report 1066 }
{ Submitted by "Fernando Oscar Schmitt" on 2000-07-24 }
{ e-mail: pulp@cpovo.net }
var
somevar:longint;
{$asmmode intel}
{$inline on}
procedure putpixel(x,y,color:longint);assembler;inline;
asm
mov edi,x
mov eax,y
cmp edi,0
jl @@putpixelend
cmp eax,0
jl @@putpixelend
cmp edi,1023
jg @@putpixelend
cmp eax,767
jg @@putpixelend
shl eax,12
mov ebx,color
add eax,somevar
mov [eax+edi*4],ebx
@@putpixelend:
end ['eax','ebx','edi'];
procedure pixelrow(y,x1,x2,color:longint);assembler;inline;
asm
mov edi,x1
mov ecx,x2
mov eax,y
cmp edi,ecx
jle @@pixelrowdirok
xchg edi,ecx
@@pixelrowdirok:
cmp eax,0
jl @@endpixelrow
cmp eax,767
jg @@endpixelrow
cmp ecx,0
jl @@endpixelrow
cmp edi,1023
jg @@endpixelrow
cmp edi,0
jge @@pixelrowx1ok
mov edi,0
@@pixelrowx1ok:
cmp ecx,1023
jle @@pixelrowx2ok
mov ecx,1023
@@pixelrowx2ok:
sub ecx,edi
shl eax,12
inc ecx
add eax,somevar
cld
lea edi,[eax+4*edi]
mov eax,color
rep stosd
@@endpixelrow:
end ['eax','ecx','edi'];
function str(w:word):string;
var tmp:string;
begin
system.str(w,tmp);
str:=tmp;
end;
function str(l:longint):string;
var tmp:string;
begin
system.str(l,tmp);
str:=tmp;
end;
procedure circle(x0,y0,r,color:longint);
var x,y:longint;
begin
for x:=0 to trunc(r*(sqrt(2)/2))+1 do
begin
y:=round(sqrt(r*r-x*x));
putpixel(x0+x,y0+y,color);
putpixel(x0-x,y0+y,color);
putpixel(x0+x,y0-y,color);
putpixel(x0-x,y0-y,color);
putpixel(x0+y,y0+x,color);
putpixel(x0-y,y0+x,color);
putpixel(x0+y,y0-x,color);
putpixel(x0-y,y0-x,color);
end;
end;
procedure circlefill(x0,y0,r,color:longint);
var x,y:longint;
begin
for x:=0 to trunc(r*(sqrt(2)/2))+1 do
begin
y:=round(sqrt(r*r-x*x));
pixelrow(y0+y,x0-x,x0+x,color);
pixelrow(y0-y,x0-x,x0+x,color);
pixelrow(y0+x,x0-y,x0+y,color);
pixelrow(y0-x,x0-y,x0+y,color);
end;
end;
begin
end.

119
tests/webtbs/tbug1066.pp → tests/webtbs/tbug1066b.pp
View File

@ -1,122 +1,7 @@
{ Source provided for Free Pascal Bug Report 1066 }
{ Submitted by "Fernando Oscar Schmitt" on 2000-07-24 }
{ e-mail: pulp@cpovo.net }
var
somevar:longint;
procedure putpixel(x,y,color:longint);assembler;inline;
asm
mov edi,x
mov eax,y
cmp edi,0
jl @@putpixelend
cmp eax,0
jl @@putpixelend
cmp edi,1023
jg @@putpixelend
cmp eax,767
jg @@putpixelend
shl eax,12
mov ebx,color
add eax,somevar
mov [eax+edi*4],ebx
@@putpixelend:
end ['eax','ebx','edi'];
procedure pixelrow(y,x1,x2,color:longint);assembler;inline;
asm
mov edi,x1
mov ecx,x2
mov eax,y
cmp edi,ecx
jle @@pixelrowdirok
xchg edi,ecx
@@pixelrowdirok:
cmp eax,0
jl @@endpixelrow
cmp eax,767
jg @@endpixelrow
cmp ecx,0
jl @@endpixelrow
cmp edi,1023
jg @@endpixelrow
cmp edi,0
jge @@pixelrowx1ok
mov edi,0
@@pixelrowx1ok:
cmp ecx,1023
jle @@pixelrowx2ok
mov ecx,1023
@@pixelrowx2ok:
sub ecx,edi
shl eax,12
inc ecx
add eax,somevar
cld
lea edi,[eax+4*edi]
mov eax,color
rep stosd
@@endpixelrow:
end ['eax','ecx','edi'];
function str(w:word):string;
var tmp:string;
begin
system.str(w,tmp);
str:=tmp;
end;
function str(l:longint):string;
var tmp:string;
begin
system.str(l,tmp);
str:=tmp;
end;
procedure circle(x0,y0,r,color:longint);
var x,y:longint;
begin
for x:=0 to trunc(r*(sqrt(2)/2))+1 do
begin
y:=round(sqrt(r*r-x*x));
putpixel(x0+x,y0+y,color);
putpixel(x0-x,y0+y,color);
putpixel(x0+x,y0-y,color);
putpixel(x0-x,y0-y,color);
putpixel(x0+y,y0+x,color);
putpixel(x0-y,y0+x,color);
putpixel(x0+y,y0-x,color);
putpixel(x0-y,y0-x,color);
end;
end;
procedure circlefill(x0,y0,r,color:longint);
var x,y:longint;
begin
for x:=0 to trunc(r*(sqrt(2)/2))+1 do
begin
y:=round(sqrt(r*r-x*x));
pixelrow(y0+y,x0-x,x0+x,color);
pixelrow(y0-y,x0-x,x0+x,color);
pixelrow(y0+x,x0-y,x0+y,color);
pixelrow(y0-x,x0-y,x0+y,color);
end;
end;
begin
end.
{----------------cut here----------------}
{$asmmode intel}
{$inline on}
var
somevar:longint;

8
tests/webtbs/tbug1092.pp
View File

@ -6,8 +6,14 @@ const
{$else}
path='c:\';
{$endif}
var
t : text;
BEGIN
if FSearch('tbug1092.pp',path)<>'tbug1092.pp' then
{ create a file }
assign(t,'tbug1092.txt');
rewrite(t);
close(t);
if FSearch('tbug1092.txt',path)<>'tbug1092.txt' then
begin
writeln('FSearch didn''t find file in the current dir!');
halt(1);