|
@@ -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
|
|
|
- * better check for FindClose
|
|
|
+ Revision 1.1.2.8 2001/05/20 15:05:02 hajny
|
|
|
+ DiskSize/DiskFree EMX mode corrections
|
|
|
|
|
|
- Revision 1.9 2001/03/11 18:58:42 hajny
|
|
|
- * another Find* problem :-(
|
|
|
+ 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.8 2001/03/10 09:57:51 hajny
|
|
|
- * FExpand without IOResult change, remaining direct asm removed
|
|
|
+ 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.7 2001/02/04 01:57:52 hajny
|
|
|
- * direct asm removing
|
|
|
+ Revision 1.1.2.5 2001/04/10 18:54:50 hajny
|
|
|
+ * better check for FindClose
|
|
|
|
|
|
- Revision 1.6 2000/11/06 20:35:05 hajny
|
|
|
- * common FExpand introduced
|
|
|
+ Revision 1.1.2.4 2001/03/11 19:07:14 hajny
|
|
|
+ * merging FExpand and Find* fixes
|
|
|
|
|
|
- Revision 1.5 2000/11/05 22:21:47 hajny
|
|
|
+ Revision 1.1.2.3 2001/02/04 02:01:29 hajny
|
|
|
+ * direct asm removing, DosGetInfoBlocks change merged
|
|
|
+
|
|
|
+ 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.1 2000/07/13 06:31:04 michael
|
|
|
+ + Initial import
|
|
|
+
|
|
|
+ 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.3 2000/09/29 21:49:41 jonas
|
|
|
- * removed warnings
|
|
|
+ Revision 1.14 1999/09/13 17:35:15 hajny
|
|
|
+ * little addition/correction to FSearch fix
|
|
|
|
|
|
- Revision 1.2 2000/07/14 10:33:10 michael
|
|
|
- + Conditionals fixed
|
|
|
+ Revision 1.13 1999/09/09 09:20:43 hajny
|
|
|
+ * FSearch under OS/2 fixed
|
|
|
|
|
|
}
|