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

* IOCheck for chdir,rmdir and mkdir as in TP

Browse Source
This commit is contained in:
carl 1998-07-02 12:37:52 +00:00
parent f5ea384880
commit b77b3c9200
1 changed files with 37 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
rtl/amiga/sysamiga.pas
View File

@ -17,7 +17,6 @@
unit sysamiga; unit sysamiga;
{ Things left to do : } { Things left to do : }
{ - Fix randomize }
{ - Fix Truncate!! } { - Fix Truncate!! }
{$I os.inc} {$I os.inc}
@ -217,6 +216,21 @@ const
{ ************************ AMIGAOS STUB ROUTINES ************************* } { ************************ AMIGAOS STUB ROUTINES ************************* }
procedure DateStamp(var ds : tDateStamp);
begin
asm
MOVE.L A6,-(A7)
MOVE.L ds,d1
{ LAST THING TO SETUP SHOULD BE A6, otherwise you can }
{ not accept local variable, nor any parameters! :) }
MOVE.L _DOSBase,A6
JSR -192(A6)
MOVE.L (A7)+,A6
end;
end;
{ UNLOCK the BPTR pointed to in L } { UNLOCK the BPTR pointed to in L }
Procedure Unlock(alock: longint); Procedure Unlock(alock: longint);
Begin Begin
@ -644,12 +658,10 @@ const
var var
hl : longint; hl : longint;
time : TDateStamp;
begin begin
asm DateStamp(time);
{ !!!!!!! } randseed:=time.ds_tick;
end;
randseed:=hl;
end; end;
{ This routine is used to grow the heap. } { This routine is used to grow the heap. }
@ -682,6 +694,17 @@ begin
end; end;
function do_isdevice(handle:longint):boolean;
begin
if (handle=stdoutputhandle) or (handle=stdinputhandle) or
(handle=stderrorhandle) then
do_isdevice:=TRUE
else
do_isdevice:=FALSE;
end;
procedure do_erase(p : pchar); procedure do_erase(p : pchar);
begin begin
asm asm
@ -1042,6 +1065,7 @@ procedure mkdir(const s : string);[IOCheck];
var var
buffer : array[0..255] of char; buffer : array[0..255] of char;
begin begin
If InOutRes <> 0 then exit;
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
asm asm
@ -1075,6 +1099,7 @@ procedure rmdir(const s : string);[IOCheck];
var var
buffer : array[0..255] of char; buffer : array[0..255] of char;
begin begin
If InOutRes <> 0 then exit;
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
do_erase(buffer); do_erase(buffer);
@ -1088,6 +1113,7 @@ var
alock : longint; alock : longint;
FIB :pFileInfoBlock; FIB :pFileInfoBlock;
begin begin
If InOutRes <> 0 then exit;
alock := 0; alock := 0;
fib:=nil; fib:=nil;
new(fib); new(fib);
@ -1204,7 +1230,7 @@ end;
end; end;
procedure getdir(drivenr : byte;var dir : string);[IOCheck]; procedure getdir(drivenr : byte;var dir : string);
begin begin
GetCwd(dir); GetCwd(dir);
If errno <> 0 then If errno <> 0 then
@ -1295,15 +1321,6 @@ asm
end; end;
procedure OpenStdIO(var f:text;mode:word;hdl:longint);
begin
Assign(f,'');
TextRec(f).Handle:=hdl;
TextRec(f).Mode:=mode;
TextRec(f).InOutFunc:=@FileInOutFunc;
TextRec(f).FlushFunc:=@FileInOutFunc;
TextRec(f).Closefunc:=@fileclosefunc;
end;
begin begin
@ -1345,7 +1362,10 @@ end.
{ {
$Log$ $Log$
Revision 1.5 1998-07-01 14:30:56 carl Revision 1.6 1998-07-02 12:37:52 carl
* IOCheck for chdir,rmdir and mkdir as in TP
Revision 1.5 1998/07/01 14:30:56 carl
* forgot that includes are case sensitive * forgot that includes are case sensitive
Revision 1.4 1998/07/01 14:13:50 carl Revision 1.4 1998/07/01 14:13:50 carl