mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-20 18:09:27 +02:00
+ handles program parameters for MPW
+ program start stub * improved working directory handling * minor changes + some documentation
This commit is contained in:
olle
parent
6a06df943b
commit
00065dd24d
@ -33,7 +33,7 @@ const
|
||||
LFNSupport = true;
|
||||
DirectorySeparator = ':';
|
||||
DriveSeparator = ':';
|
||||
PathSeparator = ','; // Is used in MPW
|
||||
PathSeparator = ','; // Is used in MPW and OzTeX
|
||||
FileNameCaseSensitive = false;
|
||||
|
||||
{ include heap support headers }
|
||||
@ -54,8 +54,86 @@ var
|
||||
argv : ppchar;
|
||||
envp : ppchar;
|
||||
|
||||
{
|
||||
MacOS paths
|
||||
===========
|
||||
MacOS directory separator is a colon ":" which is the only character not
|
||||
allowed in filenames.
|
||||
A path containing no colon or which begins with a colon is a partial path.
|
||||
E g ":kalle:petter" ":kalle" "kalle"
|
||||
All other paths are full (absolute) paths. E g "HD:kalle:" "HD:"
|
||||
When generating paths, one is safe is one ensures that all partial paths
|
||||
begins with a colon, and all full paths ends with a colon.
|
||||
In full paths the first name (e g HD above) is the name of a mounted volume.
|
||||
These names are not unique, because, for instance, two diskettes with the
|
||||
same names could be inserted. This means that paths on MacOS is not
|
||||
waterproof. In case of equal names the first volume found will do.
|
||||
Two colons "::" are the relative path to the parent. Three is to the
|
||||
grandparent etc.
|
||||
}
|
||||
|
||||
implementation
|
||||
|
||||
{
|
||||
About the implementation
|
||||
========================
|
||||
A MacOS application is assembled and linked by MPW (Macintosh
|
||||
Programmers Workshop), which nowadays is free to use. For info
|
||||
and download of MPW and MacOS api, see www.apple.com
|
||||
|
||||
It can be linked to either a standalone application (using SIOW) or
|
||||
to an MPW tool, this is entirely controlled by the linking step.
|
||||
|
||||
It requires system 7 and CFM, which is always the case for PowerPC.
|
||||
|
||||
If a m68k version would be implemented, it would save a lot
|
||||
of efforts if it also uses CFM. This System.pp should, with
|
||||
minor modifications, probably work with m68k.
|
||||
|
||||
Initial working directory is the directory of the application,
|
||||
or for an MPWTool, the MPW directory.
|
||||
|
||||
Note about working directory. There is a facility in MacOS which
|
||||
manages a working directory for an application, initially set to
|
||||
the applictaions directory, or for an MPWTool, the tool's directory.
|
||||
However, this requires the application to have a unique application
|
||||
signature (creator code), to distinguish its working directory
|
||||
from working directories of other applications. Due to the fact
|
||||
that casual applications are anonymous in this sense (without an
|
||||
application signature), this facility will not work. Hence we
|
||||
will manage a working directory by our self.
|
||||
|
||||
|
||||
Deviations
|
||||
==========
|
||||
|
||||
In current implementation, working directory is stored as
|
||||
directory id. This means there is a possibility the user moves the
|
||||
working directory or a parent to it, while the application uses it.
|
||||
Then the path to the wd suddenly changes. This is AFAIK not in
|
||||
accordance with other OS's. Although this is a minor caveat,
|
||||
it is mentioned here. To overcome this the wd could be stored
|
||||
as a path instead, but this imposes translations from fullpath
|
||||
to directory id each time the filesystem is accessed.
|
||||
|
||||
The initial working directory for an MPWTool, as considered by
|
||||
FPC, is different from the MacOS working directory facility,
|
||||
see above.
|
||||
|
||||
|
||||
Possible improvements:
|
||||
=====================
|
||||
TODO: Add check so that working directory cannot be removed. Alt ensure
|
||||
the nothing crashes if wd is removed.
|
||||
|
||||
TODO: rmdir and erase does not differentiate between files and directories
|
||||
thus removing both of them.
|
||||
|
||||
TODO: Check of the MacOS version (and prescence of CFM) to
|
||||
ensure it is a supported version. only needed for m68k.
|
||||
}
|
||||
|
||||
{This implementation uses StdCLib, which is included in the MPW.}
|
||||
{$define MACOS_USE_STDCLIB}
|
||||
|
||||
|
||||
@ -71,9 +149,6 @@ as an include file and not a unit.}
|
||||
|
||||
{$I macostp.inc}
|
||||
|
||||
{TODO: Perhaps the System unit should check the MacOS version to
|
||||
ensure it is a supported version. }
|
||||
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
|
||||
{************** API to StdCLib in MacOS ***************}
|
||||
@ -126,36 +201,35 @@ const
|
||||
|
||||
TIOFLUSH = $00007408; // discard unread input. arg is ignored
|
||||
|
||||
function C_open(path: PChar; oflag: C_int): C_int;
|
||||
function c_open(path: PChar; oflag: C_int): C_int; cdecl;
|
||||
external 'StdCLib' name 'open';
|
||||
|
||||
function C_close(filedes: C_int): C_int;
|
||||
function c_close(filedes: C_int): C_int; cdecl;
|
||||
external 'StdCLib' name 'close';
|
||||
|
||||
function C_write(filedes: C_int; buf: pointer; nbyte: size_t): size_t;
|
||||
function c_write(filedes: C_int; buf: pointer; nbyte: size_t): size_t; cdecl;
|
||||
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;
|
||||
function c_read(filedes: C_int; buf: pointer; nbyte: size_t): size_t; cdecl;
|
||||
external 'StdCLib' name 'read';
|
||||
|
||||
function lseek(filedes: C_int; offset: off_t; whence: C_int): off_t;
|
||||
function lseek(filedes: C_int; offset: off_t; whence: C_int): off_t; cdecl;
|
||||
external 'StdCLib' name 'lseek';
|
||||
|
||||
function ioctl(filedes: C_int; cmd: C_unsigned_int; arg: pointer): C_int;
|
||||
function ioctl(filedes: C_int; cmd: C_unsigned_int; arg: pointer): C_int; cdecl;
|
||||
external 'StdCLib' name 'ioctl';
|
||||
|
||||
function remove(filename: PChar): C_int;
|
||||
function remove(filename: PChar): C_int; cdecl;
|
||||
external 'StdCLib';
|
||||
|
||||
function c_rename(old, c_new: PChar): C_int;
|
||||
function c_rename(old, c_new: PChar): C_int; cdecl;
|
||||
external 'StdCLib' name 'rename';
|
||||
|
||||
procedure c_exit(status: C_int);
|
||||
procedure c_exit(status: C_int); cdecl;
|
||||
external 'StdCLib' name 'exit';
|
||||
|
||||
{cdecl is actually only needed for m68k}
|
||||
|
||||
var
|
||||
{Is set to nonzero for MPWTool, zero otherwise.}
|
||||
StandAlone: C_int; external name 'StandAlone';
|
||||
@ -205,17 +279,9 @@ Sys_ERANGE = 34; { Math result not representable }
|
||||
{******************************************************}
|
||||
|
||||
var
|
||||
{working directory}
|
||||
curDirectorySpec: FSSpec;
|
||||
|
||||
{Note about working directory. There is a facility in MacOS to
|
||||
set a working directory. However, this requires the application
|
||||
to have a unique application signature (creator code), to distinguish
|
||||
its working directory from working directory of other applications.
|
||||
Due to the fact that applications might be anonymous (without an
|
||||
application signature), this facility will not work. Hence we
|
||||
will manage working directory by our self.}
|
||||
|
||||
|
||||
function GetAppFileLocation (var spec: FSSpec): Boolean;
|
||||
//Requires >= System 7
|
||||
|
||||
@ -487,6 +553,27 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function FSpLocationFromFullPath(fullPathLength: Integer;
|
||||
fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
|
||||
|
||||
var
|
||||
alias: AliasHandle;
|
||||
res: OSErr;
|
||||
wasChanged: Boolean;
|
||||
nullString: Str32;
|
||||
|
||||
begin
|
||||
nullString:= '';
|
||||
res:= NewAliasMinimalFromFullPath(fullPathLength,
|
||||
fullPath, nullString, nullString, alias);
|
||||
if res = noErr then
|
||||
begin
|
||||
res:= ResolveAlias(nil, alias, spec, wasChanged);
|
||||
DisposeHandle(Mac_Handle(alias));
|
||||
end;
|
||||
FSpLocationFromFullPath:= res;
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
ParamStr/Randomize
|
||||
*****************************************************************************}
|
||||
@ -494,16 +581,16 @@ end;
|
||||
{ number of args }
|
||||
function paramcount : longint;
|
||||
begin
|
||||
{paramcount := argc - 1;}
|
||||
paramcount:=0;
|
||||
paramcount := argc - 1;
|
||||
//paramcount:=0;
|
||||
end;
|
||||
|
||||
{ argument number l }
|
||||
function paramstr(l : longint) : string;
|
||||
begin
|
||||
{if (l>=0) and (l+1<=argc) then
|
||||
if (l>=0) and (l+1<=argc) then
|
||||
paramstr:=strpas(argv[l])
|
||||
else}
|
||||
else
|
||||
paramstr:='';
|
||||
end;
|
||||
|
||||
@ -555,18 +642,22 @@ end;
|
||||
|
||||
{ close a file from the handle value }
|
||||
procedure do_close(h : longint);
|
||||
var
|
||||
err: OSErr;
|
||||
{No error handling, according to the other targets, which seems reasonable,
|
||||
because close might be used to clean up after an error.}
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
C_close(h);
|
||||
Errno2InOutRes;
|
||||
c_close(h);
|
||||
// Errno2InOutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
if FSClose(h) = noErr then
|
||||
InOutRes:=0;
|
||||
err:= FSClose(h);
|
||||
// OSErr2InOutRes(err);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
procedure do_erase(p : pchar);
|
||||
{this implementation cannot distinguish between directories and files}
|
||||
var
|
||||
s: AnsiString;
|
||||
begin
|
||||
@ -599,7 +690,7 @@ end;
|
||||
function do_write(h,addr,len : longint) : longint;
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
do_write:= C_write(h, pointer(addr), len);
|
||||
do_write:= c_write(h, pointer(addr), len);
|
||||
Errno2InoutRes;
|
||||
{$else}
|
||||
InOutRes:=1;
|
||||
@ -616,7 +707,7 @@ var
|
||||
|
||||
begin
|
||||
{$ifdef MACOS_USE_STDCLIB}
|
||||
len:= C_read(h, pointer(addr), len);
|
||||
len:= c_read(h, pointer(addr), len);
|
||||
Errno2InoutRes;
|
||||
|
||||
// TEMP BUGFIX Exchange CR to LF.
|
||||
@ -715,27 +806,6 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function FSpLocationFromFullPath(fullPathLength: Integer;
|
||||
fullPath: Mac_Ptr; var spec: FSSpec ):OSErr;
|
||||
|
||||
var
|
||||
alias: AliasHandle;
|
||||
res: OSErr;
|
||||
wasChanged: Boolean;
|
||||
nullString: Str32;
|
||||
|
||||
begin
|
||||
nullString:= '';
|
||||
res:= NewAliasMinimalFromFullPath(fullPathLength,
|
||||
fullPath, nullString, nullString, alias);
|
||||
if res = noErr then
|
||||
begin
|
||||
res:= ResolveAlias(nil, alias, spec, wasChanged);
|
||||
DisposeHandle(Mac_Handle(alias));
|
||||
end;
|
||||
FSpLocationFromFullPath:= res;
|
||||
end;
|
||||
|
||||
procedure do_open(var f;p:pchar;flags:longint);
|
||||
{
|
||||
filerec and textrec have both handle and mode as the first items so
|
||||
@ -824,10 +894,11 @@ begin
|
||||
p:= PChar(s);
|
||||
end;
|
||||
|
||||
fh:= C_open(p, oflags);
|
||||
|
||||
//TODO Perhaps handle readonly filesystems, as in sysunix.inc
|
||||
|
||||
fh:= c_open(p, oflags);
|
||||
Errno2InOutRes;
|
||||
|
||||
if fh <> -1 then
|
||||
filerec(f).handle:= fh
|
||||
else
|
||||
@ -846,7 +917,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
|
||||
;
|
||||
|
||||
@ -854,7 +925,7 @@ begin
|
||||
begin
|
||||
filerec(f).handle:= refNum;
|
||||
InOutRes:=0;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
if (filerec(f).handle=UnusedHandle) then
|
||||
@ -865,8 +936,6 @@ begin
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
UnTyped File Handling
|
||||
*****************************************************************************}
|
||||
@ -883,8 +952,7 @@ end;
|
||||
Text File Handling
|
||||
*****************************************************************************}
|
||||
|
||||
{ should we consider #26 as the end of a file ? }
|
||||
{?? $DEFINE EOF_CTRLZ}
|
||||
{ #26 is not end of a file in MacOS ! }
|
||||
|
||||
{$i text.inc}
|
||||
|
||||
@ -896,19 +964,20 @@ procedure mkdir(const s:string);[IOCheck];
|
||||
var
|
||||
spec: FSSpec;
|
||||
createdDirID: Longint;
|
||||
err: OSErr;
|
||||
begin
|
||||
If (s='') or (InOutRes <> 0) then
|
||||
exit;
|
||||
|
||||
if PathArgToFSSpec(s, spec) then
|
||||
if FSpDirCreate(spec, smSystemScript, createdDirID) = noErr then
|
||||
InOutRes:= 0
|
||||
else
|
||||
InOutRes:= 1;
|
||||
begin
|
||||
err:= FSpDirCreate(spec, smSystemScript, createdDirID);
|
||||
OSErr2InOutRes(err);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure rmdir(const s:string);[IOCheck];
|
||||
//Kolla så att endast directories tas bort, kolla med dok.
|
||||
{this implementation cannot distinguish between directories and files}
|
||||
var
|
||||
spec: FSSpec;
|
||||
err: OSErr;
|
||||
@ -925,42 +994,72 @@ end;
|
||||
|
||||
procedure chdir(const s:string);[IOCheck];
|
||||
var
|
||||
newDirSpec: FSSpec;
|
||||
spec, newDirSpec: FSSpec;
|
||||
err: OSErr;
|
||||
begin
|
||||
If (s='') or (InOutRes <> 0) then
|
||||
if (s='') or (InOutRes <> 0) then
|
||||
exit;
|
||||
|
||||
InOutRes:=1;
|
||||
if FSMakeFSSpec (curDirectorySpec.vRefNum, curDirectorySpec.parID,
|
||||
s+':x', newDirSpec) in [ noErr, fnfErr] then
|
||||
{ the fictive file x is appended to the path to make FSMakeFSSpec return a FSSpec
|
||||
to a file in the directory. Then by clearing the name, the FSSpec then
|
||||
if PathArgToFSSpec(s, spec) then
|
||||
begin
|
||||
{ The fictive file x is appended to the directory name to make
|
||||
FSMakeFSSpec return a FSSpec to a file in the directory.
|
||||
Then by clearing the name, the FSSpec then
|
||||
points to the directory. It doesn't matter whether x exists or not.}
|
||||
begin
|
||||
curDirectorySpec:= newDirSpec;
|
||||
curDirectorySpec.name:='';
|
||||
InOutRes:= 0;
|
||||
end;
|
||||
|
||||
err:= FSMakeFSSpec (spec.vRefNum, spec.parID, ':'+spec.name+':x', newDirSpec);
|
||||
if err in [ noErr, fnfErr] then
|
||||
begin
|
||||
curDirectorySpec:= newDirSpec;
|
||||
curDirectorySpec.name:='';
|
||||
InOutRes:= 0;
|
||||
end
|
||||
else
|
||||
begin
|
||||
//E g if the directory doesn't exist.
|
||||
OSErr2InOutRes(err);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure getDir (DriveNr: byte; var Dir: ShortString);
|
||||
var
|
||||
pathHandle: Mac_Handle;
|
||||
pathHandleSize: Longint;
|
||||
begin
|
||||
if FSpGetFullPath(curDirectorySpec, pathHandle, false) <> noErr then
|
||||
Halt(3); //exit code 3 according to MPW
|
||||
SetString(dir, pathHandle^, GetHandleSize(pathHandle));
|
||||
|
||||
pathHandleSize:= GetHandleSize(pathHandle);
|
||||
SetString(dir, pathHandle^, pathHandleSize);
|
||||
DisposeHandle(pathHandle);
|
||||
InOutRes := 0;
|
||||
|
||||
if pathHandleSize <= 255 then //because dir is ShortString
|
||||
InOutRes := 0
|
||||
else
|
||||
InOutRes := 1; //TODO Exchange to something better
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
SystemUnit Initialization
|
||||
*****************************************************************************}
|
||||
|
||||
procedure pascalmain; external name 'PASCALMAIN';
|
||||
|
||||
{Main entry point in C style, needed to capture program parameters.
|
||||
For this to work, the system unit must be before the main program
|
||||
in the linking order.}
|
||||
procedure main(argcparam: Longint; argvparam: ppchar; envpparam: ppchar); cdecl;
|
||||
|
||||
begin
|
||||
argc:= argcparam;
|
||||
argv:= argvparam;
|
||||
envp:= envpparam;
|
||||
pascalmain; {run the pascal main program}
|
||||
end;
|
||||
|
||||
procedure setup_arguments;
|
||||
begin
|
||||
//Nothing needs to be done here.
|
||||
end;
|
||||
|
||||
procedure setup_environment;
|
||||
@ -1039,7 +1138,14 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2003-10-17 23:44:30 olle
|
||||
Revision 1.10 2003-10-29 22:34:52 olle
|
||||
+ handles program parameters for MPW
|
||||
+ program start stub
|
||||
* improved working directory handling
|
||||
* minor changes
|
||||
+ some documentation
|
||||
|
||||
Revision 1.9 2003/10/17 23:44:30 olle
|
||||
+ working direcory emulated
|
||||
+ implemented directory handling procs
|
||||
+ all proc which take a path param, now resolve it relative wd
|
||||
|
||||
Loading…
Reference in New Issue
Block a user