mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 13:59:29 +02:00
+ filehandling complete
+ heaphandling complete + support for random * filehandling now uses filedecriptors in StdCLib * other minor changes - removed DEFINE MAC_SYS_RUNNABLE
This commit is contained in:
olle
parent
615792ffe9
commit
19e0c3eb31
@ -17,50 +17,29 @@ unit System;
|
||||
|
||||
interface
|
||||
|
||||
{If MAC_SYS_RUNABLE is defined, this file can be included in a
|
||||
runnable program, but it then lacks lot of features. If not defined
|
||||
it tries to be faithful to a real system.pp, but it may not be
|
||||
able to assemble and link. The switch is only temporary, and only for
|
||||
use when system.pp is developed.}
|
||||
|
||||
{$Y-}
|
||||
|
||||
{$ifdef MAC_SYS_RUNABLE}
|
||||
|
||||
type
|
||||
integer = -32768 .. 32767;
|
||||
byte =0..255;
|
||||
shortint=-128..127;
|
||||
word=0..65535;
|
||||
longint=+(-$7FFFFFFF-1)..$7FFFFFFF;
|
||||
pchar=^char;
|
||||
|
||||
{$else}
|
||||
|
||||
{At the moment we do not support threadvars}
|
||||
{$undef HASTHREADVAR}
|
||||
|
||||
{ include system-independent routine headers }
|
||||
{$I systemh.inc}
|
||||
|
||||
{$I heaph.inc}
|
||||
|
||||
|
||||
{Platform specific information}
|
||||
const
|
||||
LineEnding = #13;
|
||||
LFNSupport = true;
|
||||
DirectorySeparator = ':';
|
||||
DriveSeparator = ':';
|
||||
PathSeparator = ';';
|
||||
PathSeparator = ','; // Is used in MPW
|
||||
FileNameCaseSensitive = false;
|
||||
|
||||
const
|
||||
UnusedHandle = 0;
|
||||
StdInputHandle = 0;
|
||||
StdOutputHandle = 0;
|
||||
StdErrorHandle = 0;
|
||||
{ include heap support headers }
|
||||
{$I heaph.inc}
|
||||
|
||||
sLineBreak : string[1] = LineEnding;
|
||||
const
|
||||
{ Default filehandles }
|
||||
UnusedHandle : Longint = -1;
|
||||
StdInputHandle : Longint = 0;
|
||||
StdOutputHandle : Longint = 1;
|
||||
StdErrorHandle : Longint = 2;
|
||||
|
||||
sLineBreak = LineEnding;
|
||||
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCR;
|
||||
|
||||
var
|
||||
@ -68,10 +47,16 @@ var
|
||||
argv : ppchar;
|
||||
envp : ppchar;
|
||||
|
||||
{$endif}
|
||||
|
||||
implementation
|
||||
|
||||
{$define MACOS_USE_STDCLIB}
|
||||
|
||||
|
||||
{ include system independent routines }
|
||||
{$I system.inc}
|
||||
|
||||
{*********************** MacOS API *************}
|
||||
|
||||
{TODO: Perhaps the System unit should check the MacOS version to
|
||||
ensure it is a supported version. }
|
||||
|
||||
@ -85,6 +70,7 @@ with FPC types.}
|
||||
|
||||
type
|
||||
SignedByte = shortint;
|
||||
SignedBytePtr = ^SignedByte;
|
||||
OSErr = Integer;
|
||||
OSType = Longint;
|
||||
Mac_Ptr = pointer;
|
||||
@ -92,11 +78,12 @@ type
|
||||
Str31 = string[31];
|
||||
Str32 = string[32];
|
||||
Str63 = string[63];
|
||||
Str255 = string[255];
|
||||
FSSpec = record
|
||||
vRefNum: Integer;
|
||||
parID: Longint;
|
||||
name: Str63;
|
||||
end;
|
||||
end;
|
||||
FSSpecPtr = ^FSSpec;
|
||||
AliasHandle = Mac_Handle;
|
||||
ScriptCode = Integer;
|
||||
@ -113,12 +100,26 @@ external 'InterfaceLib';
|
||||
procedure DisposeHandle(hdl: Mac_Handle);
|
||||
external 'InterfaceLib';
|
||||
|
||||
function Mac_FreeMem: Longint;
|
||||
external 'InterfaceLib' name 'FreeMem';
|
||||
|
||||
procedure Debugger;
|
||||
external 'InterfaceLib';
|
||||
|
||||
procedure DebugStr(s: Str255);
|
||||
external 'InterfaceLib';
|
||||
|
||||
procedure ExitToShell;
|
||||
external 'InterfaceLib';
|
||||
|
||||
procedure SysBeep(dur: Integer);
|
||||
external 'SysBeep';
|
||||
|
||||
function TickCount: Longint;
|
||||
external 'InterfaceLib';
|
||||
|
||||
{$ifndef MACOS_USE_STDCLIB}
|
||||
|
||||
function FSpOpenDF(spec: FSSpec; permission: SignedByte;
|
||||
var refNum: Integer): OSErr;
|
||||
external 'InterfaceLib';
|
||||
@ -157,47 +158,171 @@ function ResolveAlias(fromFile: FSSpecPtr; alias: AliasHandle;
|
||||
var target: FSSpec; var wasChanged: Boolean):OSErr;
|
||||
external 'InterfaceLib';
|
||||
|
||||
{$ifdef MAC_SYS_RUNABLE}
|
||||
|
||||
procedure do_exit;[public,alias:'FPC_DO_EXIT'];
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure fpc_initializeunits;[public,alias:'FPC_INITIALIZEUNITS'];
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
{$else}
|
||||
|
||||
{$I system.inc}
|
||||
{**************** API to StdCLib in MacOS *************}
|
||||
{The reason StdCLib is used is that it can easily be connected
|
||||
to either SIOW or, in case of MPWTOOL, to MPW }
|
||||
|
||||
{*********************** ??????? *************}
|
||||
{The prefix C_ or c_ is used where names conflicts with pascal
|
||||
keywords and names. Suffix Ptr is added for pointer to a type.}
|
||||
|
||||
procedure SysInitStdIO;
|
||||
begin
|
||||
type
|
||||
size_t = Longint;
|
||||
off_t = Longint;
|
||||
C_int = Longint;
|
||||
C_short = Integer;
|
||||
C_long = Longint;
|
||||
C_unsigned_int = Cardinal;
|
||||
|
||||
var
|
||||
errno: C_int; external name 'errno';
|
||||
MacOSErr: C_short; external name 'MacOSErr';
|
||||
|
||||
const
|
||||
_IOFBF = $00;
|
||||
_IOLBF = $40;
|
||||
_IONBF = $04;
|
||||
|
||||
|
||||
O_RDONLY = $00; // Open for reading only.
|
||||
O_WRONLY = $01; // Open for writing only.
|
||||
O_RDWR = $02; // Open for reading & writing.
|
||||
O_APPEND = $08; // Write to the end of the file.
|
||||
O_RSRC = $10; // Open the resource fork.
|
||||
O_ALIAS = $20; // Open alias file.
|
||||
O_CREAT = $100; // Open or create a file.
|
||||
O_TRUNC = $200; // Open and truncate to zero length.
|
||||
O_EXCL = $400; // Create file only; fail if exists.
|
||||
O_BINARY = $800; // Open as a binary stream.
|
||||
O_NRESOLVE = $4000; // Don't resolve any aliases.
|
||||
|
||||
|
||||
SEEK_SET = 0;
|
||||
SEEK_CUR = 1;
|
||||
SEEK_END = 2;
|
||||
|
||||
FIOINTERACTIVE = $00006602; // If device is interactive
|
||||
FIOBUFSIZE = $00006603; // Return optimal buffer size
|
||||
FIOFNAME = $00006604; // Return filename
|
||||
FIOREFNUM = $00006605; // Return fs refnum
|
||||
FIOSETEOF = $00006606; // Set file length
|
||||
|
||||
TIOFLUSH = $00007408; // discard unread input. arg is ignored
|
||||
|
||||
function C_open(path: PChar; oflag: C_int): C_int;
|
||||
external 'StdCLib' name 'open';
|
||||
|
||||
function C_close(filedes: C_int): C_int;
|
||||
external 'StdCLib' name 'close';
|
||||
|
||||
function C_write(filedes: C_int; buf: pointer; nbyte: size_t): size_t;
|
||||
external 'StdCLib' name 'write';
|
||||
|
||||
{??? fread returns only when n items has been read. Does not specifically
|
||||
return after newlines, so cannot be used for reading input from the console.}
|
||||
|
||||
function C_read(filedes: C_int; buf: pointer; nbyte: size_t): size_t;
|
||||
external 'StdCLib' name 'read';
|
||||
|
||||
function lseek(filedes: C_int; offset: off_t; whence: C_int): off_t;
|
||||
external 'StdCLib' name 'lseek';
|
||||
|
||||
function ioctl(filedes: C_int; cmd: C_unsigned_int; arg: pointer): C_int;
|
||||
external 'StdCLib' name 'ioctl';
|
||||
|
||||
function remove(filename: PChar): C_int;
|
||||
external 'StdCLib';
|
||||
|
||||
function c_rename(old, c_new: PChar): C_int;
|
||||
external 'StdCLib' name 'rename';
|
||||
|
||||
procedure c_exit(status: C_int);
|
||||
external 'StdCLib' name 'exit';
|
||||
|
||||
var
|
||||
{Is set to nonzero for MPWTool, zero otherwise.}
|
||||
StandAlone: C_int; external name 'StandAlone';
|
||||
|
||||
CONST
|
||||
|
||||
Sys_EPERM = 1; { No permission match }
|
||||
Sys_ENOENT = 2; { No such file or directory }
|
||||
Sys_ENORSRC = 3; { Resource not found *}
|
||||
Sys_EINTR = 4; { System service interrupted *}
|
||||
Sys_EIO = 5; { I/O error }
|
||||
Sys_ENXIO = 6; { No such device or address }
|
||||
Sys_E2BIG = 7; { Insufficient space for return argument * }
|
||||
Sys_ENOEXEC = 8; { File not executable * }
|
||||
Sys_EBADF = 9; { Bad file number }
|
||||
Sys_ECHILD = 10; { No child processes }
|
||||
Sys_EAGAIN = 11; { Resource temporarily unavailable * }
|
||||
Sys_ENOMEM = 12; { Not enough space * }
|
||||
Sys_EACCES = 13; { Permission denied }
|
||||
Sys_EFAULT = 14; { Illegal filename * }
|
||||
Sys_ENOTBLK = 15; { Block device required }
|
||||
Sys_EBUSY = 16; { Device or resource busy }
|
||||
Sys_EEXIST = 17; { File exists }
|
||||
Sys_EXDEV = 18; { Cross-device link }
|
||||
Sys_ENODEV = 19; { No such device }
|
||||
Sys_ENOTDIR = 20; { Not a directory }
|
||||
Sys_EISDIR = 21; { Is a directory }
|
||||
Sys_EINVAL = 22; { Invalid parameter * }
|
||||
Sys_ENFILE = 23; { File table overflow }
|
||||
Sys_EMFILE = 24; { Too many open files }
|
||||
Sys_ENOTTY = 25; { Not a typewriter }
|
||||
Sys_ETXTBSY = 26; { Text file busy }
|
||||
Sys_EFBIG = 27; { File too large }
|
||||
Sys_ENOSPC = 28; { No space left on device }
|
||||
Sys_ESPIPE = 29; { Illegal seek }
|
||||
Sys_EROFS = 30; { Read-only file system }
|
||||
Sys_EMLINK = 31; { Too many links }
|
||||
Sys_EPIPE = 32; { Broken pipe }
|
||||
Sys_EDOM = 33; { Math argument out of domain of func }
|
||||
Sys_ERANGE = 34; { Math result not representable }
|
||||
|
||||
{ Note * is slightly different, compared to rtl/sunos/errno.inc}
|
||||
|
||||
{$endif}
|
||||
|
||||
|
||||
{******************************************************}
|
||||
|
||||
|
||||
Procedure Errno2InOutRes;
|
||||
{
|
||||
Convert ErrNo error to the correct Inoutres value
|
||||
}
|
||||
|
||||
Begin
|
||||
if errno = 0 then { Else it will go through all the cases }
|
||||
exit;
|
||||
//If errno<0 then Errno:=-errno;
|
||||
case Errno of
|
||||
Sys_ENFILE,
|
||||
Sys_EMFILE : Inoutres:=4;
|
||||
Sys_ENOENT : Inoutres:=2;
|
||||
Sys_EBADF : Inoutres:=6;
|
||||
Sys_ENOMEM,
|
||||
Sys_EFAULT : Inoutres:=217;
|
||||
Sys_EINVAL : Inoutres:=218;
|
||||
Sys_EPIPE,
|
||||
Sys_EINTR,
|
||||
Sys_EIO,
|
||||
Sys_EAGAIN,
|
||||
Sys_ENOSPC : Inoutres:=101;
|
||||
Sys_ENOTDIR : Inoutres:=3;
|
||||
Sys_EROFS,
|
||||
Sys_EEXIST,
|
||||
Sys_EISDIR,
|
||||
Sys_EACCES : Inoutres:=5;
|
||||
Sys_ETXTBSY : Inoutres:=162;
|
||||
else
|
||||
InOutRes := Integer(errno);
|
||||
end;
|
||||
errno:=0;
|
||||
end;
|
||||
|
||||
{*****************************************************************************}
|
||||
|
||||
procedure setup_arguments;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure setup_environment;
|
||||
begin
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
System Dependent Exit code
|
||||
*****************************************************************************}
|
||||
Procedure system_exit;
|
||||
begin
|
||||
ExitToShell;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
ParamStr/Randomize
|
||||
*****************************************************************************}
|
||||
@ -213,31 +338,26 @@ end;
|
||||
function paramstr(l : longint) : string;
|
||||
begin
|
||||
{if (l>=0) and (l+1<=argc) then
|
||||
paramstr:=strpas(argv[l])
|
||||
paramstr:=strpas(argv[l])
|
||||
else}
|
||||
paramstr:='';
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
{ set randseed to a new pseudo random value }
|
||||
procedure randomize;
|
||||
begin
|
||||
{regs.realeax:=$2c00;
|
||||
sysrealintr($21,regs);
|
||||
hl:=regs.realedx and $ffff;
|
||||
randseed:=hl*$10000+ (regs.realecx and $ffff);}
|
||||
randseed:=0;
|
||||
randseed:= Cardinal(TickCount);
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
Heap Management
|
||||
*****************************************************************************}
|
||||
const
|
||||
theHeapSize = 300000; //TODO: Use heapsize set by user.
|
||||
|
||||
var
|
||||
{ Pointer to a block allocated with the MacOS Memory Manager, which
|
||||
is used as the FPC heap }
|
||||
is used as the initial FPC heap. }
|
||||
theHeap: Mac_Ptr;
|
||||
intern_heapsize : longint;external name 'HEAPSIZE';
|
||||
|
||||
{ first address of heap }
|
||||
function getheapstart:pointer;
|
||||
@ -248,107 +368,189 @@ end;
|
||||
{ current length of heap }
|
||||
function getheapsize:longint;
|
||||
begin
|
||||
getheapsize:= theHeapSize ;
|
||||
getheapsize:= intern_heapsize ;
|
||||
end;
|
||||
|
||||
{ function to allocate size bytes more for the program }
|
||||
{ must return the first address of new data space or -1 if fail }
|
||||
function Sbrk(size : longint):longint;
|
||||
|
||||
var
|
||||
p: Mac_Ptr;
|
||||
|
||||
begin
|
||||
Sbrk:=-1; //TODO: Allow heap increase.
|
||||
p:= NewPtr(size);
|
||||
if p = nil then
|
||||
Sbrk:= -1 //Tell its failed
|
||||
else
|
||||
Sbrk:= longint(p)
|
||||
end;
|
||||
|
||||
{ include standard heap management }
|
||||
{$I heap.inc}
|
||||
|
||||
{****************************************************************************
|
||||
Low level File Routines
|
||||
All these functions can set InOutRes on errors
|
||||
{*****************************************************************************
|
||||
Low Level File Routines
|
||||
****************************************************************************}
|
||||
|
||||
{ close a file from the handle value }
|
||||
procedure do_close(handle : longint);
|
||||
function do_isdevice(handle:longint):boolean;
|
||||
begin
|
||||
do_isdevice:=false;
|
||||
end;
|
||||
|
||||
{ close a file from the handle value }
|
||||
procedure do_close(h : longint);
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
C_close(h);
|
||||
Errno2InOutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if handle = UnusedHandle then exit;
|
||||
if FSClose(handle) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
if FSClose(h) = noErr then
|
||||
InOutRes:=0;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure do_erase(p : pchar);
|
||||
begin
|
||||
InOutRes:=1;
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
remove(p);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure do_rename(p1,p2 : pchar);
|
||||
begin
|
||||
InOutRes:=1;
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
c_rename(p1,p2);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_write(h,addr,len : longint) : longint;
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
do_write:= C_write(h, pointer(addr), len);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if h = UnusedHandle then exit;
|
||||
if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
InOutRes:=0;
|
||||
do_write:= len;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_read(h,addr,len : longint) : longint;
|
||||
|
||||
var
|
||||
i: Longint;
|
||||
|
||||
begin
|
||||
InOutRes:=1;
|
||||
if h = UnusedHandle then exit;
|
||||
if FSread(h, len, Mac_Ptr(addr)) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
len:= C_read(h, pointer(addr), len);
|
||||
Errno2InoutRes;
|
||||
|
||||
// TEMP BUGFIX Exchange CR to LF.
|
||||
for i:= 0 to len-1 do
|
||||
if SignedBytePtr(ord(addr) + i)^ = 13 then
|
||||
SignedBytePtr(ord(addr) + i)^ := 10;
|
||||
|
||||
do_read:= len;
|
||||
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if FSread(h, len, Mac_Ptr(addr)) = noErr then
|
||||
InOutRes:=0;
|
||||
do_read:= len;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_filepos(handle : longint) : longint;
|
||||
|
||||
var
|
||||
pos: Longint;
|
||||
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
{This returns the filepos without moving it.}
|
||||
do_filepos := lseek(handle, 0, SEEK_CUR);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if handle = UnusedHandle then exit;
|
||||
if GetFPos(handle, pos) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
InOutRes:=0;
|
||||
do_filepos:= pos;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure do_seek(handle,pos : longint);
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
lseek(handle, pos, SEEK_SET);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if handle = UnusedHandle then exit;
|
||||
if SetFPos(handle, fsFromStart, pos) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
InOutRes:=0;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_seekend(handle:longint):longint;
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
lseek(handle, 0, SEEK_END);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if handle = UnusedHandle then exit;
|
||||
if SetFPos(handle, fsFromLEOF, 0) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
InOutRes:=0;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_filesize(handle : longint) : longint;
|
||||
|
||||
var
|
||||
pos: Longint;
|
||||
aktfilepos: Longint;
|
||||
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
aktfilepos:= lseek(handle, 0, SEEK_CUR);
|
||||
if errno = 0 then
|
||||
begin
|
||||
do_filesize := lseek(handle, 0, SEEK_END);
|
||||
Errno2InOutRes; {Report the error from this operation.}
|
||||
lseek(handle, aktfilepos, SEEK_SET); {Always try to move back,
|
||||
even in presence of error.}
|
||||
end
|
||||
else
|
||||
Errno2InOutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if handle = UnusedHandle then exit;
|
||||
if GetEOF(handle, pos) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
InOutRes:=0;
|
||||
do_filesize:= pos;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{ truncate at a given position }
|
||||
procedure do_truncate (handle,pos:longint);
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
ioctl(handle, FIOSETEOF, pointer(pos));
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
do_seek(handle,pos); //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
|
||||
if SetEOF(handle, pos) = noErr then
|
||||
InOutRes:=0; //TODO: Is this right ?
|
||||
InOutRes:=0;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
{$ifndef MACOS_USE_STDCLIB}
|
||||
function FSpLocationFromFullPath(fullPathLength: Integer;
|
||||
fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
|
||||
|
||||
@ -366,17 +568,18 @@ begin
|
||||
begin
|
||||
res:= ResolveAlias(nil, alias, spec, wasChanged);
|
||||
DisposeHandle(Mac_Handle(alias));
|
||||
end;
|
||||
end;
|
||||
FSpLocationFromFullPath:= res;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure do_open(var f;p:pchar;flags:longint);
|
||||
{
|
||||
filerec and textrec have both handle and mode as the first items so
|
||||
they could use the same routine for opening/creating.
|
||||
when (flags and $10) the file will be append
|
||||
when (flags and $100) the file will be truncate/rewritten
|
||||
when (flags and $1000) there is no check for close (needed for textfiles)
|
||||
when (flags and $100) the file will be append
|
||||
when (flags and $1000) the file will be truncate/rewritten
|
||||
when (flags and $10000) there is no check for close (needed for textfiles)
|
||||
}
|
||||
|
||||
var
|
||||
@ -386,11 +589,87 @@ var
|
||||
refNum: Integer;
|
||||
res: OSErr;
|
||||
|
||||
const
|
||||
fh: Longint;
|
||||
|
||||
oflags : longint;
|
||||
|
||||
Const
|
||||
fsCurPerm = 0;
|
||||
smSystemScript = -1;
|
||||
|
||||
begin
|
||||
// AllowSlash(p);
|
||||
|
||||
{ close first if opened }
|
||||
if ((flags and $10000)=0) then
|
||||
begin
|
||||
case filerec(f).mode of
|
||||
fminput,fmoutput,fminout : Do_Close(filerec(f).handle);
|
||||
fmclosed : ;
|
||||
else
|
||||
begin
|
||||
{not assigned}
|
||||
inoutres:=102;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ reset file handle }
|
||||
filerec(f).handle:=UnusedHandle;
|
||||
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
|
||||
{ We do the conversion of filemodes here, concentrated on 1 place }
|
||||
case (flags and 3) of
|
||||
0 : begin
|
||||
oflags :=O_RDONLY;
|
||||
filerec(f).mode:=fminput;
|
||||
end;
|
||||
1 : begin
|
||||
oflags :=O_WRONLY;
|
||||
filerec(f).mode:=fmoutput;
|
||||
end;
|
||||
2 : begin
|
||||
oflags :=O_RDWR;
|
||||
filerec(f).mode:=fminout;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (flags and $1000)=$1000 then
|
||||
oflags:=oflags or (O_CREAT or O_TRUNC)
|
||||
else if (flags and $100)=$100 then
|
||||
oflags:=oflags or (O_APPEND);
|
||||
|
||||
{ empty name is special }
|
||||
if p[0]=#0 then
|
||||
begin
|
||||
case FileRec(f).mode of
|
||||
fminput :
|
||||
FileRec(f).Handle:=StdInputHandle;
|
||||
fminout, { this is set by rewrite }
|
||||
fmoutput :
|
||||
FileRec(f).Handle:=StdOutputHandle;
|
||||
fmappend :
|
||||
begin
|
||||
FileRec(f).Handle:=StdOutputHandle;
|
||||
FileRec(f).mode:=fmoutput; {fool fmappend}
|
||||
end;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
|
||||
fh:= C_open(p, oflags);
|
||||
|
||||
//TODO Perhaps handle readonly filesystems, as in sysunix.inc
|
||||
Errno2InOutRes;
|
||||
if fh <> -1 then
|
||||
filerec(f).handle:= fh
|
||||
else
|
||||
filerec(f).handle:= UnusedHandle;
|
||||
|
||||
{$else}
|
||||
|
||||
InOutRes:=1;
|
||||
//creator:= $522A6368; {'MPS ' -- MPW}
|
||||
//creator:= $74747874; {'ttxt'}
|
||||
@ -402,7 +681,7 @@ begin
|
||||
|
||||
res:= FSpLocationFromFullPath(StrLen(p), p, spec);
|
||||
if (res = noErr) or (res = fnfErr) then
|
||||
begin
|
||||
begin
|
||||
if FSpCreate(spec, creator, fileType, smSystemScript) = noErr then
|
||||
;
|
||||
|
||||
@ -410,7 +689,7 @@ begin
|
||||
begin
|
||||
filerec(f).handle:= refNum;
|
||||
InOutRes:=0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (filerec(f).handle=UnusedHandle) then
|
||||
@ -418,12 +697,9 @@ begin
|
||||
//errno:=GetLastError;
|
||||
//Errno2InoutRes;
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function do_isdevice(handle:longint):boolean;
|
||||
begin
|
||||
do_isdevice:=false;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
@ -450,17 +726,17 @@ end;
|
||||
{*****************************************************************************
|
||||
Directory Handling
|
||||
*****************************************************************************}
|
||||
procedure mkdir(const s : string);[IOCheck];
|
||||
procedure mkdir(const s:string);[IOCheck];
|
||||
begin
|
||||
InOutRes:=1;
|
||||
end;
|
||||
|
||||
procedure rmdir(const s : string);[IOCheck];
|
||||
procedure rmdir(const s:string);[IOCheck];
|
||||
begin
|
||||
InOutRes:=1;
|
||||
end;
|
||||
|
||||
procedure chdir(const s : string);[IOCheck];
|
||||
procedure chdir(const s:string);[IOCheck];
|
||||
begin
|
||||
InOutRes:=1;
|
||||
end;
|
||||
@ -475,38 +751,86 @@ end;
|
||||
SystemUnit Initialization
|
||||
*****************************************************************************}
|
||||
|
||||
Begin
|
||||
procedure setup_arguments;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure setup_environment;
|
||||
begin
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
System Dependent Exit code
|
||||
*****************************************************************************}
|
||||
|
||||
Procedure system_exit;
|
||||
begin
|
||||
{$ifndef MACOS_USE_STDCLIB}
|
||||
if StandAlone <> 0 then
|
||||
ExitToShell;
|
||||
{$else}
|
||||
c_exit(exitcode); //exitcode is only utilized by an MPW tool
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure SysInitStdIO;
|
||||
begin
|
||||
{ Setup stdin, stdout and stderr }
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
OpenStdIO(Input,fmInput,StdInputHandle);
|
||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
||||
OpenStdIO(StdErr,fmOutput,StdErrorHandle);
|
||||
{$endif }
|
||||
end;
|
||||
|
||||
begin
|
||||
if false then //To save it from the dead code stripper
|
||||
Debugger; //Included only to make it available for debugging
|
||||
|
||||
{ To be set if this is a GUI or console application }
|
||||
begin
|
||||
//Included only to make them available for debugging in asm.
|
||||
Debugger;
|
||||
DebugStr('');
|
||||
end;
|
||||
{ To be set if this is a GUI or console application }
|
||||
IsConsole := TRUE;
|
||||
{ To be set if this is a library and not a program }
|
||||
IsLibrary := FALSE;
|
||||
|
||||
StackLength := InitialStkLen;
|
||||
StackBottom := SPtr - StackLength;
|
||||
ExitCode := 0;
|
||||
{ Setup heap }
|
||||
theHeap:= NewPtr(theHeapSize);
|
||||
|
||||
{ Setup heap }
|
||||
if Mac_FreeMem - intern_heapsize < 30000 then
|
||||
Halt(3);
|
||||
theHeap:= NewPtr(intern_heapsize);
|
||||
if theHeap = nil then
|
||||
Halt(3); //According to MPW
|
||||
InitHeap;
|
||||
{ Setup stdin, stdout and stderr }
|
||||
(* OpenStdIO(Input,fmInput,StdInputHandle);
|
||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
||||
OpenStdIO(StdErr,fmOutput,StdErrorHandle);*)
|
||||
{ Setup environment and arguments }
|
||||
SysInitStdIO;
|
||||
|
||||
{ Setup environment and arguments }
|
||||
Setup_Environment;
|
||||
Setup_Arguments;
|
||||
{ Reset IO Error }
|
||||
setup_arguments;
|
||||
{ Reset IO Error }
|
||||
InOutRes:=0;
|
||||
|
||||
{$endif}
|
||||
|
||||
End.
|
||||
errno:=0;
|
||||
{$ifdef HASVARIANT}
|
||||
initvariantmanager;
|
||||
{$endif HASVARIANT}
|
||||
end.
|
||||
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2003-01-13 17:18:55 olle
|
||||
Revision 1.6 2003-09-12 12:45:15 olle
|
||||
+ filehandling complete
|
||||
+ heaphandling complete
|
||||
+ support for random
|
||||
* filehandling now uses filedecriptors in StdCLib
|
||||
* other minor changes
|
||||
- removed DEFINE MAC_SYS_RUNNABLE
|
||||
|
||||
Revision 1.5 2003/01/13 17:18:55 olle
|
||||
+ added support for rudimentary file handling
|
||||
|
||||
Revision 1.4 2002/11/28 10:58:02 olle
|
||||
@ -523,4 +847,4 @@ End.
|
||||
|
||||
Revision 1.1 2002/10/02 21:34:31 florian
|
||||
* first dummy implementation
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user