1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Free Pascal development team
This file implements all the base types and limits required
for a minimal POSIX compliant subset required to port the compiler
to a new OS.
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ * Turn on AmigaOS4 mode on PowerPC * }
{$IFDEF CPUPOWERPC}
{$DEFINE AMIGAOS4}
{$ENDIF}
{*****************************************************************************
AmigaOS structures
*****************************************************************************}
{$include execd.inc}
{$include timerd.inc}
{$include doslibd.inc}
{*****************************************************************************
AmigaOS functions
*****************************************************************************}
{ exec.library functions }
{$include execf.inc}
{$include doslibf.inc}
{$IFDEF AMIGAOS4}
// Required to allow opening of utility library interface...
{$include utilf.inc}
{$ENDIF}
{*****************************************************************************
System Dependent Structures/Consts
*****************************************************************************}
const
CTRL_C = 20; { Error code on CTRL-C press }
{ Used for CTRL_C checking in I/O calls }
procedure checkCTRLC;
begin
if BreakOn then begin
if (SetSignal(0,0) And SIGBREAKF_CTRL_C)<>0 then begin
{ Clear CTRL-C signal }
SetSignal(0,SIGBREAKF_CTRL_C);
Halt(CTRL_C);
end;
end;
end;
{ Converts a AmigaOS dos.library error code to a TP compatible error code }
{ Based on 1.0.x Amiga RTL }
procedure dosError2InOut(errno: LongInt);
begin
case errno of
ERROR_BAD_NUMBER,
ERROR_ACTION_NOT_KNOWN,
ERROR_NOT_IMPLEMENTED : InOutRes := 1;
ERROR_OBJECT_NOT_FOUND : InOutRes := 2;
ERROR_DIR_NOT_FOUND : InOutRes := 3;
ERROR_DISK_WRITE_PROTECTED : InOutRes := 150;
ERROR_OBJECT_WRONG_TYPE : InOutRes := 151;
ERROR_OBJECT_EXISTS,
ERROR_DELETE_PROTECTED,
ERROR_WRITE_PROTECTED,
ERROR_READ_PROTECTED,
ERROR_OBJECT_IN_USE,
ERROR_DIRECTORY_NOT_EMPTY : InOutRes := 5;
ERROR_NO_MORE_ENTRIES : InOutRes := 18;
ERROR_RENAME_ACROSS_DEVICES : InOutRes := 17;
ERROR_DISK_FULL : InOutRes := 101;
ERROR_INVALID_RESIDENT_LIBRARY : InoutRes := 153;
ERROR_BAD_HUNK : InOutRes := 153;
ERROR_NOT_A_DOS_DISK : InOutRes := 157;
ERROR_NO_DISK,
ERROR_DISK_NOT_VALIDATED,
ERROR_DEVICE_NOT_MOUNTED : InOutRes := 152;
ERROR_SEEK_ERROR : InOutRes := 156;
ERROR_LOCK_COLLISION,
ERROR_LOCK_TIMEOUT,
ERROR_UNLOCK_ERROR,
ERROR_INVALID_LOCK,
ERROR_INVALID_COMPONENT_NAME,
ERROR_BAD_STREAM_NAME,
ERROR_FILE_NOT_OBJECT : InOutRes := 6;
else
InOutRes := errno;
end;
end;
{ Converts an Unix-like path to Amiga-like path }
function PathConv(path: string): string; alias: 'PATHCONV'; [public];
var tmppos: longint;
begin
{ check for short paths }
if length(path)<=2 then begin
if (path='.') or (path='./') then path:='' else
if path='..' then path:='/' else
if path='*' then path:='#?';
end else begin
{ convert parent directories }
tmppos:=pos('../',path);
while tmppos<>0 do begin
{ delete .. to have / as parent dir sign }
delete(path,tmppos,2);
tmppos:=pos('../',path);
end;
{ convert current directories }
tmppos:=pos('./',path);
while tmppos<>0 do begin
{ delete ./ since we doesn't need to sign current directory }
delete(path,tmppos,2);
tmppos:=pos('./',path);
end;
{ convert wildstart to #? }
tmppos:=pos('*',path);
while tmppos<>0 do begin
delete(path,tmppos,1);
insert('#?',path,tmppos);
tmppos:=pos('*',path);
end;
end;
PathConv:=path;
end;
|
