mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 00:46:02 +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:
parent
615792ffe9
commit
19e0c3eb31
@ -17,50 +17,29 @@ unit System;
|
|||||||
|
|
||||||
interface
|
interface
|
||||||
|
|
||||||
{If MAC_SYS_RUNABLE is defined, this file can be included in a
|
{ include system-independent routine headers }
|
||||||
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}
|
|
||||||
|
|
||||||
{$I systemh.inc}
|
{$I systemh.inc}
|
||||||
|
|
||||||
{$I heaph.inc}
|
|
||||||
|
|
||||||
|
|
||||||
{Platform specific information}
|
{Platform specific information}
|
||||||
const
|
const
|
||||||
LineEnding = #13;
|
LineEnding = #13;
|
||||||
LFNSupport = true;
|
LFNSupport = true;
|
||||||
DirectorySeparator = ':';
|
DirectorySeparator = ':';
|
||||||
DriveSeparator = ':';
|
DriveSeparator = ':';
|
||||||
PathSeparator = ';';
|
PathSeparator = ','; // Is used in MPW
|
||||||
FileNameCaseSensitive = false;
|
FileNameCaseSensitive = false;
|
||||||
|
|
||||||
const
|
{ include heap support headers }
|
||||||
UnusedHandle = 0;
|
{$I heaph.inc}
|
||||||
StdInputHandle = 0;
|
|
||||||
StdOutputHandle = 0;
|
|
||||||
StdErrorHandle = 0;
|
|
||||||
|
|
||||||
sLineBreak : string[1] = LineEnding;
|
const
|
||||||
|
{ Default filehandles }
|
||||||
|
UnusedHandle : Longint = -1;
|
||||||
|
StdInputHandle : Longint = 0;
|
||||||
|
StdOutputHandle : Longint = 1;
|
||||||
|
StdErrorHandle : Longint = 2;
|
||||||
|
|
||||||
|
sLineBreak = LineEnding;
|
||||||
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCR;
|
DefaultTextLineBreakStyle : TTextLineBreakStyle = tlbsCR;
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -68,10 +47,16 @@ var
|
|||||||
argv : ppchar;
|
argv : ppchar;
|
||||||
envp : ppchar;
|
envp : ppchar;
|
||||||
|
|
||||||
{$endif}
|
|
||||||
|
|
||||||
implementation
|
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
|
{TODO: Perhaps the System unit should check the MacOS version to
|
||||||
ensure it is a supported version. }
|
ensure it is a supported version. }
|
||||||
|
|
||||||
@ -85,6 +70,7 @@ with FPC types.}
|
|||||||
|
|
||||||
type
|
type
|
||||||
SignedByte = shortint;
|
SignedByte = shortint;
|
||||||
|
SignedBytePtr = ^SignedByte;
|
||||||
OSErr = Integer;
|
OSErr = Integer;
|
||||||
OSType = Longint;
|
OSType = Longint;
|
||||||
Mac_Ptr = pointer;
|
Mac_Ptr = pointer;
|
||||||
@ -92,6 +78,7 @@ type
|
|||||||
Str31 = string[31];
|
Str31 = string[31];
|
||||||
Str32 = string[32];
|
Str32 = string[32];
|
||||||
Str63 = string[63];
|
Str63 = string[63];
|
||||||
|
Str255 = string[255];
|
||||||
FSSpec = record
|
FSSpec = record
|
||||||
vRefNum: Integer;
|
vRefNum: Integer;
|
||||||
parID: Longint;
|
parID: Longint;
|
||||||
@ -113,12 +100,26 @@ external 'InterfaceLib';
|
|||||||
procedure DisposeHandle(hdl: Mac_Handle);
|
procedure DisposeHandle(hdl: Mac_Handle);
|
||||||
external 'InterfaceLib';
|
external 'InterfaceLib';
|
||||||
|
|
||||||
|
function Mac_FreeMem: Longint;
|
||||||
|
external 'InterfaceLib' name 'FreeMem';
|
||||||
|
|
||||||
procedure Debugger;
|
procedure Debugger;
|
||||||
external 'InterfaceLib';
|
external 'InterfaceLib';
|
||||||
|
|
||||||
|
procedure DebugStr(s: Str255);
|
||||||
|
external 'InterfaceLib';
|
||||||
|
|
||||||
procedure ExitToShell;
|
procedure ExitToShell;
|
||||||
external 'InterfaceLib';
|
external 'InterfaceLib';
|
||||||
|
|
||||||
|
procedure SysBeep(dur: Integer);
|
||||||
|
external 'SysBeep';
|
||||||
|
|
||||||
|
function TickCount: Longint;
|
||||||
|
external 'InterfaceLib';
|
||||||
|
|
||||||
|
{$ifndef MACOS_USE_STDCLIB}
|
||||||
|
|
||||||
function FSpOpenDF(spec: FSSpec; permission: SignedByte;
|
function FSpOpenDF(spec: FSSpec; permission: SignedByte;
|
||||||
var refNum: Integer): OSErr;
|
var refNum: Integer): OSErr;
|
||||||
external 'InterfaceLib';
|
external 'InterfaceLib';
|
||||||
@ -157,47 +158,171 @@ function ResolveAlias(fromFile: FSSpecPtr; alias: AliasHandle;
|
|||||||
var target: FSSpec; var wasChanged: Boolean):OSErr;
|
var target: FSSpec; var wasChanged: Boolean):OSErr;
|
||||||
external 'InterfaceLib';
|
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}
|
{$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;
|
type
|
||||||
begin
|
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;
|
end;
|
||||||
|
|
||||||
{*****************************************************************************}
|
|
||||||
|
|
||||||
procedure setup_arguments;
|
|
||||||
begin
|
|
||||||
end;
|
|
||||||
|
|
||||||
procedure setup_environment;
|
|
||||||
begin
|
|
||||||
end;
|
|
||||||
|
|
||||||
{*****************************************************************************
|
|
||||||
System Dependent Exit code
|
|
||||||
*****************************************************************************}
|
|
||||||
Procedure system_exit;
|
|
||||||
begin
|
|
||||||
ExitToShell;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
ParamStr/Randomize
|
ParamStr/Randomize
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
@ -221,23 +346,18 @@ end;
|
|||||||
{ set randseed to a new pseudo random value }
|
{ set randseed to a new pseudo random value }
|
||||||
procedure randomize;
|
procedure randomize;
|
||||||
begin
|
begin
|
||||||
{regs.realeax:=$2c00;
|
randseed:= Cardinal(TickCount);
|
||||||
sysrealintr($21,regs);
|
|
||||||
hl:=regs.realedx and $ffff;
|
|
||||||
randseed:=hl*$10000+ (regs.realecx and $ffff);}
|
|
||||||
randseed:=0;
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
Heap Management
|
Heap Management
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
const
|
|
||||||
theHeapSize = 300000; //TODO: Use heapsize set by user.
|
|
||||||
|
|
||||||
var
|
var
|
||||||
{ Pointer to a block allocated with the MacOS Memory Manager, which
|
{ 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;
|
theHeap: Mac_Ptr;
|
||||||
|
intern_heapsize : longint;external name 'HEAPSIZE';
|
||||||
|
|
||||||
{ first address of heap }
|
{ first address of heap }
|
||||||
function getheapstart:pointer;
|
function getheapstart:pointer;
|
||||||
@ -248,107 +368,189 @@ end;
|
|||||||
{ current length of heap }
|
{ current length of heap }
|
||||||
function getheapsize:longint;
|
function getheapsize:longint;
|
||||||
begin
|
begin
|
||||||
getheapsize:= theHeapSize ;
|
getheapsize:= intern_heapsize ;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ function to allocate size bytes more for the program }
|
{ function to allocate size bytes more for the program }
|
||||||
{ must return the first address of new data space or -1 if fail }
|
{ must return the first address of new data space or -1 if fail }
|
||||||
function Sbrk(size : longint):longint;
|
function Sbrk(size : longint):longint;
|
||||||
|
|
||||||
|
var
|
||||||
|
p: Mac_Ptr;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Sbrk:=-1; //TODO: Allow heap increase.
|
p:= NewPtr(size);
|
||||||
|
if p = nil then
|
||||||
|
Sbrk:= -1 //Tell its failed
|
||||||
|
else
|
||||||
|
Sbrk:= longint(p)
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ include standard heap management }
|
||||||
{$I heap.inc}
|
{$I heap.inc}
|
||||||
|
|
||||||
{****************************************************************************
|
{*****************************************************************************
|
||||||
Low level File Routines
|
Low Level File Routines
|
||||||
All these functions can set InOutRes on errors
|
|
||||||
****************************************************************************}
|
****************************************************************************}
|
||||||
|
|
||||||
{ close a file from the handle value }
|
function do_isdevice(handle:longint):boolean;
|
||||||
procedure do_close(handle : longint);
|
|
||||||
begin
|
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;
|
InOutRes:=1;
|
||||||
if handle = UnusedHandle then exit;
|
if FSClose(h) = noErr then
|
||||||
if FSClose(handle) = noErr then
|
InOutRes:=0;
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure do_erase(p : pchar);
|
procedure do_erase(p : pchar);
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
remove(p);
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure do_rename(p1,p2 : pchar);
|
procedure do_rename(p1,p2 : pchar);
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
c_rename(p1,p2);
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function do_write(h,addr,len : longint) : longint;
|
function do_write(h,addr,len : longint) : longint;
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
do_write:= C_write(h, pointer(addr), len);
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
if h = UnusedHandle then exit;
|
|
||||||
if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
|
if FSWrite(h, len, Mac_Ptr(addr)) = noErr then
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
InOutRes:=0;
|
||||||
do_write:= len;
|
do_write:= len;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function do_read(h,addr,len : longint) : longint;
|
function do_read(h,addr,len : longint) : longint;
|
||||||
|
|
||||||
|
var
|
||||||
|
i: Longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
InOutRes:=1;
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
if h = UnusedHandle then exit;
|
len:= C_read(h, pointer(addr), len);
|
||||||
if FSread(h, len, Mac_Ptr(addr)) = noErr then
|
Errno2InoutRes;
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
|
||||||
|
// 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;
|
do_read:= len;
|
||||||
|
|
||||||
|
{$else}
|
||||||
|
InOutRes:=1;
|
||||||
|
if FSread(h, len, Mac_Ptr(addr)) = noErr then
|
||||||
|
InOutRes:=0;
|
||||||
|
do_read:= len;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function do_filepos(handle : longint) : longint;
|
function do_filepos(handle : longint) : longint;
|
||||||
|
|
||||||
var
|
var
|
||||||
pos: Longint;
|
pos: Longint;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
{This returns the filepos without moving it.}
|
||||||
|
do_filepos := lseek(handle, 0, SEEK_CUR);
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
if handle = UnusedHandle then exit;
|
|
||||||
if GetFPos(handle, pos) = noErr then
|
if GetFPos(handle, pos) = noErr then
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
InOutRes:=0;
|
||||||
do_filepos:= pos;
|
do_filepos:= pos;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure do_seek(handle,pos : longint);
|
procedure do_seek(handle,pos : longint);
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
lseek(handle, pos, SEEK_SET);
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
if handle = UnusedHandle then exit;
|
|
||||||
if SetFPos(handle, fsFromStart, pos) = noErr then
|
if SetFPos(handle, fsFromStart, pos) = noErr then
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
InOutRes:=0;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function do_seekend(handle:longint):longint;
|
function do_seekend(handle:longint):longint;
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
lseek(handle, 0, SEEK_END);
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
if handle = UnusedHandle then exit;
|
|
||||||
if SetFPos(handle, fsFromLEOF, 0) = noErr then
|
if SetFPos(handle, fsFromLEOF, 0) = noErr then
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
InOutRes:=0;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function do_filesize(handle : longint) : longint;
|
function do_filesize(handle : longint) : longint;
|
||||||
|
|
||||||
var
|
var
|
||||||
pos: Longint;
|
aktfilepos: Longint;
|
||||||
|
|
||||||
begin
|
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;
|
InOutRes:=1;
|
||||||
if handle = UnusedHandle then exit;
|
|
||||||
if GetEOF(handle, pos) = noErr then
|
if GetEOF(handle, pos) = noErr then
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
InOutRes:=0;
|
||||||
do_filesize:= pos;
|
do_filesize:= pos;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ truncate at a given position }
|
{ truncate at a given position }
|
||||||
procedure do_truncate (handle,pos:longint);
|
procedure do_truncate (handle,pos:longint);
|
||||||
begin
|
begin
|
||||||
|
{$ifdef MACOS_USE_STDCLIB}
|
||||||
|
ioctl(handle, FIOSETEOF, pointer(pos));
|
||||||
|
Errno2InoutRes;
|
||||||
|
{$else}
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
do_seek(handle,pos); //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
|
do_seek(handle,pos); //TODO: Is this needed (Does the user anticipate the filemarker is at the end?)
|
||||||
if SetEOF(handle, pos) = noErr then
|
if SetEOF(handle, pos) = noErr then
|
||||||
InOutRes:=0; //TODO: Is this right ?
|
InOutRes:=0;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$ifndef MACOS_USE_STDCLIB}
|
||||||
function FSpLocationFromFullPath(fullPathLength: Integer;
|
function FSpLocationFromFullPath(fullPathLength: Integer;
|
||||||
fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
|
fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
|
||||||
|
|
||||||
@ -366,17 +568,18 @@ begin
|
|||||||
begin
|
begin
|
||||||
res:= ResolveAlias(nil, alias, spec, wasChanged);
|
res:= ResolveAlias(nil, alias, spec, wasChanged);
|
||||||
DisposeHandle(Mac_Handle(alias));
|
DisposeHandle(Mac_Handle(alias));
|
||||||
end;
|
end;
|
||||||
FSpLocationFromFullPath:= res;
|
FSpLocationFromFullPath:= res;
|
||||||
end;
|
end;
|
||||||
|
{$endif}
|
||||||
|
|
||||||
procedure do_open(var f;p:pchar;flags:longint);
|
procedure do_open(var f;p:pchar;flags:longint);
|
||||||
{
|
{
|
||||||
filerec and textrec have both handle and mode as the first items so
|
filerec and textrec have both handle and mode as the first items so
|
||||||
they could use the same routine for opening/creating.
|
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 append
|
||||||
when (flags and $100) the file will be truncate/rewritten
|
when (flags and $1000) the file will be truncate/rewritten
|
||||||
when (flags and $1000) there is no check for close (needed for textfiles)
|
when (flags and $10000) there is no check for close (needed for textfiles)
|
||||||
}
|
}
|
||||||
|
|
||||||
var
|
var
|
||||||
@ -386,11 +589,87 @@ var
|
|||||||
refNum: Integer;
|
refNum: Integer;
|
||||||
res: OSErr;
|
res: OSErr;
|
||||||
|
|
||||||
const
|
fh: Longint;
|
||||||
|
|
||||||
|
oflags : longint;
|
||||||
|
|
||||||
|
Const
|
||||||
fsCurPerm = 0;
|
fsCurPerm = 0;
|
||||||
smSystemScript = -1;
|
smSystemScript = -1;
|
||||||
|
|
||||||
begin
|
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;
|
InOutRes:=1;
|
||||||
//creator:= $522A6368; {'MPS ' -- MPW}
|
//creator:= $522A6368; {'MPS ' -- MPW}
|
||||||
//creator:= $74747874; {'ttxt'}
|
//creator:= $74747874; {'ttxt'}
|
||||||
@ -418,12 +697,9 @@ begin
|
|||||||
//errno:=GetLastError;
|
//errno:=GetLastError;
|
||||||
//Errno2InoutRes;
|
//Errno2InoutRes;
|
||||||
end;
|
end;
|
||||||
|
{$endif}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function do_isdevice(handle:longint):boolean;
|
|
||||||
begin
|
|
||||||
do_isdevice:=false;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
@ -450,17 +726,17 @@ end;
|
|||||||
{*****************************************************************************
|
{*****************************************************************************
|
||||||
Directory Handling
|
Directory Handling
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
procedure mkdir(const s : string);[IOCheck];
|
procedure mkdir(const s:string);[IOCheck];
|
||||||
begin
|
begin
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure rmdir(const s : string);[IOCheck];
|
procedure rmdir(const s:string);[IOCheck];
|
||||||
begin
|
begin
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure chdir(const s : string);[IOCheck];
|
procedure chdir(const s:string);[IOCheck];
|
||||||
begin
|
begin
|
||||||
InOutRes:=1;
|
InOutRes:=1;
|
||||||
end;
|
end;
|
||||||
@ -475,38 +751,86 @@ end;
|
|||||||
SystemUnit Initialization
|
SystemUnit Initialization
|
||||||
*****************************************************************************}
|
*****************************************************************************}
|
||||||
|
|
||||||
Begin
|
procedure setup_arguments;
|
||||||
if false then //To save it from the dead code stripper
|
begin
|
||||||
Debugger; //Included only to make it available for debugging
|
end;
|
||||||
|
|
||||||
{ To be set if this is a GUI or console application }
|
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
|
||||||
|
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;
|
IsConsole := TRUE;
|
||||||
{ To be set if this is a library and not a program }
|
{ To be set if this is a library and not a program }
|
||||||
IsLibrary := FALSE;
|
IsLibrary := FALSE;
|
||||||
|
|
||||||
|
StackLength := InitialStkLen;
|
||||||
StackBottom := SPtr - StackLength;
|
StackBottom := SPtr - StackLength;
|
||||||
ExitCode := 0;
|
|
||||||
{ Setup heap }
|
{ Setup heap }
|
||||||
theHeap:= NewPtr(theHeapSize);
|
if Mac_FreeMem - intern_heapsize < 30000 then
|
||||||
|
Halt(3);
|
||||||
|
theHeap:= NewPtr(intern_heapsize);
|
||||||
|
if theHeap = nil then
|
||||||
|
Halt(3); //According to MPW
|
||||||
InitHeap;
|
InitHeap;
|
||||||
{ Setup stdin, stdout and stderr }
|
SysInitStdIO;
|
||||||
(* OpenStdIO(Input,fmInput,StdInputHandle);
|
|
||||||
OpenStdIO(Output,fmOutput,StdOutputHandle);
|
{ Setup environment and arguments }
|
||||||
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
|
|
||||||
OpenStdIO(StdErr,fmOutput,StdErrorHandle);*)
|
|
||||||
{ Setup environment and arguments }
|
|
||||||
Setup_Environment;
|
Setup_Environment;
|
||||||
Setup_Arguments;
|
setup_arguments;
|
||||||
{ Reset IO Error }
|
{ Reset IO Error }
|
||||||
InOutRes:=0;
|
InOutRes:=0;
|
||||||
|
errno:=0;
|
||||||
{$endif}
|
{$ifdef HASVARIANT}
|
||||||
|
initvariantmanager;
|
||||||
End.
|
{$endif HASVARIANT}
|
||||||
|
end.
|
||||||
|
|
||||||
|
|
||||||
{
|
{
|
||||||
$Log$
|
$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
|
+ added support for rudimentary file handling
|
||||||
|
|
||||||
Revision 1.4 2002/11/28 10:58:02 olle
|
Revision 1.4 2002/11/28 10:58:02 olle
|
||||||
|
Loading…
Reference in New Issue
Block a user