mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 08:29:28 +02:00
* more things got implemented
This commit is contained in:
Károly Balogh
parent
39183a8778
commit
65223ed162
@ -55,9 +55,14 @@ var
|
||||
MOS_DOSBase : Pointer;
|
||||
|
||||
MOS_heapPool : Pointer; { pointer for the OS pool for growing the heap }
|
||||
MOS_origDir : LongInt; { original directory on startup }
|
||||
|
||||
|
||||
{ MorphOS functions }
|
||||
{*****************************************************************************
|
||||
MorphOS functions
|
||||
*****************************************************************************}
|
||||
|
||||
{ exec.library functions }
|
||||
|
||||
function exec_OpenLibrary(libname: PChar location 'a1';
|
||||
libver: LongInt location 'd0'): Pointer; SysCall MOS_ExecBase 552;
|
||||
@ -72,6 +77,9 @@ function exec_AllocPooled(poolHeader: Pointer location 'a0';
|
||||
function exec_SetSignal(newSignals: LongInt location 'd0';
|
||||
signalMask: LongInt location 'd1'): LongInt; SysCall MOS_ExecBase 306;
|
||||
|
||||
|
||||
{ dos.library functions }
|
||||
|
||||
function dos_Output: LongInt; SysCall MOS_DOSBase 60;
|
||||
function dos_Input: LongInt; SysCall MOS_DOSBase 54;
|
||||
function dos_IoErr: LongInt; SysCall MOS_DOSBase 132;
|
||||
@ -105,13 +113,48 @@ function dos_GetCurrentDirName(buf: PChar location 'd1';
|
||||
|
||||
function dos_Lock(lname: PChar location 'd1';
|
||||
accessMode: LongInt location 'd2'): LongInt; SysCall MOS_DOSBase 84;
|
||||
procedure dos_Unlock(lock: LongInt location 'd1'); SysCall MOS_DOSBase 90;
|
||||
function dos_CurrentDir(lock: LongInt location 'd1'): LongInt; SysCall MOS_DOSBase 126;
|
||||
function dos_Examine(lock: LongInt location 'd1';
|
||||
FileInfoBlock: Pointer location 'd2'): Boolean; SysCall MOS_DOSBase 102;
|
||||
function dos_CreateDir(dname: PChar location 'd1'): LongInt; SysCall MOS_DOSBase 120;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$I system.inc}
|
||||
|
||||
|
||||
{ OS dependant parts }
|
||||
{*****************************************************************************
|
||||
System Dependent Structures/Consts
|
||||
*****************************************************************************}
|
||||
|
||||
{ Used system structures }
|
||||
Type
|
||||
TDateStamp = packed record
|
||||
ds_Days : LongInt; { Number of days since Jan. 1, 1978 }
|
||||
ds_Minute : LongInt; { Number of minutes past midnight }
|
||||
ds_Tick : LongInt; { Number of ticks past minute }
|
||||
end;
|
||||
PDateStamp = ^TDateStamp;
|
||||
|
||||
PFileInfoBlock = ^TFileInfoBlock;
|
||||
TFileInfoBlock = packed record
|
||||
fib_DiskKey : LongInt;
|
||||
fib_DirEntryType : LongInt;
|
||||
{ Type of Directory. If < 0, then a plain file. If > 0 a directory }
|
||||
fib_FileName : Array [0..107] of Char;
|
||||
{ Null terminated. Max 30 chars used for now }
|
||||
fib_Protection : LongInt;
|
||||
{ bit mask of protection, rwxd are 3-0. }
|
||||
fib_EntryType : LongInt;
|
||||
fib_Size : LongInt; { Number of bytes in file }
|
||||
fib_NumBlocks : LongInt; { Number of blocks in file }
|
||||
fib_Date : TDateStamp; { Date file last changed }
|
||||
fib_Comment : Array [0..79] of Char;
|
||||
{ Null terminated comment associated with file }
|
||||
fib_Reserved : Array [0..35] of Char;
|
||||
end;
|
||||
|
||||
{ Errors from dos_IoErr(), etc. }
|
||||
const
|
||||
@ -168,6 +211,13 @@ const
|
||||
OFFSET_CURRENT = 0;
|
||||
OFFSET_END = 1;
|
||||
|
||||
{ Lock AccessMode }
|
||||
const
|
||||
SHARED_LOCK = -2;
|
||||
ACCESS_READ = SHARED_LOCK;
|
||||
EXCLUSIVE_LOCK = -1;
|
||||
ACCESS_WRITE = EXCLUSIVE_LOCK;
|
||||
|
||||
{ Memory flags }
|
||||
const
|
||||
MEMF_ANY = 0;
|
||||
@ -190,6 +240,99 @@ const
|
||||
SIGBREAKF_CTRL_C = $1000; { CTRL-C signal flags }
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
MorphOS File-handling Support Functions
|
||||
*****************************************************************************}
|
||||
type
|
||||
{ AmigaOS does not automatically close opened files on exit back to }
|
||||
{ the operating system, therefore as a precuation we close all files }
|
||||
{ manually on exit. }
|
||||
PFileList = ^TFileList;
|
||||
TFileList = record { no packed, must be correctly aligned }
|
||||
handle : LongInt; { Handle to file }
|
||||
next : PFileList; { Next file in list }
|
||||
end;
|
||||
|
||||
var
|
||||
MOS_fileList: PFileList; { List pointer to opened files }
|
||||
|
||||
{ Function to be called at program shutdown, to close all opened files }
|
||||
procedure CloseList(l: PFileList);
|
||||
var
|
||||
tmpNext : PFileList;
|
||||
tmpHandle : LongInt;
|
||||
begin
|
||||
if l=nil then exit;
|
||||
|
||||
{ First, close all tracked files }
|
||||
tmpNext:=l^.next;
|
||||
while tmpNext<>nil do begin
|
||||
tmpHandle:=tmpNext^.handle;
|
||||
if (tmpHandle<>StdInputHandle) and (tmpHandle<>StdOutputHandle)
|
||||
and (tmpHandle<>StdErrorHandle) then begin
|
||||
dos_Close(tmpHandle);
|
||||
end;
|
||||
tmpNext:=tmpNext^.next;
|
||||
end;
|
||||
|
||||
{ Next, erase the linked list }
|
||||
while l<>nil do begin
|
||||
tmpNext:=l;
|
||||
l:=l^.next;
|
||||
dispose(tmpNext);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Function to be called to add a file to the opened file list }
|
||||
procedure AddToList(var l: PFileList; h: LongInt);
|
||||
var
|
||||
p : PFileList;
|
||||
inList: Boolean;
|
||||
begin
|
||||
inList:=False;
|
||||
if l<>nil then begin
|
||||
{ if there is a valid filelist, search for the value }
|
||||
{ in the list to avoid double additions }
|
||||
p:=l;
|
||||
while (p^.next<>nil) and (not inList) do
|
||||
if p^.next^.handle=h then inList:=True
|
||||
else p:=p^.next;
|
||||
p:=nil;
|
||||
end else begin
|
||||
{ if the list is not yet allocated, allocate it. }
|
||||
New(l);
|
||||
l^.next:=nil;
|
||||
end;
|
||||
|
||||
if not inList then begin
|
||||
New(p);
|
||||
p^.handle:=h;
|
||||
p^.next:=l^.next;
|
||||
l^.next:=p;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ Function to be called to remove a file from the list }
|
||||
procedure RemoveFromList(var l: PFileList; h: longint);
|
||||
var
|
||||
p : PFileList;
|
||||
inList: Boolean;
|
||||
begin
|
||||
if l=nil then exit;
|
||||
|
||||
inList:=False;
|
||||
p:=l;
|
||||
while (p^.next<>nil) and (not inList) do
|
||||
if p^.next^.handle=h then inList:=True
|
||||
else p:=p^.next;
|
||||
|
||||
if p^.next<>nil then begin
|
||||
dispose(p^.next);
|
||||
p^.next:=p^.next^.next;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
Misc. System Dependent Functions
|
||||
*****************************************************************************}
|
||||
@ -198,6 +341,17 @@ procedure haltproc(e:longint);cdecl;external name '_haltproc';
|
||||
|
||||
procedure System_exit;
|
||||
begin
|
||||
{ We must remove the CTRL-C FALG here because halt }
|
||||
{ may call I/O routines, which in turn might call }
|
||||
{ halt, so a recursive stack crash }
|
||||
if BreakOn then begin
|
||||
if (exec_SetSignal(0,0) and SIGBREAKF_CTRL_C)<>0 then
|
||||
exec_SetSignal(0,SIGBREAKF_CTRL_C);
|
||||
end;
|
||||
|
||||
{ Closing opened files }
|
||||
CloseList(MOS_fileList);
|
||||
|
||||
if MOS_DOSBase<>NIL then exec_CloseLibrary(MOS_DOSBase);
|
||||
if MOS_heapPool<>NIL then exec_DeletePool(MOS_heapPool);
|
||||
haltproc(ExitCode);
|
||||
@ -261,6 +415,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
ParamStr/Randomize
|
||||
*****************************************************************************}
|
||||
@ -303,13 +458,13 @@ var
|
||||
{ first address of heap }
|
||||
function getheapstart:pointer;
|
||||
begin
|
||||
getheapstart:=@int_heap;
|
||||
getheapstart:=@int_heap;
|
||||
end;
|
||||
|
||||
{ current length of heap }
|
||||
function getheapsize:longint;
|
||||
begin
|
||||
getheapsize:=int_heapsize;
|
||||
getheapsize:=int_heapsize;
|
||||
end;
|
||||
|
||||
{ function to allocate size bytes more for the program }
|
||||
@ -326,33 +481,98 @@ end;
|
||||
Directory Handling
|
||||
*****************************************************************************}
|
||||
procedure mkdir(const s : string);[IOCheck];
|
||||
var
|
||||
buffer : array[0..255] of char;
|
||||
j : Integer;
|
||||
tmpStr : string;
|
||||
tmpLock : LongInt;
|
||||
begin
|
||||
checkCTRLC;
|
||||
InOutRes:=1;
|
||||
if (s='') or (InOutRes<>0) then exit;
|
||||
tmpStr:=s;
|
||||
|
||||
for j:=1 to length(tmpStr) do
|
||||
if tmpStr[j]='\' then tmpStr[j]:='/';
|
||||
move(tmpStr[1],buffer,length(tmpStr));
|
||||
buffer[length(tmpStr)]:=#0;
|
||||
|
||||
tmpLock:=dos_CreateDir(buffer);
|
||||
if tmpLock=0 then begin
|
||||
dosError2InOut(dos_IoErr);
|
||||
exit;
|
||||
end;
|
||||
dos_UnLock(tmpLock);
|
||||
end;
|
||||
|
||||
procedure rmdir(const s : string);[IOCheck];
|
||||
var
|
||||
buffer : array[0..255] of char;
|
||||
j : Integer;
|
||||
temp : string;
|
||||
tmpStr : string;
|
||||
begin
|
||||
checkCTRLC;
|
||||
if (s='.') then InOutRes:=16;
|
||||
If (s='') or (InOutRes<>0) then exit;
|
||||
temp:=s;
|
||||
for j:=1 to length(temp) do
|
||||
if temp[j] = '\' then temp[j] := '/';
|
||||
move(temp[1],buffer,length(temp));
|
||||
buffer[length(temp)]:=#0;
|
||||
tmpStr:=s;
|
||||
for j:=1 to length(tmpStr) do
|
||||
if tmpStr[j] = '\' then tmpStr[j] := '/';
|
||||
move(tmpStr[1],buffer,length(tmpStr));
|
||||
buffer[length(tmpStr)]:=#0;
|
||||
if not dos_DeleteFile(buffer) then
|
||||
dosError2InOut(dos_IoErr);
|
||||
end;
|
||||
|
||||
procedure chdir(const s : string);[IOCheck];
|
||||
var
|
||||
buffer : array[0..255] of char;
|
||||
alock : LongInt;
|
||||
FIB : PFileInfoBlock;
|
||||
j : Integer;
|
||||
tmpStr : string;
|
||||
begin
|
||||
checkCTRLC;
|
||||
InOutRes:=1;
|
||||
If (s='') or (InOutRes<>0) then exit;
|
||||
tmpStr:=s;
|
||||
|
||||
for j:=1 to length(tmpStr) do
|
||||
if tmpStr[j]='\' then tmpStr[j]:='/';
|
||||
|
||||
{ Return parent directory }
|
||||
if s='..' then begin
|
||||
getdir(0,tmpStr);
|
||||
j:=length(tmpStr);
|
||||
{ Look through the previous paths }
|
||||
while (tmpStr[j]<>'/') and (tmpStr[j]<>':') and (j>0) do
|
||||
dec(j);
|
||||
if j>0 then
|
||||
tmpStr:=copy(tmpStr,1,j);
|
||||
end;
|
||||
alock:=0;
|
||||
|
||||
move(tmpStr[1],buffer,length(tmpStr));
|
||||
buffer[length(tmpStr)]:=#0;
|
||||
{ Changing the directory is a pretty complicated affair }
|
||||
{ 1) Obtain a lock on the directory }
|
||||
{ 2) CurrentDir the lock }
|
||||
alock:=dos_Lock(buffer,SHARED_LOCK);
|
||||
if alock=0 then begin
|
||||
dosError2InOut(dos_IoErr);
|
||||
exit;
|
||||
end;
|
||||
|
||||
FIB:=nil;
|
||||
new(FIB);
|
||||
|
||||
if (dos_Examine(alock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
|
||||
alock := dos_CurrentDir(alock);
|
||||
if MOS_OrigDir=0 then begin
|
||||
MOS_OrigDir:=alock;
|
||||
alock:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
if alock<>0 then dos_Unlock(alock);
|
||||
if assigned(FIB) then dispose(FIB)
|
||||
end;
|
||||
|
||||
procedure GetDir (DriveNr: byte; var Dir: ShortString);
|
||||
@ -375,6 +595,7 @@ end;
|
||||
{ close a file from the handle value }
|
||||
procedure do_close(handle : longint);
|
||||
begin
|
||||
RemoveFromList(MOS_fileList,handle);
|
||||
{ Do _NOT_ check CTRL_C on Close, because it will conflict
|
||||
with System_Exit! }
|
||||
if not dos_Close(handle) then
|
||||
@ -493,7 +714,7 @@ procedure do_open(var f;p:pchar;flags:longint);
|
||||
}
|
||||
var
|
||||
i,j : LongInt;
|
||||
openflags: LongInt;
|
||||
openflags : LongInt;
|
||||
path : String;
|
||||
buffer : array[0..255] of Char;
|
||||
index : Integer;
|
||||
@ -511,7 +732,7 @@ begin
|
||||
delete(path,1,3);
|
||||
getdir(0,s);
|
||||
j:=length(s);
|
||||
while (s[j] <> '/') AND (s[j] <> ':') AND (j > 0 ) do
|
||||
while (s[j]<>'/') and (s[j]<>':') and (j>0) do
|
||||
dec(j);
|
||||
if j > 0 then
|
||||
s:=copy(s,1,j);
|
||||
@ -524,7 +745,7 @@ begin
|
||||
begin
|
||||
delete(path,1,2);
|
||||
getdir(0,s);
|
||||
if (s[length(s)] <> '/') and (s[length(s)] <> ':') then
|
||||
if (s[length(s)]<>'/') and (s[length(s)]<>':') then
|
||||
s:=s+'/';
|
||||
path:=s+path;
|
||||
end;
|
||||
@ -581,7 +802,7 @@ begin
|
||||
begin
|
||||
dosError2InOut(dos_IoErr);
|
||||
end else begin
|
||||
{AddToList(FileList,i);}
|
||||
AddToList(MOS_fileList,i);
|
||||
filerec(f).handle:=i;
|
||||
end;
|
||||
|
||||
@ -694,11 +915,16 @@ Begin
|
||||
{$ifdef HASVARIANT}
|
||||
initvariantmanager;
|
||||
{$endif HASVARIANT}
|
||||
MOS_origDir:=0;
|
||||
MOS_fileList:=nil;
|
||||
End.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2004-05-02 02:06:57 karoly
|
||||
Revision 1.5 2004-05-09 02:02:42 karoly
|
||||
* more things got implemented
|
||||
|
||||
Revision 1.4 2004/05/02 02:06:57 karoly
|
||||
+ most of file I/O calls implemented
|
||||
|
||||
Revision 1.3 2004/05/01 15:09:47 karoly
|
||||
|
||||
Loading…
Reference in New Issue
Block a user