← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to rtl/morphos/sysos.inc

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

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