mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-14 15:36:34 +00:00
897 lines
21 KiB
C
Executable File
897 lines
21 KiB
C
Executable File
/* $Id: main.c,v 1.4 2001/12/26 22:17:03 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved */
|
|
static char *id = "$Id: main.c,v 1.4 2001/12/26 22:17:03 sybalsky Exp $ Copyright (C) Venue";
|
|
|
|
|
|
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
|
/* Manufactured in the United States of America. */
|
|
/* */
|
|
/* The contents of this file are proprietary information */
|
|
/* belonging to Venue, and are provided to you under license. */
|
|
/* They may not be further distributed or disclosed to third */
|
|
/* parties without the specific permission of Venue. */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
#include "version.h"
|
|
|
|
|
|
|
|
/*
|
|
* main.c
|
|
* This file includes main()
|
|
*/
|
|
|
|
#include "lispemul.h"
|
|
#include "dbprint.h"
|
|
#include <sys/types.h>
|
|
#ifndef DOS
|
|
#include <sys/param.h>
|
|
#include <sys/time.h>
|
|
#else /* DOS */
|
|
#define MAXPATHLEN 128
|
|
#define R_OK 04
|
|
#define index strchr
|
|
#define rindex strrchr
|
|
#include <time.h>
|
|
#include <string.h>
|
|
#include <i32.h>
|
|
#endif /* DOS */
|
|
|
|
#ifndef NOETHER
|
|
#ifndef USE_DLPI
|
|
#include <net/nit.h> /* needed for Ethernet stuff below */
|
|
#endif /* USE_DLPI */
|
|
#endif /* NOETHER */
|
|
#include <stdio.h>
|
|
#ifndef SYSVONLY
|
|
#ifndef DOS
|
|
#include <strings.h>
|
|
#endif /* DOS */
|
|
#else /* SYSVONLY -IS- ON */
|
|
#include <string.h>
|
|
#include <unistd.h>
|
|
#endif /* SYSVONLY */
|
|
|
|
#ifndef DOS
|
|
#include <sys/file.h>
|
|
#endif /* DOS */
|
|
|
|
#include <setjmp.h>
|
|
#ifndef DOS
|
|
#include <pwd.h>
|
|
#endif /* DOS */
|
|
|
|
#ifdef RISCOS
|
|
#include <unistd.h>
|
|
#endif /* RISCOS */
|
|
|
|
|
|
#ifdef ISC
|
|
#include <unistd.h>
|
|
#include <sys/dirent.h>
|
|
#endif
|
|
|
|
#if defined(MACOSX) || defined(FREEBSD)
|
|
#include <string.h>
|
|
#endif
|
|
|
|
#include <errno.h>
|
|
|
|
#include "emlglob.h"
|
|
#include "address.h"
|
|
#include "adr68k.h"
|
|
#include "stack.h"
|
|
#include "return.h"
|
|
|
|
#include "lspglob.h"
|
|
#include "lsptypes.h"
|
|
#include "lispmap.h"
|
|
#include "ifpage.h"
|
|
#include "iopage.h"
|
|
|
|
#include "debug.h"
|
|
#include "profile.h"
|
|
|
|
#include "timeout.h"
|
|
|
|
DLword *Lisp_world; /* lispworld */
|
|
|
|
/********** 68k address for Lisp Space **********/
|
|
DLword *Atomspace;
|
|
DLword *Stackspace;
|
|
DLword *Plistspace;
|
|
DLword *DTDspace;
|
|
DLword *MDStypetbl;
|
|
DLword *AtomHT;
|
|
DLword *Pnamespace;
|
|
DLword *AtomSpace;
|
|
DLword *Defspace;
|
|
DLword *Valspace;
|
|
DLword *Spospspace;
|
|
DLword *Snegspace;
|
|
|
|
/********** For Virtual Memory Management **********/
|
|
#ifdef BIGVM
|
|
LispPTR *FPtoVP;
|
|
#else
|
|
DLword *FPtoVP;
|
|
#endif /* BIGVM */
|
|
DLword *PAGEMap;
|
|
DLword *PageMapTBL;
|
|
DLword *LockedPageTable;
|
|
|
|
/********** For Interface to LispMicro/Device **********/
|
|
DLword *IOCBPage;
|
|
IOPAGE *IOPage;
|
|
IFPAGE *InterfacePage;
|
|
MISCSTATS *MiscStats;
|
|
|
|
/********** UFN Table **********/
|
|
DLword *UFNTable;
|
|
|
|
/********** Tables for GC **********/
|
|
#ifdef BIGVM
|
|
LispPTR *HTmain;
|
|
LispPTR *HToverflow;
|
|
LispPTR *HTbigcount;
|
|
LispPTR *HTcoll;
|
|
#else
|
|
DLword *HTmain;
|
|
DLword *HToverflow;
|
|
DLword *HTbigcount;
|
|
DLword *HTcoll;
|
|
#endif /* BIGVM */
|
|
|
|
/********** Display **********/
|
|
DLword *DisplayRegion;
|
|
int DisplayInitialized = NIL;
|
|
|
|
DLword *Arrayspace;
|
|
DLword *MDS_space_bottom;
|
|
DLword *PnCharspace;
|
|
struct dtd *ListpDTD;
|
|
|
|
|
|
/********** For Lisp Emulator **********/
|
|
struct state MachineState;
|
|
|
|
/**********************************/
|
|
/*** Share val with LISP code ******/
|
|
|
|
DLword *MDS_free_page;
|
|
DLword *Next_MDSpage;
|
|
DLword *Next_Array;
|
|
/*******************************************/
|
|
|
|
/** CACHE LISP SYSVAL ***/
|
|
LispPTR *Next_MDSpage_word;
|
|
LispPTR *Next_Array_word;
|
|
LispPTR *MDS_free_page_word;
|
|
|
|
LispPTR *Reclaim_cnt_word ;
|
|
|
|
/*** Cache Values for reclaimer by Tomtom 30-Sep-1987 ***/
|
|
LispPTR *GcDisabled_word;
|
|
LispPTR *CdrCoding_word;
|
|
LispPTR *FreeBlockBuckets_word;
|
|
LispPTR *Array_Block_Checking_word;
|
|
LispPTR *ArrayMerging_word;
|
|
LispPTR *ArraySpace_word;
|
|
LispPTR *ArraySpace2_word;
|
|
LispPTR *ArrayFrLst_word;
|
|
LispPTR *ArrayFrLst2_word;
|
|
LispPTR *Hunk_word;
|
|
LispPTR *System_Buffer_List_word;
|
|
|
|
/*** The end of the addition of cache values on reclaimer ***/
|
|
|
|
|
|
/*** cache values for the top level reclaimer's implementation ***/
|
|
|
|
LispPTR *GcMess_word;
|
|
LispPTR *ReclaimMin_word;
|
|
LispPTR *GcTime1_word;
|
|
LispPTR *GcTime2_word;
|
|
LispPTR *MaxTypeNumber_word;
|
|
|
|
/*** The end of the addition of cache values for top reclaimer by Tomtom
|
|
15-Oct-1987 ***/
|
|
|
|
/* Pointers for closure caching */
|
|
|
|
LispPTR *Package_from_Index_word;
|
|
LispPTR *Package_from_Name_word;
|
|
LispPTR *Keyword_Package_word;
|
|
LispPTR *Closure_Cache_Enabled_word;
|
|
LispPTR *Closure_Cache_word;
|
|
LispPTR *Deleted_Implicit_Hash_Slot_word;
|
|
LispPTR First_index;
|
|
|
|
/*** The end of Pointers for closure caching ***/
|
|
|
|
/* CACHE values for 32Mb MDS/Array by Take */
|
|
LispPTR *STORAGEFULLSTATE_word;
|
|
LispPTR *STORAGEFULL_word;
|
|
LispPTR *PENDINGINTERRUPT_word;
|
|
LispPTR *LeastMDSPage_word;
|
|
LispPTR *SecondMDSPage_word;
|
|
LispPTR *SecondArrayPage_word;
|
|
LispPTR *INTERRUPTSTATE_word;
|
|
LispPTR *SYSTEMCACHEVARS_word;
|
|
LispPTR *MACHINETYPE_word;
|
|
|
|
LispPTR STORAGEFULLSTATE_index;
|
|
LispPTR *LASTVMEMFILEPAGE_word;
|
|
LispPTR *VMEM_FULL_STATE_word ;
|
|
|
|
/** Array for N-tran **/
|
|
|
|
int native_load_address;
|
|
LispPTR native_closure_env = NOBIND_PTR;
|
|
|
|
/** Pipes for Unix Interface **/
|
|
int UnixPipeIn;
|
|
int UnixPipeOut;
|
|
int UnixPID;
|
|
int please_fork = 1;
|
|
|
|
/*** STACK handle staff(Takeshi) **/
|
|
LispPTR *STACKOVERFLOW_word;
|
|
LispPTR *GuardStackAddr_word;
|
|
LispPTR *LastStackAddr_word;
|
|
LispPTR *NeedHardreturnCleanup_word;
|
|
|
|
/*** Ethernet stuff (JRB) **/
|
|
#ifndef NOETHER
|
|
extern int ether_fd;
|
|
extern u_char ether_host[6];
|
|
#endif /* NOETHER */
|
|
|
|
extern struct sockaddr_nit snit;
|
|
|
|
#ifdef INIT
|
|
int for_makeinit = 1;
|
|
#else
|
|
int for_makeinit = 0;
|
|
#endif /* INIT */
|
|
|
|
int kbd_for_makeinit = 0;
|
|
int save_argc;
|
|
char **save_argv;
|
|
int display_max = 65536*16*2;
|
|
|
|
/* diagnostic flag for sysout dumping */
|
|
extern int maxpages;
|
|
|
|
/** For call makepathname inside main() **/
|
|
extern int *Lisp_errno;
|
|
extern int Dummy_errno; /* If errno cell is not provided by Lisp, dummy_errno is used. */
|
|
|
|
char keystring[128];
|
|
|
|
#define FALSE 0
|
|
#define TRUE !FALSE
|
|
|
|
char *getenv();
|
|
int Lisp_Xinitialized = FALSE;
|
|
char sysout_name[1024]; /* Set by read_Xoption, in the X version. */
|
|
int sysout_size = 0; /* ditto */
|
|
|
|
#if defined(DOS) || defined (XWINDOW)
|
|
#include "devif.h"
|
|
extern DspInterface currentdsp;
|
|
#endif /* DOS || XWINDOW */
|
|
|
|
extern long MDate;
|
|
extern int nokbdflag;
|
|
extern int nomouseflag;
|
|
#ifdef DOS
|
|
extern void dispatch();
|
|
|
|
int dosdisplaymode = 0;
|
|
int twobuttonflag = FALSE;
|
|
int eurokbd = TRUE; /* Assume eurokbd by default. */
|
|
char *helpstring = "\n\
|
|
medley [sysout-name] [<options>] ...\n\
|
|
Where <options> are:\n\
|
|
sysout-name The filename of your sysout.(see manual.)\n\
|
|
-m <size> Virtual memory size in Mega Bytes(from 8 to 32)\n\
|
|
-vga Use standard VGA 640x480 screen resolution\n\
|
|
-vesa102 Use VESA 800x600 screen resolution\n\
|
|
-vesa104 Use VESA 1024x768 screen resolution\n\
|
|
-2button Force two button mouse handling\n\
|
|
-3button Force three button mouse handling\n\
|
|
-noeurokbd Force old style kbd handling (for 2.0 and earlier sysouts)\n\
|
|
-eurokbd Force new style kbd handling (for 2.01 and later sysouts)\n\
|
|
-nokbd Turn the kbd handling off (for debugging only)\n\
|
|
-nomouse Turn the mouse handling off (for debugging only)\n\
|
|
-info Print general info about the system\n\
|
|
-help Print this message\n";
|
|
#elif XWINDOW
|
|
char *helpstring = "\n\
|
|
either setenv LDESRCESYSOUT or do:\n\
|
|
medley [<sysout-name>] [<options>]\n\
|
|
-info Print general info about the system\n\
|
|
-help Print this message\n\
|
|
-k access-key Your access key\n\
|
|
-d[isplay] host:srv.scr The host, X server and screen you want Medley on\n\
|
|
-bw <pixels> The Medley screen borderwidth\n\
|
|
-g[eometry] <geom>] The Medley screen geometry\n\
|
|
-sc[reen] <w>x<h>] The Medley screen geometry\n";
|
|
#else /* not DOS, not XWINDOW */
|
|
char *helpstring = "\n\
|
|
either setenv LDESRCESYSOUT or do:\n\
|
|
lde[ether] [sysout-name] [-k access-key] [<options>]\n\
|
|
-info Print general info about the system\n\
|
|
-help Print this message\n";
|
|
#endif /* DOS */
|
|
/************************************************************************/
|
|
/* */
|
|
/* M A I N E N T R Y P O I N T */
|
|
/* */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
main(argc, argv)
|
|
int argc ;
|
|
char **argv ;
|
|
{
|
|
int i;
|
|
char *envname;
|
|
extern int TIMER_INTERVAL;
|
|
char keytyped [ 255 ];
|
|
|
|
#ifndef NOFORN
|
|
if (dld_find_executable (argv[0]) == 0) {
|
|
perror("Name of executable not found.");
|
|
} else if (dld_init (dld_find_executable (argv[0])) != 0) {
|
|
dld_perror( "Can't init DLD." );
|
|
};
|
|
#endif /* NOFORN */
|
|
|
|
#ifdef XWINDOW
|
|
read_Xoption( &argc, argv );
|
|
#endif /* XWINDOW */
|
|
|
|
|
|
save_argc = argc;
|
|
save_argv = argv;
|
|
|
|
#ifdef PROFILE
|
|
moncontrol(0); /* initially stop sampling */
|
|
#endif /* PROFILE */
|
|
|
|
|
|
/* Sysout is found as follows:
|
|
If the first argument doesn't begin with '-', assume it's the sysout
|
|
Look at the environment variable LDESRCESYSOUT if that fails
|
|
Look for ~/lisp.virtualmem if that fails
|
|
Barf and print the command line if tha fails
|
|
*/
|
|
|
|
#ifdef FSERROR
|
|
/* For call makepathname */
|
|
Lisp_errno = &Dummy_errno;
|
|
#endif
|
|
|
|
i=1;
|
|
|
|
if (argv[i] && ((strcmp(argv[i], "-info") == 0) ||
|
|
(strcmp(argv[i], "-INFO") == 0))) {
|
|
print_info_lines();
|
|
exit(0);
|
|
}
|
|
|
|
if (argv[i] &&
|
|
((strcmp(argv[i], "-help") == 0) ||
|
|
(strcmp(argv[i], "-HELP") == 0)))
|
|
{
|
|
fprintf(stderr, helpstring );
|
|
exit(0);
|
|
}
|
|
|
|
if(argc > 1 && argv[1][0] != '-')
|
|
{
|
|
strcpy(sysout_name, argv[1]);
|
|
i++;
|
|
}
|
|
else if ((envname = getenv("LDESRCESYSOUT")) != NULL)
|
|
{
|
|
strcpy(sysout_name, envname);
|
|
}
|
|
else if ((envname = getenv("LDESOURCESYSOUT")) != NULL)
|
|
strcpy(sysout_name, envname);
|
|
#ifdef DOS
|
|
else if( !makepathname("lisp.vm", sysout_name)
|
|
#else
|
|
else if( !makepathname("~/lisp.virtualmem", sysout_name)
|
|
#endif /* DOS */
|
|
|| access(sysout_name, R_OK))
|
|
{
|
|
fprintf(stderr, "Couldn't find a sysout to run;\n");
|
|
fprintf(stderr, helpstring );
|
|
exit(1);
|
|
}
|
|
/* OK, sysout name is now in sysout_name, and i is moved past a supplied name */
|
|
|
|
for ( ; i < argc; i += 1 )
|
|
{ /* step by 1 in case of typo */
|
|
|
|
/* -t and -m are undocumented and somewhat dangerous... */
|
|
|
|
if (! strcmp(argv[i], "-t"))
|
|
{ /**** timer interval ****/
|
|
if(argc > ++i) TIMER_INTERVAL = atoi(argv[i]);
|
|
else
|
|
{
|
|
fprintf(stderr, "Missing argument after -t\n");
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
else if (! strcmp(argv[i], "-m"))
|
|
{ /**** sysout size ****/
|
|
if(argc > ++i) sysout_size = atoi(argv[i]);
|
|
else
|
|
{
|
|
fprintf(stderr, "Missing argument after -m\n");
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
else if (! strcmp(argv[i], "-NF"))
|
|
{ /**** Don't fork (for dbxing) ****/
|
|
please_fork = 0;
|
|
}
|
|
|
|
else if ( ! strcmp(argv[i], "-INIT"))
|
|
{ /*** init sysout, no packaged */
|
|
for_makeinit = 1;
|
|
}
|
|
else if (! strcmp(argv[i], "-k"))
|
|
{ /**** security key ****/
|
|
|
|
if(argc > ++i) { (void)strcpy(keystring, argv[i]); }
|
|
else
|
|
{
|
|
fprintf(stderr, "Missing argument after -k\n");
|
|
exit(1);
|
|
}
|
|
}
|
|
|
|
#ifdef DOS
|
|
else if ((strcmp(argv[i], "-vga") == 0) ||
|
|
(strcmp(argv[i], "-VGA") == 0))
|
|
{
|
|
dosdisplaymode = 1;
|
|
}
|
|
else if ((strcmp(argv[i], "-vesa102") == 0) ||
|
|
(strcmp(argv[i], "-VESA102") == 0))
|
|
{
|
|
dosdisplaymode = 0x102;
|
|
}
|
|
else if ((strcmp(argv[i], "-vesa104") == 0) ||
|
|
(strcmp(argv[i], "-VESA104") == 0))
|
|
{
|
|
dosdisplaymode = 0x104;
|
|
}
|
|
else if ((strcmp(argv[i], "-2button") == 0) ||
|
|
(strcmp(argv[i], "-2BUTTON") == 0)) {
|
|
twobuttonflag = TRUE;
|
|
}
|
|
else if ((strcmp(argv[i], "-3button") == 0) ||
|
|
(strcmp(argv[i], "-3BUTTON") == 0)) {
|
|
twobuttonflag = FALSE;
|
|
}
|
|
else if ((strcmp(argv[i], "-noeurokbd") == 0) ||
|
|
(strcmp(argv[i], "-NOEUROKBD") == 0)) {
|
|
eurokbd = FALSE;
|
|
}
|
|
else if ((strcmp(argv[i], "-eurokbd") == 0) ||
|
|
(strcmp(argv[i], "-EUROKBD") == 0)) {
|
|
eurokbd = TRUE;
|
|
}
|
|
else if ((strcmp(argv[i], "-nokbd") == 0) ||
|
|
(strcmp(argv[i], "-NOKBD") == 0)) {
|
|
nokbdflag = TRUE;
|
|
}
|
|
else if ((strcmp(argv[i], "-nomouse") == 0) ||
|
|
(strcmp(argv[i], "-NOMOUSE") == 0)) {
|
|
nomouseflag = TRUE;
|
|
}
|
|
|
|
#endif /* DOS */
|
|
|
|
/* Can only do this under SUNOs, for now */
|
|
else if (! strcmp(argv[i], "-E"))
|
|
{ /**** ethernet info ****/
|
|
#ifdef NOETHER
|
|
#else
|
|
int b0, b1, b2, b3, b4, b5;
|
|
#ifdef USE_DLPI
|
|
if(argc > ++i && sscanf(argv[i],"%d:%x:%x:%x:%x:%x:%x",ðer_fd,
|
|
&b0, &b1, &b2, &b3, &b4, &b5) == 7)
|
|
#else
|
|
if(argc > ++i && sscanf(argv[i],"%d:%x:%x:%x:%x:%x:%x:%s",ðer_fd,
|
|
&b0, &b1, &b2, &b3, &b4, &b5, snit.snit_ifname) == 8)
|
|
#endif /* USE_FDLPI */
|
|
{
|
|
ether_host[0] = b0; ether_host[1] = b1;
|
|
ether_host[2] = b2; ether_host[3] = b3;
|
|
ether_host[4] = b4; ether_host[5] = b5;
|
|
}
|
|
else
|
|
{
|
|
fprintf(stderr, "Missing or bogus -E argument\n");
|
|
ether_fd = -1;
|
|
exit(1);
|
|
}
|
|
#endif /* NOETHER */
|
|
|
|
}
|
|
/* diagnostic flag for big vmem write() calls */
|
|
else if (! strcmp(argv[i], "-xpages"))
|
|
{
|
|
if(argc > ++i) maxpages = atoi(argv[i]);
|
|
else
|
|
{
|
|
fprintf(stderr, "Missing argument after -xpages\n");
|
|
exit(1);
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Sanity checks. */
|
|
#ifdef DOS
|
|
probemouse(); /* See if the mouse is connected. */
|
|
#else
|
|
if ( getuid() != geteuid() ) {
|
|
fprintf(stderr, "Effective user is not real user. Setting euid to uid.\n");
|
|
seteuid(getuid());
|
|
}
|
|
#endif /* DOS */
|
|
|
|
if ( keystring ) /* key given, so safe to copy */
|
|
strcpy ( keytyped, keystring );
|
|
|
|
if ( keytester(keystring) ) { /* keytester destroys keystring */
|
|
fprintf (stderr, "Sorry, invalid or expired access key.\n" );
|
|
fprintf (stderr, "Key tried: %s\n", keytyped );
|
|
exit(-1);
|
|
}
|
|
|
|
#ifndef NOETHER
|
|
init_ether(); /* modified by kiuchi Nov. 4 */
|
|
#endif /* NOETHER */
|
|
|
|
|
|
#ifdef FORKCOMM
|
|
/* Fork Unix was called in kickstarter; if we forked, look up the */
|
|
/* pipe handles to the subprocess and set them up. */
|
|
|
|
if(FindUnixPipes()) /* must call the routine to allocate storage, */
|
|
{ /* in case we're re-starting a savevm w/open ptys */
|
|
if(please_fork)
|
|
fprintf(stderr,
|
|
"Failed to find UNIXCOMM file handles; no processes\n");
|
|
}
|
|
#else
|
|
/* Fork Unix Interface subprocess before we create anything big; */
|
|
/* interrupts need to be blocked here so subprocess won't see them */
|
|
/* This should actually live in the kickstarter... */
|
|
|
|
#ifdef DOS
|
|
init_host_filesystem();
|
|
#else
|
|
if(please_fork){int_block(); fork_Unix();}
|
|
#endif /* DOS */
|
|
#endif /* FORKCOMM */
|
|
#if defined(DOS) || defined (XWINDOW)
|
|
make_dsp_instance(currentdsp, 0, 0, 0, 1 ); /* All defaults the first time */
|
|
#endif /* DOS || XWINDOW */
|
|
|
|
/* Load sysout to VM space and returns real sysout_size(not 0) */
|
|
sysout_size= sysout_loader(sysout_name, sysout_size);
|
|
|
|
build_lisp_map(); /* built up map */
|
|
|
|
init_ifpage(sysout_size); /* init interface page */
|
|
init_iopage();
|
|
init_miscstats();
|
|
#ifdef NEW_STORAGE
|
|
init_storage();
|
|
#endif /* NEW_STORAGE */
|
|
|
|
set_cursor();
|
|
|
|
/* file system directory enumeration stuff */
|
|
if (!init_finfo())
|
|
{
|
|
fprintf(stderr, "Cannot allocate internal data.\n");
|
|
exit(1);
|
|
}
|
|
#ifdef RS232
|
|
rs232c_init();
|
|
#endif
|
|
|
|
/* Get OS message to ~/lisp.log and print the message to prompt window */
|
|
if(!for_makeinit)
|
|
{
|
|
#ifdef SUNDISPLAY
|
|
mess_init();
|
|
#endif /* SUNDISPLAY */
|
|
|
|
init_keyboard(0); /* can't turn on the keyboard yet or you will die
|
|
in makeinit. Pilotbitblt will turn it on if
|
|
you used the proper switches when building LDE.
|
|
JDS -- 1/18/90 also BITBLTSUB does it now. */
|
|
}
|
|
|
|
#ifdef I386
|
|
/* 80387 initialization */
|
|
asm(".data");
|
|
asm(".align 4");
|
|
asm("__FP_trunc:");
|
|
asm(" .globl __FP_trunc");
|
|
asm(".byte 0x3f");
|
|
asm(".byte 0x0c");
|
|
asm("__FP_round:");
|
|
asm(" .globl __FP_round");
|
|
asm(".byte 0x3f");
|
|
asm(".byte 0x00");
|
|
asm(".text");
|
|
asm("fldcw __FP_round");
|
|
#elif DOS
|
|
_setrealmode(0x3f); /* Don't interrupt on FP overflows */
|
|
_getrealerror();
|
|
#endif /* I386 */
|
|
|
|
|
|
|
|
|
|
#ifdef RS6000
|
|
/****************************************************/
|
|
/* For the IBM RS/6000, we have to initialize its */
|
|
/* notion of the time zone, so gettimeofday works */
|
|
/****************************************************/
|
|
|
|
tzset();
|
|
#endif /* RS6000 */
|
|
|
|
#if defined(ISC) || defined(DOS)
|
|
tzset();
|
|
#endif
|
|
|
|
#ifdef OS5
|
|
tzset();
|
|
#endif /* OS5 */
|
|
|
|
|
|
/* now start up lisp */
|
|
start_lisp();
|
|
}
|
|
|
|
|
|
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* s t a r t _ l i s p */
|
|
/* */
|
|
/* This is the function that actually starts up the lisp emulator. */
|
|
/* */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
start_lisp()
|
|
{
|
|
DLword *freeptr,*next68k;
|
|
|
|
/*******************************/
|
|
/* First, turn off any pending interrupts from during VMEMSAVE. */
|
|
/* This keeps US from trying to handle OLD interrupts. */
|
|
/*******************************/
|
|
#ifndef INIT
|
|
{ INTSTAT * intstate =
|
|
((INTSTAT *)Addr68k_from_LADDR(*INTERRUPTSTATE_word));
|
|
intstate->ETHERInterrupt = 0;
|
|
intstate->LogFileIO = 0;
|
|
intstate->IOInterrupt = 0;
|
|
intstate->waitinginterrupt = 0;
|
|
intstate->intcharcode = 0;
|
|
}
|
|
#endif /* INIT */
|
|
|
|
TopOfStack=0;
|
|
Error_Exit = 0;
|
|
|
|
MState->pvar = (DLword *) Addr68k_from_LADDR( STK_OFFSET
|
|
| InterfacePage->currentfxp)
|
|
+ FRAMESIZE;
|
|
|
|
freeptr = next68k = Addr68k_from_LADDR(STK_OFFSET | CURRENTFX->nextblock);
|
|
|
|
if (GETWORD(next68k) != STK_FSB_WORD)
|
|
error("Starting Lisp: Next stack block isn't free!");
|
|
|
|
while(GETWORD(freeptr)==STK_FSB_WORD)
|
|
EndSTKP = freeptr = freeptr + GETWORD(freeptr+1);
|
|
|
|
CurrentStackPTR =next68k -2;
|
|
|
|
FastRetCALL;
|
|
|
|
/* JRB - The interrupt intitialization must be done right before */
|
|
/* entering the bytecode dispatch loop; interrupts get */
|
|
/* unblocked here */
|
|
int_init();
|
|
#ifdef DOS
|
|
_dpmi_lockregion((void *)&dispatch, 32768);
|
|
#endif /* DOS */
|
|
dispatch();
|
|
}
|
|
|
|
|
|
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* m a k e p a t h n a m e */
|
|
/* */
|
|
/* */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
makepathname(src, dst)
|
|
register char *src;
|
|
register char *dst;
|
|
{
|
|
register int len;
|
|
register char *base, *cp;
|
|
register struct passwd *pwd;
|
|
char name[MAXPATHLEN];
|
|
|
|
base = src;
|
|
switch ( *base )
|
|
{
|
|
case '.':
|
|
#ifdef DOS
|
|
if(getcwd(dst, MAXPATHLEN) == 0)
|
|
#else
|
|
if(getwd(dst) == 0)
|
|
#endif /* DOS */
|
|
{ /* set working directory */
|
|
#ifdef FSERROR
|
|
*Lisp_errno = errno;
|
|
#endif
|
|
return(0);
|
|
}
|
|
switch ( *(base+1) )
|
|
{
|
|
case '.':
|
|
if(*(base+2) == '/')
|
|
{ /* Now, base == "../xxxx" */
|
|
cp = (char *)strrchr(dst, '/');
|
|
if(cp == 0) return(0);
|
|
*cp = '\0';
|
|
strcat(dst, base+2);
|
|
return(1);
|
|
}
|
|
else return(0);
|
|
case '/':
|
|
/* Now, base == "./xxx" */
|
|
strcat(dst, base+1);
|
|
return(1);
|
|
default:
|
|
return(0);
|
|
}
|
|
case '~':
|
|
#ifdef FSERROR
|
|
ERRSETJMP(0);
|
|
#else
|
|
SETJMP(0);
|
|
#endif
|
|
if( *(base+1) == '/')
|
|
{
|
|
/* path is "~/foo" */
|
|
#ifdef DOS
|
|
pwd = 0;
|
|
#else
|
|
TIMEOUT( pwd = getpwuid( getuid()) );
|
|
#endif /* DOS */
|
|
if(pwd == NULL)
|
|
{
|
|
#ifdef FSERROR
|
|
*Lisp_errno = errno;
|
|
#endif
|
|
return(0);
|
|
}
|
|
#ifndef DOS
|
|
sprintf(dst, "%s%s", pwd->pw_dir, base+1);
|
|
#endif
|
|
return(1);
|
|
}
|
|
else
|
|
{
|
|
/* path is "~foo/" */
|
|
if((cp=(char *)strchr(base+1, '/')) == 0) return(0);
|
|
else
|
|
{
|
|
len = (UNSIGNED)cp - (UNSIGNED)base -1;
|
|
strncpy(name, base+1, len);
|
|
name[len] = '\0';
|
|
#ifndef DOS
|
|
TIMEOUT( pwd = getpwnam(name) );
|
|
#endif /* DOS */
|
|
if(pwd == NULL)
|
|
{
|
|
#ifdef FSERROR
|
|
*Lisp_errno = errno;
|
|
#endif
|
|
return(0);
|
|
}
|
|
#ifndef DOS
|
|
sprintf(dst, "%s%s", pwd->pw_dir, cp);
|
|
#endif /* DOS */
|
|
return(1);
|
|
}
|
|
}
|
|
default:
|
|
strcpy(dst, src);
|
|
return(1);
|
|
}
|
|
}
|
|
|
|
|
|
|
|
print_info_lines ()
|
|
{
|
|
#if (RELEASE == 200)
|
|
printf("Emulator for Medley release 2.0\n");
|
|
#elif (RELEASE == 201)
|
|
printf("Emulator for Medley release 2.01\n");
|
|
#elif (RELEASE == 210)
|
|
printf("Emulator for Medley release 2.1\n");
|
|
#elif (RELEASE == 300)
|
|
printf("Emulator for Medley release 3.0\n");
|
|
#elif (RELEASE == 350)
|
|
printf("Emulator for Medley release 3.5\n");
|
|
#elif (RELEASE == 351)
|
|
printf("Emulator for Medley release 3.51\n");
|
|
#endif /* RELEASE */
|
|
#if defined(MACOSX) || defined(FREEBSD)
|
|
printf("Creation date: %s", ctime((const time_t *)&MDate));
|
|
#else
|
|
printf("Creation date: %s", ctime(&MDate));
|
|
#endif
|
|
#ifdef DEMO
|
|
printf("Demonstration emulator, not for commercial use\n");
|
|
#endif /* DEMO */
|
|
#ifdef LPSOLVE
|
|
printf("Contains lp_solve LP solver.\n");
|
|
#endif /* LPSOLVE */
|
|
#ifdef BIGBIGVM
|
|
printf("Supports 256Mb virtual memory.\n");
|
|
#elif BIGVM
|
|
printf("Supports 64Mb virtual memory.\n");
|
|
#else
|
|
printf("Supports 32Mb virtual memory.\n");
|
|
#endif /* BIGVM */
|
|
#ifdef NOVERSION
|
|
printf("Does not enforce SYSOUT version matching.\n");
|
|
#endif /* NOVERSION */
|
|
#ifdef NOFORN
|
|
printf("Has no foreign-function-call interface.\n");
|
|
#endif /* NOFORN */
|
|
#ifdef NOEUROKBD
|
|
printf("No support for European keyboards.\n");
|
|
#else
|
|
printf("Supports Sun European Type-4/5 keyboards.\n");
|
|
#endif /* NOEUROKBD */
|
|
|
|
}
|