mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 10:45:08 +02:00
* updated behavior of some routines to conform to docs (completely taken from fixes branch)
This commit is contained in:
carl
parent
0c1893bc2a
commit
2c93d32ff3
228
rtl/os2/dos.pas
228
rtl/os2/dos.pas
@ -180,7 +180,7 @@ function getenv(const envvar:string): string;
|
||||
implementation
|
||||
|
||||
var LastSR: SearchRec;
|
||||
envc: longint; external name '_envc';
|
||||
EnvC: longint; external name '_envc';
|
||||
EnvP: ppchar; external name '_environ';
|
||||
|
||||
type TBA = array [1..SizeOf (SearchRec)] of byte;
|
||||
@ -316,7 +316,7 @@ procedure msdos(var regs:registers);
|
||||
|
||||
begin
|
||||
if os_mode in [osDPMI,osDOS] then
|
||||
intr($21,regs);
|
||||
intr($21,regs);
|
||||
end;
|
||||
|
||||
procedure intr(intno:byte;var regs:registers);
|
||||
@ -325,14 +325,14 @@ procedure intr(intno:byte;var regs:registers);
|
||||
|
||||
begin
|
||||
if os_mode = osos2 then exit;
|
||||
asm
|
||||
asm
|
||||
jmp .Lstart
|
||||
{ .data}
|
||||
.Lint86:
|
||||
.byte 0xcd
|
||||
.byte 0xcd
|
||||
.Lint86_vec:
|
||||
.byte 0x03
|
||||
jmp .Lint86_retjmp
|
||||
.byte 0x03
|
||||
jmp .Lint86_retjmp
|
||||
|
||||
{ .text}
|
||||
.Lstart:
|
||||
@ -383,7 +383,7 @@ asm
|
||||
popl %ebx {Flags.}
|
||||
movl %ebx,32(%eax)
|
||||
{FS and GS too}
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure exec(const path:pathstr;const comline:comstr);
|
||||
@ -642,22 +642,12 @@ end;
|
||||
procedure getcbreak(var breakvalue:boolean);
|
||||
|
||||
begin
|
||||
DosError := 0;
|
||||
{! Do not use in OS/2. Also not recommended in DOS. Use
|
||||
signal handling instead.
|
||||
asm
|
||||
movw $0x3300,%ax
|
||||
call syscall
|
||||
movl BreakValue,%eax
|
||||
movb %dl,(%eax)
|
||||
end;
|
||||
}
|
||||
breakvalue := True;
|
||||
end;
|
||||
|
||||
procedure setcbreak(breakvalue:boolean);
|
||||
|
||||
begin
|
||||
DosError := 0;
|
||||
{! Do not use in OS/2. Also not recommended in DOS. Use
|
||||
signal handling instead.
|
||||
asm
|
||||
@ -671,29 +661,30 @@ end;
|
||||
procedure getverify(var verify:boolean);
|
||||
|
||||
begin
|
||||
DosError := 0;
|
||||
{! Do not use in OS/2.}
|
||||
if os_mode in [osDOS,osDPMI] then
|
||||
asm
|
||||
movb $0x54,%ah
|
||||
call syscall
|
||||
movl verify,%edi
|
||||
stosb
|
||||
end;
|
||||
end;
|
||||
{! Do not use in OS/2.}
|
||||
if os_mode in [osDOS,osDPMI] then
|
||||
asm
|
||||
movb $0x54,%ah
|
||||
call syscall
|
||||
movl verify,%edi
|
||||
stosb
|
||||
end
|
||||
else
|
||||
verify := true;
|
||||
end;
|
||||
|
||||
procedure setverify(verify:boolean);
|
||||
|
||||
begin
|
||||
DosError := 0;
|
||||
{! Do not use in OS/2!}
|
||||
if os_mode in [osDOS,osDPMI] then
|
||||
asm
|
||||
movb verify,%al
|
||||
movb $0x2e,%ah
|
||||
call syscall
|
||||
end;
|
||||
end;
|
||||
{! Do not use in OS/2!}
|
||||
if os_mode in [osDOS,osDPMI] then
|
||||
asm
|
||||
movb verify,%al
|
||||
movb $0x2e,%ah
|
||||
call syscall
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function DiskFree (Drive: byte): int64;
|
||||
|
||||
@ -811,7 +802,7 @@ begin
|
||||
begin
|
||||
Name := FStat^.Name;
|
||||
Size := FStat^.FileSize;
|
||||
Attr := FStat^.AttrFile;
|
||||
Attr := byte(FStat^.AttrFile and $FF);
|
||||
TRec (Time).T := FStat^.TimeLastWrite;
|
||||
TRec (Time).D := FStat^.DateLastWrite;
|
||||
end else
|
||||
@ -861,8 +852,8 @@ begin
|
||||
New (F.FStat);
|
||||
F.Handle := $FFFFFFFF;
|
||||
Count := 1;
|
||||
DosError := DosFindFirst (Path, F.Handle, Attr, F.FStat,
|
||||
SizeOf (F.FStat^), Count, ilStandard);
|
||||
DosError := Integer(DosFindFirst (Path, F.Handle, Attr, F.FStat,
|
||||
SizeOf (F.FStat^), Count, ilStandard));
|
||||
if (DosError = 0) and (Count = 0) then DosError := 18;
|
||||
end else
|
||||
begin
|
||||
@ -897,7 +888,7 @@ begin
|
||||
if os_mode = osOS2 then
|
||||
begin
|
||||
Count := 1;
|
||||
DosError := DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^), Count);
|
||||
DosError := Integer(DosFindNext (F.Handle, F.FStat, SizeOf (F.FStat^), Count));
|
||||
if (DosError = 0) and (Count = 0) then DosError := 18;
|
||||
end else _findnext (F);
|
||||
DosSearchRec2SearchRec (F);
|
||||
@ -968,8 +959,12 @@ procedure fsplit(path:pathstr;var dir:dirstr;var name:namestr;
|
||||
var ext:extstr);
|
||||
|
||||
var p1,i : longint;
|
||||
dotpos : integer;
|
||||
|
||||
begin
|
||||
{ allow slash as backslash }
|
||||
for i:=1 to length(path) do
|
||||
if path[i]='/' then path[i]:='\';
|
||||
{Get drive name}
|
||||
p1:=pos(':',path);
|
||||
if p1>0 then
|
||||
@ -984,23 +979,26 @@ begin
|
||||
while true do
|
||||
begin
|
||||
p1:=pos('\',path);
|
||||
if p1=0 then
|
||||
p1:=pos('/',path);
|
||||
if p1=0 then
|
||||
break;
|
||||
dir:=dir+copy(path,1,p1);
|
||||
delete(path,1,p1);
|
||||
end;
|
||||
{Try to find an extension.}
|
||||
ext:='';
|
||||
for i:=length(path) downto 1 do
|
||||
if path[i]='.' then
|
||||
begin
|
||||
ext:=copy(path,i,high(extstr));
|
||||
delete(path,i,length(path)-i+1);
|
||||
break;
|
||||
end;
|
||||
name:=path;
|
||||
{ try to find out a extension }
|
||||
Ext:='';
|
||||
i:=Length(Path);
|
||||
DotPos:=256;
|
||||
While (i>0) Do
|
||||
Begin
|
||||
If (Path[i]='.') Then
|
||||
begin
|
||||
DotPos:=i;
|
||||
break;
|
||||
end;
|
||||
Dec(i);
|
||||
end;
|
||||
Ext:=Copy(Path,DotPos,255);
|
||||
Name:=Copy(Path,1,DotPos - 1);
|
||||
end;
|
||||
|
||||
(*
|
||||
@ -1011,6 +1009,9 @@ function FExpand (const Path: PathStr): PathStr;
|
||||
{$DEFINE FPC_FEXPAND_UNC} (* UNC paths are supported *)
|
||||
{$DEFINE FPC_FEXPAND_DRIVES} (* Full paths begin with drive specification *)
|
||||
|
||||
const
|
||||
LFNSupport = true;
|
||||
|
||||
{$I fexpand.inc}
|
||||
|
||||
{$UNDEF FPC_FEXPAND_DRIVES}
|
||||
@ -1068,7 +1069,7 @@ begin
|
||||
path:=FExPand(path);
|
||||
move(path[1],buffer,length(path));
|
||||
buffer[length(path)]:=#0;
|
||||
asm
|
||||
asm
|
||||
movw $0x4300,%ax
|
||||
leal buffer,%edx
|
||||
call syscall
|
||||
@ -1096,8 +1097,8 @@ begin
|
||||
path:=FExPand(path);
|
||||
move(path[1],buffer,length(path));
|
||||
buffer[length(path)]:=#0;
|
||||
asm
|
||||
movw $0x4301,%ax
|
||||
asm
|
||||
movw $0x4301,%ax
|
||||
leal buffer,%edx
|
||||
movw attr,%cx
|
||||
call syscall
|
||||
@ -1175,43 +1176,110 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 2001-10-05 01:35:48 carl
|
||||
Revision 1.15 2001-11-23 00:35:02 carl
|
||||
* updated behavior of some routines to conform to docs (completely taken from fixes branch)
|
||||
|
||||
Revision 1.1.2.14 2001/11/23 00:33:17 carl
|
||||
* updated behavior of some routines to conform to docs
|
||||
|
||||
Revision 1.1.2.13 2001/11/20 03:32:09 carl
|
||||
* range check errors fixes
|
||||
|
||||
Revision 1.1.2.12 2001/10/05 01:36:18 carl
|
||||
* corrected assembler syntax error
|
||||
|
||||
Revision 1.13 2001/06/13 22:21:53 hajny
|
||||
+ platform specific information
|
||||
Revision 1.1.2.11 2001/06/06 01:30:04 carl
|
||||
+ small modification from go32v2 LFN version (fsplit)
|
||||
* now support / but returns always \ (as it should) (fsplit)
|
||||
|
||||
Revision 1.12 2001/05/21 20:50:19 hajny
|
||||
Revision 1.1.2.10 2001/05/21 20:51:43 hajny
|
||||
* silly mistyping corrected
|
||||
|
||||
Revision 1.11 2001/05/20 18:55:48 hajny
|
||||
* merging Carl's fixes from the fixes branch
|
||||
Revision 1.1.2.9 2001/05/20 18:55:12 hajny
|
||||
* fix for Carl's Exec modification
|
||||
|
||||
Revision 1.10 2001/04/10 18:49:40 hajny
|
||||
Revision 1.1.2.8 2001/05/20 15:05:02 hajny
|
||||
DiskSize/DiskFree EMX mode corrections
|
||||
|
||||
Revision 1.1.2.7 2001/05/14 19:22:53 carl
|
||||
+ More DosError results
|
||||
* GetFattr handle bug
|
||||
* SetFTime handle bug
|
||||
* Passing the environment in exec() now works
|
||||
* Correct flags set with exec()
|
||||
* Buffer overflow for setftime()
|
||||
* Fixed a bug that i added with my last commit, environment pointers under OS/2 were not always setup correctly.
|
||||
|
||||
Revision 1.1.2.6 2001/05/12 03:11:39 carl
|
||||
* fix of environment pointer under real OS/2
|
||||
* fix problems with _findfirst() , _findnext() under plain DOS
|
||||
- remove all syscalls which are either unsupported in OS/2 or untested in EMX
|
||||
(some of them i did test myself, and they crashed under plain DOS)
|
||||
|
||||
Revision 1.1.2.5 2001/04/10 18:54:50 hajny
|
||||
* better check for FindClose
|
||||
|
||||
Revision 1.9 2001/03/11 18:58:42 hajny
|
||||
* another Find* problem :-(
|
||||
Revision 1.1.2.4 2001/03/11 19:07:14 hajny
|
||||
* merging FExpand and Find* fixes
|
||||
|
||||
Revision 1.8 2001/03/10 09:57:51 hajny
|
||||
* FExpand without IOResult change, remaining direct asm removed
|
||||
Revision 1.1.2.3 2001/02/04 02:01:29 hajny
|
||||
* direct asm removing, DosGetInfoBlocks change merged
|
||||
|
||||
Revision 1.7 2001/02/04 01:57:52 hajny
|
||||
* direct asm removing
|
||||
|
||||
Revision 1.6 2000/11/06 20:35:05 hajny
|
||||
* common FExpand introduced
|
||||
|
||||
Revision 1.5 2000/11/05 22:21:47 hajny
|
||||
Revision 1.1.2.2 2000/11/05 22:21:06 hajny
|
||||
* more FExpand fixes
|
||||
|
||||
Revision 1.4 2000/10/28 16:58:34 hajny
|
||||
* many FExpand fixes
|
||||
Revision 1.1.2.1 2000/10/28 16:59:50 hajny
|
||||
* many FExpand fixes plus merging corrections made by Jonas in the main branch
|
||||
|
||||
Revision 1.3 2000/09/29 21:49:41 jonas
|
||||
* removed warnings
|
||||
Revision 1.1 2000/07/13 06:31:04 michael
|
||||
+ Initial import
|
||||
|
||||
Revision 1.2 2000/07/14 10:33:10 michael
|
||||
+ Conditionals fixed
|
||||
Revision 1.28 2000/07/06 18:57:40 hajny
|
||||
* SetFTime for OS/2 mode corrected
|
||||
|
||||
Revision 1.27 2000/06/05 18:50:55 hajny
|
||||
* SetDate, SetTime corrected
|
||||
|
||||
Revision 1.26 2000/06/01 18:38:46 hajny
|
||||
* warning about SetDate added (TODO)
|
||||
|
||||
Revision 1.25 2000/05/28 18:20:16 hajny
|
||||
* DiskFree/DiskSize updated
|
||||
|
||||
Revision 1.24 2000/05/21 16:06:38 hajny
|
||||
+ FSearch and Find* reworked
|
||||
|
||||
Revision 1.23 2000/04/18 20:30:02 hajny
|
||||
* FSearch with given path corrected
|
||||
|
||||
Revision 1.22 2000/03/12 18:32:17 hajny
|
||||
* missing parentheses added
|
||||
|
||||
Revision 1.21 2000/03/05 19:00:37 hajny
|
||||
* DiskFree, DiskSize - int64 result, fix for osDPMI mode
|
||||
|
||||
Revision 1.20 2000/02/09 16:59:33 peter
|
||||
* truncated log
|
||||
|
||||
Revision 1.19 2000/01/09 20:51:03 hajny
|
||||
* FPK changed to FPC
|
||||
|
||||
Revision 1.18 2000/01/07 16:41:45 daniel
|
||||
* copyright 2000
|
||||
|
||||
Revision 1.17 1999/10/13 12:21:56 daniel
|
||||
* OS/2 compiler works again.
|
||||
|
||||
Revision 1.16 1999/09/13 18:21:02 hajny
|
||||
* again didn't manage to read docu for DosFindFirst properly :-(
|
||||
|
||||
Revision 1.15 1999/09/13 17:56:26 hajny
|
||||
* another correction to FSearch fix - mistyping
|
||||
|
||||
Revision 1.14 1999/09/13 17:35:15 hajny
|
||||
* little addition/correction to FSearch fix
|
||||
|
||||
Revision 1.13 1999/09/09 09:20:43 hajny
|
||||
* FSearch under OS/2 fixed
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user