paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-02 07:22:37 +02:00
Code Issues Packages Projects Releases Wiki Activity

* more cleanup + changes to use new includes

Browse Source
This commit is contained in:
Károly Balogh 2004-06-26 20:48:24 +00:00
parent c8bbf8516a
commit a59bfb695b
2 changed files with 128 additions and 418 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

207
rtl/morphos/dos.pp
View File

@ -29,9 +29,9 @@ unit Dos;
{--------------------------------------------------------------------}
Interface
interface
Const
const
{Bitmasks for CPU Flags}
fcarry = $0001;
fparity = $0004;
@ -64,7 +64,6 @@ Type
ExtStr = String[255]; { size increased to be more compatible with Unix}
{
filerec.inc contains the definition of the filerec.
textrec.inc contains the definition of the textrec.
@ -75,8 +74,7 @@ Type
{$i textrec.inc}
Type
type
SearchRec = Packed Record
{ watch out this is correctly aligned for all processors }
{ don't modify. }
@ -92,12 +90,12 @@ Type
DateTime = packed record
Year: Word;
Year : Word;
Month: Word;
Day: Word;
Hour: Word;
Min: Word;
Sec: word;
Day : Word;
Hour : Word;
Min : Word;
Sec : Word;
End;
{ Some ugly x86 registers... }
@ -109,7 +107,7 @@ Type
end;
Var
var
DosError : integer;
{Interrupt}
@ -162,20 +160,24 @@ Procedure GetIntVec(intno: byte; var vector: pointer);
Procedure SetIntVec(intno: byte; vector: pointer);
Procedure Keep(exitcode: word);
implementation
{ * include MorphOS specific functions & definitions * }
{$include execd.inc}
{$include execf.inc}
{$include timerd.inc}
{$include doslibd.inc}
{$include doslibf.inc}
const
DaysPerMonth : Array[1..12] of ShortInt =
(031,028,031,030,031,030,031,031,030,031,030,031);
(031,028,031,030,031,030,031,031,030,031,030,031);
DaysPerYear : Array[1..12] of Integer =
(031,059,090,120,151,181,212,243,273,304,334,365);
(031,059,090,120,151,181,212,243,273,304,334,365);
DaysPerLeapYear : Array[1..12] of Integer =
(031,060,091,121,152,182,213,244,274,305,335,366);
(031,060,091,121,152,182,213,244,274,305,335,366);
SecsPerYear : LongInt = 31536000;
SecsPerLeapYear : LongInt = 31622400;
SecsPerDay : LongInt = 86400;
@ -183,40 +185,22 @@ const
SecsPerMinute : ShortInt = 60;
TICKSPERSECOND = 50;
type
BPTR = Longint;
BSTR = Longint;
const
LDF_READ = 1;
LDF_DEVICES = 4;
ERROR_NO_MORE_ENTRIES = 232;
FIBF_SCRIPT = 64; { program is a script }
FIBF_PURE = 32; { program is reentrant }
FIBF_ARCHIVE = 16; { cleared whenever file is changed }
FIBF_READ = 8; { ignoed by old filesystem }
FIBF_WRITE = 4; { ignored by old filesystem }
FIBF_EXECUTE = 2; { ignored by system, used by shell }
FIBF_DELETE = 1; { prevent file from being deleted }
SHARED_LOCK = -2;
{******************************************************************************
--- Internal routines ---
******************************************************************************}
function Lock(const name : string;
accessmode : Longint) : BPTR;
function dosLock(const name : string;
accessmode : Longint) : LongInt;
var
buffer: Array[0..255] of char;
Begin
move(name[1],buffer,length(name));
buffer[length(name)]:=#0;
lock:=dos_Lock(buffer,accessmode);
dosLock:=Lock(buffer,accessmode);
end;
FUNCTION BADDR(bval : BPTR): POINTER;
FUNCTION BADDR(bval : LongInt): POINTER;
BEGIN
BADDR := POINTER( bval shl 2);
END;
@ -317,21 +301,21 @@ Begin
End;
function SetProtection(const name: string; mask:longint): Boolean;
function dosSetProtection(const name: string; mask:longint): Boolean;
var
buffer : array[0..255] of Char;
begin
move(name[1],buffer,length(name));
buffer[length(name)]:=#0;
SetProtection:=dos_SetProtection(buffer,mask);
dosSetProtection:=SetProtection(buffer,mask);
end;
function SetFileDate(name: string; p : PDateStamp): Boolean;
function dosSetFileDate(name: string; p : PDateStamp): Boolean;
var buffer : array[0..255] of Char;
begin
move(name[1],buffer,length(name));
buffer[length(name)]:=#0;
SetFileDate:=dos_SetFileDate(buffer,p);
dosSetFileDate:=SetFileDate(buffer,p);
end;
@ -339,34 +323,31 @@ end;
--- Dos Interrupt ---
******************************************************************************}
Procedure Intr (intno: byte; var regs: registers);
Begin
procedure Intr(intno: byte; var regs: registers);
begin
{ Does not apply to MorphOS - not implemented }
End;
end;
Procedure SwapVectors;
Begin
procedure SwapVectors;
begin
{ Does not apply to MorphOS - Do Nothing }
End;
end;
Procedure msdos(var regs : registers);
Begin
procedure msdos(var regs : registers);
begin
{ ! Not implemented in MorphOS ! }
End;
end;
Procedure getintvec(intno : byte;var vector : pointer);
Begin
procedure getintvec(intno : byte;var vector : pointer);
begin
{ ! Not implemented in MorphOS ! }
End;
end;
Procedure setintvec(intno : byte;vector : pointer);
Begin
procedure setintvec(intno : byte;vector : pointer);
begin
{ ! Not implemented in MorphOS ! }
End;
end;
{******************************************************************************
--- Info / Date / Time ---
@ -381,45 +362,6 @@ end;
{ Here are a lot of stuff just for setdate and settime }
Const
{ unit defintions }
UNIT_MICROHZ = 0;
UNIT_VBLANK = 1;
TIMERNAME : PChar = 'timer.device';
Type
ptimeval = ^ttimeval;
ttimeval = packed record
tv_secs : longint;
tv_micro : longint;
end;
ptimerequest = ^ttimerequest;
ttimerequest = packed record
tr_node : tIORequest;
tr_time : ttimeval;
end;
Const
{ IO_COMMAND to use for adding a timer }
TR_ADDREQUEST = CMD_NONSTD;
TR_GETSYSTIME = CMD_NONSTD + 1;
TR_SETSYSTIME = CMD_NONSTD + 2;
{ To use any of the routines below, TimerBase must be set to point
to the timer.device, either by calling CreateTimer or by pulling
the device pointer from a valid TimeRequest, i.e.
TimerBase := TimeRequest.io_Device;
_after_ you have called OpenDevice on the timer.
}
var
TimerBase : Pointer;
@ -684,12 +626,12 @@ Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
{ _SystemTagList call (program will abort!!) }
{ Try to open with shared lock }
MyLock:=Lock(Path,SHARED_LOCK);
MyLock:=dosLock(Path,SHARED_LOCK);
if MyLock <> 0 then
Begin
{ File exists - therefore unlock it }
dos_Unlock(MyLock);
result:=dos_SystemTagList(buf,nil);
Unlock(MyLock);
result:=SystemTagList(buf,nil);
{ on return of -1 the shell could not be executed }
{ probably because there was not enough memory }
if result = -1 then
@ -763,7 +705,7 @@ var
Function DiskFree(Drive: Byte): Longint;
Var
MyLock : BPTR;
MyLock : LongInt;
Inf : pInfoData;
Free : Longint;
myproc : pProcess;
@ -776,13 +718,13 @@ Begin
myproc^.pr_WindowPtr := Pointer(-1);
{ End of systemrequesterstop }
New(Inf);
MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
MyLock := dosLock(devicenames[deviceids[Drive]],SHARED_LOCK);
If MyLock <> 0 then begin
if dos_Info(MyLock,Inf) then begin
if Info(MyLock,Inf) then begin
Free := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock) -
(Inf^.id_NumBlocksUsed * Inf^.id_BytesPerBlock);
end;
dos_Unlock(MyLock);
Unlock(MyLock);
end;
Dispose(Inf);
{ Restore systemrequesters }
@ -794,7 +736,7 @@ end;
Function DiskSize(Drive: Byte): Longint;
Var
MyLock : BPTR;
MyLock : LongInt;
Inf : pInfoData;
Size : Longint;
myproc : pProcess;
@ -807,12 +749,12 @@ Begin
myproc^.pr_WindowPtr := Pointer(-1);
{ End of systemrequesterstop }
New(Inf);
MyLock := Lock(devicenames[deviceids[Drive]],SHARED_LOCK);
MyLock := dosLock(devicenames[deviceids[Drive]],SHARED_LOCK);
If MyLock <> 0 then begin
if dos_Info(MyLock,Inf) then begin
if Info(MyLock,Inf) then begin
Size := (Inf^.id_NumBlocks * Inf^.id_BytesPerBlock);
end;
dos_Unlock(MyLock);
Unlock(MyLock);
end;
Dispose(Inf);
{ Restore systemrequesters }
@ -880,7 +822,7 @@ Begin
move(path[1],buf,length(path));
buf[length(path)]:=#0;
Result:=dos_MatchFirst(@buf,Anchor);
Result:=MatchFirst(@buf,Anchor);
f.AnchorPtr:=Anchor;
if Result = ERROR_NO_MORE_ENTRIES then
DosError:=18
@ -891,7 +833,7 @@ Begin
{ the anchorpath structure }
if DosError <> 0 then
Begin
dos_MatchEnd(Anchor);
MatchEnd(Anchor);
if assigned(Anchor) then
Dispose(Anchor);
end
@ -937,7 +879,7 @@ var
Anchor : pAnchorPath;
Begin
DosError:=0;
Result:=dos_MatchNext(f.AnchorPtr);
Result:=MatchNext(f.AnchorPtr);
if Result = ERROR_NO_MORE_ENTRIES then
DosError:=18
else
@ -947,7 +889,7 @@ Begin
{ the anchorpath structure }
if DosError <> 0 then
Begin
dos_MatchEnd(f.AnchorPtr);
MatchEnd(f.AnchorPtr);
if assigned(f.AnchorPtr) then
{Dispose}FreeMem(f.AnchorPtr);
end
@ -1088,10 +1030,10 @@ begin
Str := StrPas(filerec(f).name);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
FLock := Lock(Str, SHARED_LOCK);
FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then begin
New(FInfo);
if dos_Examine(FLock, FInfo) then begin
if Examine(FLock, FInfo) then begin
with FInfo^.fib_Date do
FTime := ds_Days * (24 * 60 * 60) +
ds_Minute * 60 +
@ -1099,7 +1041,7 @@ begin
end else begin
FTime := 0;
end;
dos_Unlock(FLock);
Unlock(FLock);
Dispose(FInfo);
end
else
@ -1121,15 +1063,15 @@ end;
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
{ Check first of all, if file exists }
FLock := Lock(Str, SHARED_LOCK);
FLock := dosLock(Str, SHARED_LOCK);
IF FLock <> 0 then
begin
dos_Unlock(FLock);
Unlock(FLock);
Amiga2DateStamp(time,Days,Minutes,ticks);
DateStamp^.ds_Days:=Days;
DateStamp^.ds_Minute:=Minutes;
DateStamp^.ds_Tick:=Ticks;
if SetFileDate(Str,DateStamp) then
if dosSetFileDate(Str,DateStamp) then
DosError:=0
else
DosError:=6;
@ -1154,10 +1096,10 @@ end;
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
{ open with shared lock to check if file exists }
MyLock:=Lock(Str,SHARED_LOCK);
MyLock:=dosLock(Str,SHARED_LOCK);
if MyLock <> 0 then
Begin
dos_Examine(MyLock,info);
Examine(MyLock,info);
{*------------------------------------*}
{* Determine if is a file or a folder *}
{*------------------------------------*}
@ -1175,7 +1117,7 @@ end;
AND ((info^.fib_Protection and FIBF_WRITE) = 0)
then
flags:=flags OR ReadOnly;
dos_Unlock(mylock);
Unlock(mylock);
end
else
DosError:=3;
@ -1198,7 +1140,7 @@ Procedure setfattr (var f;attr : word);
for i:=1 to length(Str) do
if str[i]='\' then str[i]:='/';
MyLock:=Lock(Str,SHARED_LOCK);
MyLock:=dosLock(Str,SHARED_LOCK);
{ By default files are read-write }
if attr AND ReadOnly <> 0 then
@ -1208,8 +1150,8 @@ Procedure setfattr (var f;attr : word);
if MyLock <> 0 then
Begin
dos_Unlock(MyLock);
if Not SetProtection(Str,flags) then
Unlock(MyLock);
if Not dosSetProtection(Str,flags) then
DosError:=5;
end
else
@ -1290,7 +1232,7 @@ begin
end else begin
move(envvar,strbuffer,length(envvar));
strbuffer[length(envvar)] := #0;
temp := dos_GetVar(strbuffer,bufarr,255,$100);
temp := GetVar(strbuffer,bufarr,255,$100);
if temp = -1 then
GetEnv := ''
else GetEnv := StrPas(bufarr);
@ -1340,7 +1282,7 @@ begin
end;
function BSTR2STRING(s : BSTR): pchar;
function BSTR2STRING(s : LongInt): pchar;
begin
BSTR2STRING := Pointer(Longint(BADDR(s))+1);
end;
@ -1351,9 +1293,9 @@ var
temp : pchar;
str : string[20];
begin
dl := dos_LockDosList(LDF_DEVICES or LDF_READ );
dl := LockDosList(LDF_DEVICES or LDF_READ );
repeat
dl := dos_NextDosEntry(dl,LDF_DEVICES );
dl := NextDosEntry(dl,LDF_DEVICES );
if dl <> nil then begin
temp := BSTR2STRING(dl^.dol_Name);
str := MakeDeviceName(temp);
@ -1361,7 +1303,7 @@ begin
AddDevice(str);
end;
until dl = nil;
dos_UnLockDosList(LDF_DEVICES or LDF_READ );
UnLockDosList(LDF_DEVICES or LDF_READ );
end;
Begin
@ -1374,7 +1316,10 @@ End.
{
$Log$
Revision 1.5 2004-06-13 22:51:08 karoly
Revision 1.6 2004-06-26 20:48:24 karoly
* more cleanup + changes to use new includes
Revision 1.5 2004/06/13 22:51:08 karoly
* cleanup and changes to use new includes
Revision 1.4 2004/05/16 00:24:19 karoly

339
rtl/morphos/system.pp
View File

@ -59,6 +59,8 @@ const
*****************************************************************************}
{$include execd.inc}
{$include timerd.inc}
{$include doslibd.inc}
type
PClockData = ^TClockData;
@ -72,108 +74,6 @@ type
wday : Word;
end;
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;
PProcess = ^TProcess;
TProcess = packed record
pr_Task : TTask;
pr_MsgPort : TMsgPort; { This is BPTR address from DOS functions }
pr_Pad : Word; { Remaining variables on 4 byte boundaries }
pr_SegList : Pointer; { Array of seg lists used by this process }
pr_StackSize : Longint; { Size of process stack in bytes }
pr_GlobVec : Pointer; { Global vector for this process (BCPL) }
pr_TaskNum : Longint; { CLI task number of zero if not a CLI }
pr_StackBase : DWord; { Ptr to high memory end of process stack }
pr_Result2 : Longint; { Value of secondary result from last call }
pr_CurrentDir : DWord; { Lock associated with current directory }
pr_CIS : DWord; { Current CLI Input Stream }
pr_COS : DWord; { Current CLI Output Stream }
pr_ConsoleTask : Pointer; { Console handler process for current window }
pr_FileSystemTask: Pointer; { File handler process for current drive }
pr_CLI : DWord; { pointer to ConsoleLineInterpreter }
pr_ReturnAddr : Pointer; { pointer to previous stack frame }
pr_PktWait : Pointer; { Function to be called when awaiting msg }
pr_WindowPtr : Pointer; { Window for error printing }
{ following definitions are new with 2.0 }
pr_HomeDir : DWord; { Home directory of executing program }
pr_Flags : Longint; { flags telling dos about process }
pr_ExitCode : Pointer; { code to call on exit of program OR NULL }
pr_ExitData : Longint; { Passed as an argument to pr_ExitCode. }
pr_Arguments : PChar; { Arguments passed to the process at start }
pr_LocalVars : TMinList; { Local environment variables }
pr_ShellPrivate : Longint; { for the use of the current shell }
pr_CES : DWord; { Error stream - IF NULL, use pr_COS }
end;
PInfoData = ^TInfoData;
TInfoData = packed record
id_NumSoftErrors: LongInt; { number of soft errors on disk }
id_UnitNumber : LongInt; { Which unit disk is (was) mounted on }
id_DiskState : LongInt; { See defines below }
id_NumBlocks : LongInt; { Number of blocks on disk }
id_NumBlocksUsed: LongInt; { Number of block in use }
id_BytesPerBlock: LongInt;
id_DiskType : LongInt; { Disk Type code }
id_VolumeNode : LongInt; { BCPL pointer to volume node }
id_InUse : LongInt; { Flag, zero if not in use }
end;
PChain = ^TChain;
TChain = packed record
an_Child : PChain;
an_Parent: PChain;
an_Lock : LongInt;
an_info : TFileInfoBlock;
an_Flags : ShortInt;
an_string: Array[0..0] of char;
end;
PAnchorPath = ^TAnchorPath;
TAnchorPath = packed record
ap_Base : PChain; { pointer to first anchor }
ap_First : PChain; { pointer to last anchor }
ap_BreakBits: LongInt; { Bits we want to break on }
ap_FondBreak: LongInt; { Bits we broke on. Also returns ERROR_BREAK }
ap_Flags : ShortInt; { New use for extra word. }
ap_reserved : Byte;
ap_StrLen : Word;
ap_Info : TFileInfoBlock;
ap_Buf : array[0..0] of Char; { Buffer for path name, allocated by user }
end;
PDOSList = ^TDOSList;
TDOSList = packed record
dol_Next: LongInt; { bptr to next device on list }
dol_Type: LongInt; { see DLT below }
dol_Task: Pointer; { ptr to handler task }
dol_Lock: LongInt;
dol_Misc: array[0..23] of ShortInt;
dol_Name: LongInt; { bptr to bcpl name }
end;
var
MOS_ExecBase : Pointer; external name '_ExecBase';
@ -195,81 +95,6 @@ var
MorphOS functions
*****************************************************************************}
{ 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;
function dos_GetArgStr: PChar; SysCall MOS_DOSBase 534;
function dos_Open(fname: PChar location 'd1';
accessMode: LongInt location 'd2'): LongInt; SysCall MOS_DOSBase 30;
function dos_Close(fileh: LongInt location 'd1'): Boolean; SysCall MOS_DOSBase 36;
function dos_Seek(fileh: LongInt location 'd1';
position: LongInt location 'd2';
posmode: LongInt location 'd3'): LongInt; SysCall MOS_DOSBase 66;
function dos_SetFileSize(fileh: LongInt location 'd1';
position: LongInt location 'd2';
posmode: LongInt location 'd3'): LongInt; SysCall MOS_DOSBase 456;
function dos_Read(fileh: LongInt location 'd1';
buffer: Pointer location 'd2';
length: LongInt location 'd3'): LongInt; SysCall MOS_DOSBase 42;
function dos_Write(fileh: LongInt location 'd1';
buffer: Pointer location 'd2';
length: LongInt location 'd3'): LongInt; SysCall MOS_DOSBase 48;
function dos_WriteChars(buf: PChar location 'd1';
buflen: LongInt location 'd2'): LongInt; SysCall MOS_DOSBase 942;
function dos_Rename(oldName: PChar location 'd1';
newName: PChar location 'd2'): Boolean; SysCall MOS_DOSBase 78;
function dos_DeleteFile(fname: PChar location 'd1'): Boolean; SysCall MOS_DOSBase 72;
function dos_GetCurrentDirName(buf: PChar location 'd1';
len: LongInt location 'd2'): Boolean; SysCall MOS_DOSBase 564;
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_NameFromLock(lock: LongInt location 'd1';
buffer: PChar location 'd2';
len: LongInt location 'd3'): Boolean; SysCall MOS_DOSBase 402;
function dos_Info(lock: LongInt location 'd1';
parameterBlock: PInfoData location 'd2'): Boolean; SysCall MOS_DOSBase 114;
function dos_CreateDir(dname: PChar location 'd1'): LongInt; SysCall MOS_DOSBase 120;
function dos_DateStamp(var ds: TDateStamp location 'd1'): LongInt; SysCall MOS_DOSBase 192;
function dos_SystemTagList(command: PChar location 'd1';
tags: Pointer location 'd2'): LongInt; SysCall MOS_DOSBase 606;
function dos_GetVar(vname: PChar location 'd1';
buffer: PChar location 'd2';
size: LongInt location 'd3';
flags: LongInt location 'd4'): LongInt; SysCall MOS_DOSBase 906;
function dos_MatchFirst(pat: PChar location 'd1';
anchor: PAnchorPath location 'd2'): LongInt; SysCall MOS_DOSBase 822;
function dos_MatchNext(anchor: PAnchorPath location 'd1'): LongInt; SysCall MOS_DOSBase 828;
procedure dos_MatchEnd(anchor: PAnchorPath location 'd1') SysCall MOS_DOSBase 834;
function dos_LockDosList(flags: LongInt location 'd1'): PDOSList; SysCall MOS_DOSBase 654;
procedure dos_UnLockDosList(flags: LongInt location 'd1'); SysCall MOS_DOSBase 660;
function dos_NextDosEntry(dlist: PDOSList location 'd1';
flags: LongInt location 'd2'): PDOSList; SysCall MOS_DOSBase 690;
function dos_SetProtection(name: PChar location 'd1';
mask: LongInt location 'd2'): Boolean; SysCall MOS_DOSBase 186;
function dos_SetFileDate(name: PChar location 'd1';
date: PDateStamp location 'd2'): Boolean; SysCall MOS_DOSBase 396;
function dos_GetProgramDir: LongInt; SysCall MOS_DOSBase 600;
function dos_GetProgramName(buf: PChar location 'd1';
len: LongInt location 'd2'): Boolean; SysCall MOS_DOSBase 576;
{ utility.library functions }
function util_Date2Amiga(date: PClockData location 'a0'): LongInt; SysCall MOS_UtilityBase 126;
@ -289,78 +114,15 @@ implementation
{ exec.library functions }
{$include execf.inc}
{$include doslibf.inc}
{*****************************************************************************
System Dependent Structures/Consts
*****************************************************************************}
{ Errors from dos_IoErr(), etc. }
const
ERROR_NO_FREE_STORE = 103;
ERROR_TASK_TABLE_FULL = 105;
ERROR_BAD_TEMPLATE = 114;
ERROR_BAD_NUMBER = 115;
ERROR_REQUIRED_ARG_MISSING = 116;
ERROR_KEY_NEEDS_ARG = 117;
ERROR_TOO_MANY_ARGS = 118;
ERROR_UNMATCHED_QUOTES = 119;
ERROR_LINE_TOO_LONG = 120;
ERROR_FILE_NOT_OBJECT = 121;
ERROR_INVALID_RESIDENT_LIBRARY = 122;
ERROR_NO_DEFAULT_DIR = 201;
ERROR_OBJECT_IN_USE = 202;
ERROR_OBJECT_EXISTS = 203;
ERROR_DIR_NOT_FOUND = 204;
ERROR_OBJECT_NOT_FOUND = 205;
ERROR_BAD_STREAM_NAME = 206;
ERROR_OBJECT_TOO_LARGE = 207;
ERROR_ACTION_NOT_KNOWN = 209;
ERROR_INVALID_COMPONENT_NAME = 210;
ERROR_INVALID_LOCK = 211;
ERROR_OBJECT_WRONG_TYPE = 212;
ERROR_DISK_NOT_VALIDATED = 213;
ERROR_DISK_WRITE_PROTECTED = 214;
ERROR_RENAME_ACROSS_DEVICES = 215;
ERROR_DIRECTORY_NOT_EMPTY = 216;
ERROR_TOO_MANY_LEVELS = 217;
ERROR_DEVICE_NOT_MOUNTED = 218;
ERROR_SEEK_ERROR = 219;
ERROR_COMMENT_TOO_BIG = 220;
ERROR_DISK_FULL = 221;
ERROR_DELETE_PROTECTED = 222;
ERROR_WRITE_PROTECTED = 223;
ERROR_READ_PROTECTED = 224;
ERROR_NOT_A_DOS_DISK = 225;
ERROR_NO_DISK = 226;
ERROR_NO_MORE_ENTRIES = 232;
{ added for AOS 1.4 }
ERROR_IS_SOFT_LINK = 233;
ERROR_OBJECT_LINKED = 234;
ERROR_BAD_HUNK = 235;
ERROR_NOT_IMPLEMENTED = 236;
ERROR_RECORD_NOT_LOCKED = 240;
ERROR_LOCK_COLLISION = 241;
ERROR_LOCK_TIMEOUT = 242;
ERROR_UNLOCK_ERROR = 243;
{ DOS file offset modes }
const
OFFSET_BEGINNING = -1;
OFFSET_CURRENT = 0;
OFFSET_END = 1;
{ Lock AccessMode }
const
SHARED_LOCK = -2;
ACCESS_READ = SHARED_LOCK;
EXCLUSIVE_LOCK = -1;
ACCESS_WRITE = EXCLUSIVE_LOCK;
const
CTRL_C = 20; { Error code on CTRL-C press }
SIGBREAKF_CTRL_C = $1000; { CTRL-C signal flags }
{*****************************************************************************
@ -393,7 +155,7 @@ begin
tmpHandle:=tmpNext^.handle;
if (tmpHandle<>StdInputHandle) and (tmpHandle<>StdOutputHandle)
and (tmpHandle<>StdErrorHandle) then begin
dos_Close(tmpHandle);
Close2(tmpHandle);
end;
tmpNext:=tmpNext^.next;
end;
@ -568,7 +330,7 @@ var
temp : string;
begin
p:=dos_GetArgStr;
p:=GetArgStr;
argvlen:=0;
{ Set argv[0] }
@ -604,22 +366,22 @@ begin
argc:=localindex;
end;
function GetProgramDir: String;
function GetProgDir: String;
var
s1 : String;
alock : LongInt;
counter: Byte;
begin
GetProgramDir:='';
GetProgDir:='';
FillChar(s1,255,#0);
{ GetLock of program directory }
alock:=dos_GetProgramDir;
alock:=GetProgramDir;
if alock<>0 then begin
if dos_NameFromLock(alock,@s1[1],255) then begin
if NameFromLock(alock,@s1[1],255) then begin
counter:=1;
while (s1[counter]<>#0) and (counter<>0) do Inc(counter);
s1[0]:=Char(counter-1);
GetProgramDir:=s1;
GetProgDir:=s1;
end;
end;
end;
@ -632,7 +394,7 @@ var
begin
GetProgramName:='';
FillChar(s1,255,#0);
if dos_GetProgramName(@s1[1],255) then begin
if GetProgramName(@s1[1],255) then begin
{ now check out and assign the length of the string }
counter := 1;
@ -672,7 +434,7 @@ begin
if MOS_ambMsg<>nil then exit;
if l=0 then begin
s1:=GetProgramDir;
s1:=GetProgDir;
if s1[length(s1)]=':' then paramstr:=s1+GetProgramName
else paramstr:=s1+'/'+GetProgramName;
end else begin
@ -684,7 +446,7 @@ end;
procedure randomize;
var tmpTime: TDateStamp;
begin
dos_DateStamp(tmpTime);
DateStamp(tmpTime);
randseed:=tmpTime.ds_tick;
end;
@ -754,12 +516,12 @@ begin
move(tmpStr[1],buffer,length(tmpStr));
buffer[length(tmpStr)]:=#0;
tmpLock:=dos_CreateDir(buffer);
tmpLock:=CreateDir(buffer);
if tmpLock=0 then begin
dosError2InOut(dos_IoErr);
dosError2InOut(IoErr);
exit;
end;
dos_UnLock(tmpLock);
UnLock(tmpLock);
end;
procedure rmdir(const s : string);[IOCheck];
@ -776,8 +538,8 @@ begin
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);
if not DeleteFile(buffer) then
dosError2InOut(IoErr);
end;
procedure chdir(const s : string);[IOCheck];
@ -812,24 +574,24 @@ begin
{ 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);
alock:=Lock(buffer,SHARED_LOCK);
if alock=0 then begin
dosError2InOut(dos_IoErr);
dosError2InOut(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 (Examine(alock,FIB)=True) and (FIB^.fib_DirEntryType>0) then begin
alock := CurrentDir(alock);
if MOS_OrigDir=0 then begin
MOS_OrigDir:=alock;
alock:=0;
end;
end;
if alock<>0 then dos_Unlock(alock);
if alock<>0 then Unlock(alock);
if assigned(FIB) then dispose(FIB)
end;
@ -838,8 +600,8 @@ var tmpbuf: array[0..255] of char;
begin
checkCTRLC;
Dir:='';
if not dos_GetCurrentDirName(tmpbuf,256) then
dosError2InOut(dos_IoErr)
if not GetCurrentDirName(tmpbuf,256) then
dosError2InOut(IoErr)
else
Dir:=strpas(tmpbuf);
end;
@ -856,22 +618,22 @@ 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
dosError2InOut(dos_IoErr);
if not Close2(handle) then
dosError2InOut(IoErr);
end;
procedure do_erase(p : pchar);
begin
checkCTRLC;
if not dos_DeleteFile(p) then
dosError2InOut(dos_IoErr);
if not DeleteFile(p) then
dosError2InOut(IoErr);
end;
procedure do_rename(p1,p2 : pchar);
begin
checkCTRLC;
if not dos_Rename(p1,p2) then
dosError2InOut(dos_IoErr);
if not Rename2(p1,p2) then
dosError2InOut(IoErr);
end;
function do_write(h:longint; addr: pointer; len: longint) : longint;
@ -881,9 +643,9 @@ begin
do_write:=0;
if len<=0 then exit;
dosResult:=dos_Write(h,addr,len);
dosResult:=Write2(h,addr,len);
if dosResult<0 then begin
dosError2InOut(dos_IoErr);
dosError2InOut(IoErr);
end else begin
do_write:=dosResult;
end;
@ -896,9 +658,9 @@ begin
do_read:=0;
if len<=0 then exit;
dosResult:=dos_Read(h,addr,len);
dosResult:=Read2(h,addr,len);
if dosResult<0 then begin
dosError2InOut(dos_IoErr);
dosError2InOut(IoErr);
end else begin
do_read:=dosResult;
end
@ -911,9 +673,9 @@ begin
do_filepos:=0;
{ Seeking zero from OFFSET_CURRENT to find out where we are }
dosResult:=dos_Seek(handle,0,OFFSET_CURRENT);
dosResult:=Seek2(handle,0,OFFSET_CURRENT);
if dosResult<0 then begin
dosError2InOut(dos_IoErr);
dosError2InOut(IoErr);
end else begin
do_filepos:=dosResult;
end;
@ -923,8 +685,8 @@ procedure do_seek(handle,pos : longint);
begin
checkCTRLC;
{ Seeking from OFFSET_BEGINNING }
if dos_Seek(handle,pos,OFFSET_BEGINNING)<0 then
dosError2InOut(dos_IoErr);
if Seek2(handle,pos,OFFSET_BEGINNING)<0 then
dosError2InOut(IoErr);
end;
function do_seekend(handle:longint):longint;
@ -934,9 +696,9 @@ begin
do_seekend:=0;
{ Seeking to OFFSET_END }
dosResult:=dos_Seek(handle,0,OFFSET_END);
dosResult:=Seek2(handle,0,OFFSET_END);
if dosResult<0 then begin
dosError2InOut(dos_IoErr);
dosError2InOut(IoErr);
end else begin
do_seekend:=dosResult;
end
@ -958,8 +720,8 @@ procedure do_truncate (handle,pos:longint);
begin
checkCTRLC;
{ Seeking from OFFSET_BEGINNING }
if dos_SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
dosError2InOut(dos_IoErr);
if SetFileSize(handle,pos,OFFSET_BEGINNING)<0 then
dosError2InOut(IoErr);
end;
procedure do_open(var f;p:pchar;flags:longint);
@ -1055,10 +817,10 @@ begin
exit;
end;
i:=dos_Open(buffer,openflags);
i:=Open(buffer,openflags);
if i=0 then
begin
dosError2InOut(dos_IoErr);
dosError2InOut(IoErr);
end else begin
AddToList(MOS_fileList,i);
filerec(f).handle:=i;
@ -1121,10 +883,10 @@ begin
if MOS_heapPool=nil then Halt(1);
if MOS_ambMsg=nil then begin
StdInputHandle:=dos_Input;
StdOutputHandle:=dos_Output;
StdInputHandle:=Input2;
StdOutputHandle:=Output2;
end else begin
MOS_ConHandle:=dos_Open(MOS_ConName,1005);
MOS_ConHandle:=Open(MOS_ConName,1005);
if MOS_ConHandle<>0 then begin
StdInputHandle:=MOS_ConHandle;
StdOutputHandle:=MOS_ConHandle;
@ -1178,7 +940,10 @@ end.
{
$Log$
Revision 1.15 2004-06-23 13:27:32 karoly
Revision 1.16 2004-06-26 20:48:24 karoly
* more cleanup + changes to use new includes
Revision 1.15 2004/06/23 13:27:32 karoly
* fixed system unit for the new heap manager
Revision 1.14 2004/06/17 16:16:14 peter