2007-10-25 16:27:34 -04:00
|
|
|
/*
|
|
|
|
* Ikarus Scheme -- A compiler for R6RS Scheme.
|
2008-01-29 00:34:34 -05:00
|
|
|
* Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
|
2007-10-25 16:27:34 -04:00
|
|
|
*
|
|
|
|
* This program is free software: you can redistribute it and/or modify
|
|
|
|
* it under the terms of the GNU General Public License version 3 as
|
|
|
|
* published by the Free Software Foundation.
|
|
|
|
*
|
|
|
|
* This program is distributed in the hope that it will be useful, but
|
|
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
* General Public License for more details.
|
|
|
|
*
|
|
|
|
* You should have received a copy of the GNU General Public License
|
|
|
|
* along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
*/
|
|
|
|
|
|
|
|
|
2006-11-23 19:38:26 -05:00
|
|
|
|
2007-11-12 03:31:14 -05:00
|
|
|
#include "bootfileloc.h"
|
2007-10-17 09:22:47 -04:00
|
|
|
#include "ikarus-data.h"
|
2006-11-23 19:38:26 -05:00
|
|
|
#include <stdio.h>
|
|
|
|
#include <stdlib.h>
|
|
|
|
#include <sys/types.h>
|
|
|
|
#include <sys/stat.h>
|
|
|
|
#include <fcntl.h>
|
|
|
|
#include <string.h>
|
|
|
|
#include <errno.h>
|
2006-11-23 19:48:14 -05:00
|
|
|
#include <gmp.h>
|
2006-12-24 01:43:20 -05:00
|
|
|
#include <signal.h>
|
2007-10-15 17:58:03 -04:00
|
|
|
#include <sys/mman.h>
|
2006-11-23 19:38:26 -05:00
|
|
|
|
2007-11-30 05:13:01 -05:00
|
|
|
|
2006-12-24 01:43:20 -05:00
|
|
|
void register_handlers();
|
|
|
|
void register_alt_stack();
|
|
|
|
|
2006-12-07 01:38:04 -05:00
|
|
|
|
2008-09-21 04:08:54 -04:00
|
|
|
ikpcb* the_pcb;
|
2007-10-17 09:22:47 -04:00
|
|
|
|
2006-12-01 11:18:01 -05:00
|
|
|
int
|
|
|
|
file_exists(char* filename){
|
|
|
|
struct stat sb;
|
|
|
|
int s = stat(filename, &sb);
|
|
|
|
return (s == 0);
|
|
|
|
}
|
|
|
|
|
2007-12-03 00:29:36 -05:00
|
|
|
extern int cpu_has_sse2();
|
|
|
|
|
2008-08-09 08:47:44 -04:00
|
|
|
int ikarus_main(int argc, char** argv, char* boot_file){
|
2007-12-03 00:29:36 -05:00
|
|
|
if(! cpu_has_sse2()){
|
|
|
|
fprintf(stderr, "Ikarus Scheme cannot run on your computer because\n");
|
|
|
|
fprintf(stderr, "your CPU does not support the SSE2 instruction set.\n");
|
|
|
|
fprintf(stderr, "Refer to the Ikarus Scheme User's Guide for the\n");
|
|
|
|
fprintf(stderr, "minimum hardware requirements.\n");
|
|
|
|
exit(-1);
|
|
|
|
}
|
2008-01-01 21:08:07 -05:00
|
|
|
if(sizeof(mp_limb_t) != sizeof(long int)){
|
2007-11-10 08:28:19 -05:00
|
|
|
fprintf(stderr, "ERROR: limb size does not match\n");
|
|
|
|
exit(-1);
|
2006-11-23 19:48:14 -05:00
|
|
|
}
|
2008-01-01 21:08:07 -05:00
|
|
|
if(mp_bits_per_limb != (8*sizeof(long int))){
|
2007-11-10 08:28:19 -05:00
|
|
|
fprintf(stderr, "ERROR: invalid bits_per_limb=%d\n", mp_bits_per_limb);
|
|
|
|
exit(-1);
|
2006-11-23 19:48:14 -05:00
|
|
|
}
|
2006-11-23 19:38:26 -05:00
|
|
|
ikpcb* pcb = ik_make_pcb();
|
2006-12-24 01:43:20 -05:00
|
|
|
the_pcb = pcb;
|
2006-12-01 09:52:12 -05:00
|
|
|
{ /* set up arg_list */
|
2007-12-23 13:37:48 -05:00
|
|
|
ikptr arg_list = null_object;
|
2006-12-01 09:52:12 -05:00
|
|
|
int i = argc-1;
|
|
|
|
while(i > 0){
|
|
|
|
char* s = argv[i];
|
|
|
|
int n = strlen(s);
|
2008-08-10 14:33:10 -04:00
|
|
|
ikptr bv = ik_unsafe_alloc(pcb, align(disp_bytevector_data+n+1))
|
|
|
|
+ bytevector_tag;
|
|
|
|
ref(bv, off_bytevector_length) = fix(n);
|
|
|
|
memcpy((char*)(bv+off_bytevector_data), s, n+1);
|
2007-12-23 13:37:48 -05:00
|
|
|
ikptr p = ik_unsafe_alloc(pcb, pair_size);
|
2008-08-10 14:33:10 -04:00
|
|
|
ref(p, disp_car) = bv;
|
2006-12-01 09:52:12 -05:00
|
|
|
ref(p, disp_cdr) = arg_list;
|
|
|
|
arg_list = p+pair_tag;
|
|
|
|
i--;
|
|
|
|
}
|
|
|
|
pcb->arg_list = arg_list;
|
|
|
|
}
|
2006-12-24 01:43:20 -05:00
|
|
|
register_handlers();
|
|
|
|
register_alt_stack();
|
2006-12-01 09:23:37 -05:00
|
|
|
ik_fasl_load(pcb, boot_file);
|
2006-11-29 18:45:13 -05:00
|
|
|
/*
|
2006-11-23 19:44:29 -05:00
|
|
|
fprintf(stderr, "collect time: %d.%03d utime, %d.%03d stime (%d collections)\n",
|
2006-11-29 18:45:13 -05:00
|
|
|
pcb->collect_utime.tv_sec,
|
|
|
|
pcb->collect_utime.tv_usec/1000,
|
|
|
|
pcb->collect_stime.tv_sec,
|
|
|
|
pcb->collect_stime.tv_usec/1000,
|
|
|
|
pcb->collection_id );
|
|
|
|
*/
|
2006-11-23 19:38:26 -05:00
|
|
|
ik_delete_pcb(pcb);
|
|
|
|
return 0;
|
|
|
|
}
|
|
|
|
|
2006-12-24 01:43:20 -05:00
|
|
|
#if 0
|
2007-09-09 20:58:47 -04:00
|
|
|
Notice how the bsd manpages have incorrect type for the handler.
|
|
|
|
|
2006-12-24 01:43:20 -05:00
|
|
|
#include <signal.h>
|
|
|
|
|
|
|
|
struct sigaction {
|
|
|
|
union {
|
|
|
|
void (*__sa_handler)(int);
|
|
|
|
void (*__sa_sigaction)(int, struct __siginfo *, void *);
|
|
|
|
} __sigaction_u; /* signal handler */
|
|
|
|
int sa_flags; /* see signal options below */
|
|
|
|
sigset_t sa_mask; /* signal mask to apply */
|
|
|
|
};
|
|
|
|
|
|
|
|
#define sa_handler __sigaction_u.__sa_handler
|
|
|
|
#define sa_sigaction __sigaction_u.__sa_sigaction
|
|
|
|
|
|
|
|
int
|
|
|
|
sigaction(int sig, const struct sigaction * restrict act,
|
|
|
|
struct sigaction * restrict oact);
|
|
|
|
#endif
|
2006-11-23 19:38:26 -05:00
|
|
|
|
2007-09-09 20:58:47 -04:00
|
|
|
void handler(int signo, siginfo_t* info, void* uap){
|
2008-06-04 03:54:53 -04:00
|
|
|
signo=signo; info=info; uap=uap; /* no warning */
|
2008-04-29 00:10:49 -04:00
|
|
|
the_pcb->engine_counter = fix(-1);
|
2006-12-24 01:43:20 -05:00
|
|
|
the_pcb->interrupted = 1;
|
|
|
|
}
|
|
|
|
|
|
|
|
void
|
|
|
|
register_handlers(){
|
|
|
|
struct sigaction sa;
|
2007-08-28 21:27:37 -04:00
|
|
|
sa.sa_sigaction = handler;
|
2007-10-16 02:10:51 -04:00
|
|
|
#ifdef __CYGWIN__
|
|
|
|
sa.sa_flags = SA_SIGINFO;
|
|
|
|
#else
|
2006-12-24 01:43:20 -05:00
|
|
|
sa.sa_flags = SA_SIGINFO | SA_ONSTACK;
|
2007-10-16 02:10:51 -04:00
|
|
|
#endif
|
2007-08-29 01:45:10 -04:00
|
|
|
sigemptyset(&sa.sa_mask);
|
2006-12-24 01:43:20 -05:00
|
|
|
int err = sigaction(SIGINT, &sa, 0);
|
|
|
|
if(err){
|
|
|
|
fprintf(stderr, "Sigaction Failed: %s\n", strerror(errno));
|
|
|
|
exit(-1);
|
|
|
|
}
|
2008-01-21 23:29:04 -05:00
|
|
|
|
|
|
|
/* ignore sigpipes */
|
|
|
|
{
|
|
|
|
sigset_t set;
|
|
|
|
sigprocmask(0, 0, &set); /* get the set */
|
|
|
|
sigaddset(&set, SIGPIPE);
|
|
|
|
int err = sigprocmask(SIG_SETMASK, &set, &set);
|
|
|
|
if(err){
|
|
|
|
fprintf(stderr, "Sigprocmask Failed: %s\n", strerror(errno));
|
|
|
|
exit(-1);
|
|
|
|
}
|
|
|
|
}
|
2006-12-24 01:43:20 -05:00
|
|
|
}
|
2006-11-23 19:38:26 -05:00
|
|
|
|
2006-12-24 01:43:20 -05:00
|
|
|
|
|
|
|
#if 0
|
|
|
|
SYNOPSIS
|
|
|
|
#include <sys/types.h>
|
|
|
|
#include <signal.h>
|
|
|
|
|
|
|
|
struct sigaltstack {
|
|
|
|
char *ss_sp;
|
|
|
|
int ss_size;
|
|
|
|
int ss_flags;
|
|
|
|
};
|
|
|
|
|
|
|
|
int
|
|
|
|
sigaltstack(const struct sigaltstack *ss, struct sigaltstack *oss);
|
|
|
|
#endif
|
|
|
|
|
|
|
|
void
|
|
|
|
register_alt_stack(){
|
2008-01-07 19:04:46 -05:00
|
|
|
#if HAVE_SIGALTSTACK
|
2007-10-18 00:16:53 -04:00
|
|
|
char* stk = mmap(0, SIGSTKSZ, PROT_READ|PROT_WRITE|PROT_EXEC,
|
|
|
|
MAP_PRIVATE|MAP_ANON, -1, 0);
|
2007-10-15 17:58:03 -04:00
|
|
|
// char* stk = ik_mmap(SIGSTKSZ);
|
|
|
|
if(stk == (char*)-1){
|
2006-12-24 01:43:20 -05:00
|
|
|
fprintf(stderr, "Cannot maloc an alt stack\n");
|
|
|
|
exit(-1);
|
|
|
|
}
|
|
|
|
|
2007-11-30 05:13:01 -05:00
|
|
|
stack_t sa;
|
2006-12-24 01:43:20 -05:00
|
|
|
sa.ss_sp = stk;
|
|
|
|
sa.ss_size = SIGSTKSZ;
|
|
|
|
sa.ss_flags = 0;
|
|
|
|
int err = sigaltstack(&sa, 0);
|
|
|
|
if(err){
|
|
|
|
fprintf(stderr, "Cannot set alt stack: %s\n", strerror(errno));
|
|
|
|
exit(-1);
|
|
|
|
}
|
2007-10-15 17:58:03 -04:00
|
|
|
#endif
|
2006-12-24 01:43:20 -05:00
|
|
|
}
|