/***********************************************************************/ /* */ /* 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 #include #include #include #include #include #include #include #include /* 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; }