paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-29 22:54:42 +01:00
Code Issues Packages Projects Releases Wiki Activity

* another SetFileSize correction

Browse Source
This commit is contained in:
Tomas Hajny 2000-06-05 18:55:54 +00:00
parent 85c76dc528
commit aa7e3215ee
1 changed files with 11 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
rtl/os2/objinc.inc
View File

@ -124,49 +124,20 @@ BEGIN
end; end;
function SetFileSize (Handle: THandle; FileSize: LongInt): Word; function SetFileSize (Handle: THandle; FileSize: longint): word; assembler;
var Actual, Buf: LongInt; asm
begin movl $0x7F18, %eax
SetFileSize := 0; movl Handle, %ebx
if FileSize > Position then movl FileSize,%edx
begin call syscall
SetFilePos (Handle, FileSize, 0, Actual); end;
if (Actual = FileSize) then
begin
{ Extend the file }
Actual := FileWrite (Handle, Buf, 0, Actual);
if Actual = -1 then
SetFileSize := 103;
end
else
SetFileSize := 103;
end
else
begin
asm
movl $0x7F25,%eax
movl Handle,%ebx
movl FileSize,%edx
call syscall
inc %eax
movl %ecx, %eax
jnz .LSetFSize1
movl $0x4202,%eax
movl Handle,%ebx
movl $0,%edx
call syscall
jnc .LSetFSize2
.LSetFSize1:
movw %ax,DosStreamError
.LSetFSize2:
end;
if DosStreamError <> 0 then SetFileSize := 103;
end;
END;
{ {
$Log$ $Log$
Revision 1.5 2000-06-04 14:17:28 hajny Revision 1.6 2000-06-05 18:55:54 hajny
* another SetFileSize correction
Revision 1.5 2000/06/04 14:17:28 hajny
* SetFileSize fixed * SetFileSize fixed
Revision 1.4 2000/02/09 16:59:33 peter Revision 1.4 2000/02/09 16:59:33 peter