/* sysmac.c Copyright (C) 1989-2002 Codemist Ltd */
/*
* Macintosh system-specific stuff
*/
/*
* This code may be used and modified, and redistributed in binary
* or source form, subject to the "CCL Public License", which should
* accompany it. This license is a variant on the BSD license, and thus
* permits use of code derived from this in either open and commercial
* projects: but it does require that updates to this code be made
* available back to the originators of the package.
* Before merging other code in with this or linking this code
* with other packages or libraries please check that the license terms
* of the other material are compatible with those of this.
*/
/* Signature: 4bed9bc9 08-Apr-2002 */
#include "machine.h"
#include <stdarg.h>
#include <stddef.h>
#include <string.h>
#include <ctype.h>
#include "tags.h"
#include "externs.h"
#include <sysequ.h>
#include <unix.h>
#include <files.h>
#include <unix.h>
#include <retrace.h>
#include <timer.h>
#undef nil /* #define'd by Think C headers but not wanted (by me) */
static void get_home_directory(char *b, int length);
static void get_users_home_directory(char *b, int length);
#include "filename.c"
/*
* This is a dummy definition of get_truename, here so that everything
* will link. Both the calling convention used here and the exact
* meaning and implementation may be under gentle review!
*/
char *get_truename(char *filename, char *old, size_t n)
{
char *w;
process_file_name(filename, old, n);
if (*filename == 0)
{ aerror("truename");
return NULL;
}
w = (char *)(*malloc_hool)(1+strlen(filename));
if (w == NULL) return w;
strcpy(w, filename);
return w;
}
char *my_getenv(char *s)
{
return getenv(s);
}
int my_system(char *s)
{
return 0; /* Not available - sorry! */
}
static void get_home_directory(char *b, int length)
{
char *w = my_getenv("home");
if (w != NULL) strcpy(b, w);
else
strcpy(b, ":"); /* Not satisfactory */
}
static void get_users_home_directory(char *b, int length)
{
char *w, h[LONGEST_LEGAL_FILENAME];
sprintf(h, "home$%s", b);
w = my_getenv(h);
if (w != NULL) strcpy(b, w);
else
strcpy(b, ":"); /* Not satisfactory */
}
int batchp()
{
return !isatty(fileno(stdin));
}
/*
* The next procedure is responsible for establishing information about
* where the main checkpoint image should be recovered from, and where
* and fasl files should come from.
*/
char *find_image_directory(int argc, char *argv[])
{
char image[LONGEST_LEGAL_FILENAME];
char pgmname[LONGEST_LEGAL_FILENAME];
char *w;
/*
* For the Macintosh I use the data fork of the application image as
* a place to store useful stuff.
*/
WDPBRec pb1;
CInfoPBRec pb2;
int i, j, r, p = LONGEST_LEGAL_FILENAME;
long id;
pgmname[--p] = 0;
sprintf(image, "%#s", CurApName); /* name of current application */
strcpy(image, program_name);
i = strlen(image);
p -= i;
memcpy(&pgmname[p], image, i); /* copy to the end of a buffer */
pb1.ioNamePtr = (unsigned char *)image;
PBHGetVolSync(&pb1); /* find current working dir & volume */
id = pb1.ioWDDirID; /* working directory identifier */
while (id != 0)
{ pb2.dirInfo.ioFDirIndex = -1; /* use directory ID, not file name/index */
pb2.dirInfo.ioVRefNum = pb1.ioVRefNum; /* look in this volume */
pb2.dirInfo.ioDrDirID = id; /* get info about this directory */
pb2.dirInfo.ioNamePtr = (unsigned char *)image;
r = PBGetCatInfoSync(&pb2); /* Read catalogue - find name & parent */
if (r != 0) break; /* failed - must be at top of tree */
id = pb2.dirInfo.ioDrParID; /* go on up to parent directory */
i = image[0] & 0xff; /* length of name of this directory */
pgmname[--p] = ':';
p -= i;
if (p < 10)
{ fprintf(stderr, "\nPlease re-install this package nearer the top of\n");
fprintf(stderr, "your directory hierarchy. It will not work this far down\n");
abort();
}
memcpy(&pgmname[p], &image[1], i); /* stick names together with ':'s */
}
strcpy(image, &pgmname[p]); /* Put complete name in convenient place */
/*
* I copy from local vectors into malloc'd space to hand my
* answer back.
*/
w = (char *)(*malloc_hook)(1+strlen(image));
/*
* The error exit here seem unsatisfactory...
*/
if (w == NULL)
{ fprintf(stderr, "\n+++ Panic - run out of space\n");
exit(EXIT_FAILURE);
}
strcpy(w, image);
return w;
}
int truncate_file(FILE *f, long int where)
{
if (fflush(f) != 0) return 1;
return SetEOF(fileno(f), where); /* Returns zero if successs */
}
#ifdef TICK_STREAM
void accept_tick(void)
{
/*
* This is where I can put things that need to be done regularly.
* This will need to involve prodding the window manager etc etc.
* At present I do NOTHING...
*/
return;
}
#ifdef USE_VBL
static VBLTask VBL_control_block;
static pascal void deal_with_tick(void)
{
/*
* This way of recovering register a5 was OK before the multi-finder,
* but is UNSATISFACTORY now. It is proper to use the time manager
* instead of VBL, but only recent versions of the time manager are any good
* so it is a bit of a mess.
*/
asm { move.l a5, -(sp)
movea.l CurrentA5, a5 }
VBL_control_block.vblCount = 5;
if (tick_pending == 0)
{
if (already_in_gc) tick_on_gc_exit = YES;
else
{ Lisp_Object nil = C_nil;
CSLbool xxx = NO;
if (exception_pending()) flip_exception(), xxx = YES;
tick_pending = YES;
saveheaplimit = heaplimit;
heaplimit = fringe;
savevheaplimit = vheaplimit;
vheaplimit = vfringe;
savecodelimit = codelimit;
codelimit = codefringe;
savestacklimit = stacklimit;
stacklimit = stackbase;
if (xxx) flip_exception();
}
}
asm { movea.l (sp)+, a5 }
return;
}
void remove_ticker(void)
{
VRemove((QElemPtr)&VBL_control_block);
}
void add_ticker(void)
{
VBL_control_block.qType = vType;
VBL_control_block.vblAddr = deal_with_tick;
VBL_control_block.vblCount = 1;
VBL_control_block.vblPhase = 0;
VInstall((QElemPtr)&VBL_control_block);
}
#else /* USE_VBL */
typedef struct xTMTask
{
struct TMTask a;
long int a5save;
} xTMTask;
static pascal void do_tick(void)
{
QElemPtr w;
long int savea5;
asm { move.l a5, savea5
move.l offsetof(xTMTask, a5save)(a1), a5
move.l a1, w }
if (tick_pending == 0)
{
if (already_in_gc) tick_on_gc_exit = YES;
else
{ Lisp_Object nil = C_nil;
CSLbool xxx = NO;
if (exception_pending()) flip_exception(), xxx = YES;
tick_pending = YES;
saveheaplimit = heaplimit;
heaplimit = fringe;
savevheaplimit = vheaplimit;
vheaplimit = vfringe;
savecodelimit = codelimit;
codelimit = codefringe;
savestacklimit = stacklimit;
stacklimit = stackbase;
if (xxx) flip_exception();
}
}
PrimeTime(w, 1000);
asm { move.l savea5, a5 }
return;
}
static xTMTask ticker;
void remove_ticker(void)
{
RmvTime((QElemPtr)&ticker);
}
void add_ticker()
{
ticker.a.tmAddr = do_tick;
ticker.a.tmCount = 0;
ticker.a.tmWakeUp = 0;
ticker.a.tmReserved = 0;
asm { move.l a5,ticker.a5save }
InsTime((QElemPtr) &ticker);
PrimeTime((QElemPtr) &ticker, 1000);
}
#endif /* USE_VBL */
#endif /* TICK_STREAM */
/* end of sysmac.c */