ocaml/byterun/macintosh.c

149 lines
3.4 KiB
C

/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Damien Doligez, projet Para, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* en Automatique. Distributed only by permission. */
/* */
/***********************************************************************/
/* $Id$ */
/* Macintosh-specific stuff */
#include <CursorCtl.h>
#include <Files.h>
#include <IntEnv.h>
#include <MacTypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <Strings.h>
#include <TextUtils.h>
#include <Timer.h>
/* The user interface defaults to MPW tool. The standalone application
overrides the ui_* functions, as well as [main], [InitCursorCtl],
[RotateCursor], [atexit], [getenv], and the terminfo functions.
*/
void ui_exit (int return_code)
{
exit (return_code);
}
int ui_read (int file_desc, char *buf, unsigned int length)
{
return read (file_desc, buf, length);
}
int ui_write (int file_desc, char *buf, unsigned int length)
{
return write (file_desc, buf, length);
}
void ui_print_stderr (char *format, void *arg)
{
fprintf (stderr, format, arg);
fflush (stderr);
}
/* Unix emulation stuff */
static short prevdir = 0;
int chdir (char *dir)
{
WDPBRec pb;
int result;
short curdir;
pb.ioCompletion = NULL;
pb.ioNamePtr = c2pstr (dir);
pb.ioVRefNum = 0;
pb.ioWDProcID = 'Caml';
pb.ioWDDirID = 0;
result = PBOpenWDSync (&pb);
p2cstr ((unsigned char *) dir);
if (result != noErr) return -1;
curdir = pb.ioVRefNum;
result = SetVol (NULL, curdir);
if (result != noErr) return -1;
if (prevdir != 0){
pb.ioVRefNum = prevdir;
PBCloseWDSync (&pb);
}
prevdir = curdir;
return 0;
}
Handle macos_getfullpathname (short vrefnum, long dirid)
{
Handle result = NewHandle (0);
CInfoPBRec mypb;
Str255 dirname;
OSErr err;
if (result == NULL) goto failed;
mypb.dirInfo.ioNamePtr = dirname;
mypb.dirInfo.ioVRefNum = vrefnum;
mypb.dirInfo.ioDrParID = dirid;
mypb.dirInfo.ioFDirIndex = -1;
do{
mypb.dirInfo.ioDrDirID = mypb.dirInfo.ioDrParID;
err = PBGetCatInfo (&mypb, false);
if (err) goto failed;
Munger (result, 0, NULL, 0, ":", 1);
Munger (result, 0, NULL, 0, dirname+1, dirname[0]);
/* XXX out of memory ?! */
}while (mypb.dirInfo.ioDrDirID != fsRtDirID);
return result;
failed:
if (result != NULL) DisposeHandle (result);
return NULL;
}
char *getcwd (char *buf, long size)
{
size_t len;
Handle path = macos_getfullpathname (0, 0);
if (path == NULL) return NULL;
len = GetHandleSize (path);
if (len+1 >= size){
DisposeHandle (path);
return NULL;
}
if (buf == NULL){
buf = malloc (len+1);
if (buf == NULL) return NULL;
}
memcpy (buf, *path, len);
buf [len] = '\000';
DisposeHandle (path);
return buf;
}
int system (char const *cmd)
{
char *filename;
FILE *f;
if (StandAlone) return -1;
filename = getenv ("ocamlcommands");
if (filename == NULL) return 1;
f = fopen (filename, "a");
if (f == NULL) return 1;
fprintf (f, "%s\n", cmd);
fclose (f);
return 0;
}