scheme-script is now its own program; it does not fork and exec

ikarus, and therefore does not interfere with ikarus's command line
parsing.
This commit is contained in:
Abdulaziz Ghuloum 2008-08-09 05:47:44 -07:00
parent c5930ac113
commit e24356eb4a
9 changed files with 219 additions and 136 deletions

View File

@ -332,7 +332,7 @@
(define non-8bit-registers (define non-8bit-registers
(case wordsize (case wordsize
[(4) '(%edi)] [(4) '(%edi)]
[else '(%edi %r8 %r9 %r10 %r11 %r14 %r15)])) [else '(%edi)]))
(define argc-register '%eax) (define argc-register '%eax)
@ -2562,7 +2562,9 @@
[else (error who "invalid reg/h" x)])) [else (error who "invalid reg/h" x)]))
(define (reg/l x) (define (reg/l x)
(cond (cond
[(assq x '([%eax %al] [%ebx %bl] [%ecx %cl] [%edx %dl])) [(assq x '([%eax %al] [%ebx %bl] [%ecx %cl] [%edx %dl]
[%r8 %r8l] [%r9 %r9l] [%r10 %r10l] [%r11 %r11l]
[%r12 %r12l] [%r13 %r13l] [%r14 %r14l] [%r15 %r15l]))
=> cadr] => cadr]
[else (error who "invalid reg/l" x)])) [else (error who "invalid reg/l" x)]))
(define (R/cl x) (define (R/cl x)

View File

@ -80,6 +80,15 @@
[xmm5 xmm 5 #f] [xmm5 xmm 5 #f]
[xmm6 xmm 6 #f] [xmm6 xmm 6 #f]
[xmm7 xmm 7 #f] [xmm7 xmm 7 #f]
[%r8l 8 0 #t]
[%r9l 8 1 #t]
[%r10l 8 2 #t]
[%r11l 8 3 #t]
[%r12l 8 4 #t]
[%r13l 8 5 #t]
[%r14l 8 6 #t]
[%r15l 8 7 #t]
)) ))
(define register-index (define register-index
@ -457,10 +466,13 @@
(REX.R #b101 ac) (REX.R #b101 ac)
(REX.R #b100 ac))] (REX.R #b100 ac))]
[(and (reg32? a0) (reg32? a1)) [(and (reg32? a0) (reg32? a1))
(error 'REC+RM "not here 3") (if (reg-requires-REX? a0)
(if (or (reg-requires-REX? a0) (reg-requires-REX? a1)) (if (reg-requires-REX? a1)
(error 'REX+RM "unhandled4" a0 a1) (REX.R #b111 ac)
(error 'REX+RM "unhandleda" a1))] (REX.R #b110 ac))
(if (reg-requires-REX? a1)
(REX.R #b101 ac)
(REX.R #b100 ac)))]
[(and (imm? a0) (imm? a1)) [(and (imm? a0) (imm? a1))
(error 'REC+RM "not here 4") (error 'REC+RM "not here 4")
(error 'REX+RM "unhandledb" a1)] (error 'REX+RM "unhandledb" a1)]

View File

@ -1 +1 @@
1576 1577

View File

@ -1,15 +1,16 @@
bin_PROGRAMS = ikarus scheme-script bin_PROGRAMS = ikarus scheme-script
ikarus_SOURCES = ikarus-collect.c ikarus-exec.c ikarus-fasl.c \ SRCS = ikarus-collect.c ikarus-exec.c ikarus-fasl.c \
ikarus-flonums.c ikarus-main.c ikarus-numerics.c ikarus-print.c \ ikarus-flonums.c ikarus-main.c ikarus-numerics.c ikarus-print.c \
ikarus-runtime.c ikarus-symbol-table.c ikarus-verify-integrity.c \ ikarus-runtime.c ikarus-symbol-table.c ikarus-verify-integrity.c \
ikarus-weak-pairs.c ikarus-winmmap.c ikarus-data.h \ ikarus-weak-pairs.c ikarus-winmmap.c ikarus-data.h \
ikarus-winmmap.h ikarus-enter.S cpu_has_sse2.S ikarus-io.c \ ikarus-winmmap.h ikarus-enter.S cpu_has_sse2.S ikarus-io.c \
ikarus-process.c ikarus-getaddrinfo.h ikarus-getaddrinfo.c \ ikarus-process.c ikarus-getaddrinfo.h ikarus-getaddrinfo.c \
ikarus-errno.c ikarus-errno.c ikarus-main.h
scheme_script_SOURCES = scheme-script.c ikarus_SOURCES = $(SRCS) ikarus.c
scheme_script_SOURCES = $(SRCS) scheme-script.c
nodist_ikarus_SOURCES = bootfileloc.h nodist_ikarus_SOURCES = bootfileloc.h
BUILT_SOURCES = bootfileloc.h BUILT_SOURCES = bootfileloc.h

View File

@ -46,7 +46,7 @@ CONFIG_CLEAN_FILES =
am__installdirs = "$(DESTDIR)$(bindir)" am__installdirs = "$(DESTDIR)$(bindir)"
binPROGRAMS_INSTALL = $(INSTALL_PROGRAM) binPROGRAMS_INSTALL = $(INSTALL_PROGRAM)
PROGRAMS = $(bin_PROGRAMS) PROGRAMS = $(bin_PROGRAMS)
am_ikarus_OBJECTS = ikarus-collect.$(OBJEXT) ikarus-exec.$(OBJEXT) \ am__objects_1 = ikarus-collect.$(OBJEXT) ikarus-exec.$(OBJEXT) \
ikarus-fasl.$(OBJEXT) ikarus-flonums.$(OBJEXT) \ ikarus-fasl.$(OBJEXT) ikarus-flonums.$(OBJEXT) \
ikarus-main.$(OBJEXT) ikarus-numerics.$(OBJEXT) \ ikarus-main.$(OBJEXT) ikarus-numerics.$(OBJEXT) \
ikarus-print.$(OBJEXT) ikarus-runtime.$(OBJEXT) \ ikarus-print.$(OBJEXT) ikarus-runtime.$(OBJEXT) \
@ -56,10 +56,11 @@ am_ikarus_OBJECTS = ikarus-collect.$(OBJEXT) ikarus-exec.$(OBJEXT) \
cpu_has_sse2.$(OBJEXT) ikarus-io.$(OBJEXT) \ cpu_has_sse2.$(OBJEXT) ikarus-io.$(OBJEXT) \
ikarus-process.$(OBJEXT) ikarus-getaddrinfo.$(OBJEXT) \ ikarus-process.$(OBJEXT) ikarus-getaddrinfo.$(OBJEXT) \
ikarus-errno.$(OBJEXT) ikarus-errno.$(OBJEXT)
am_ikarus_OBJECTS = $(am__objects_1) ikarus.$(OBJEXT)
nodist_ikarus_OBJECTS = nodist_ikarus_OBJECTS =
ikarus_OBJECTS = $(am_ikarus_OBJECTS) $(nodist_ikarus_OBJECTS) ikarus_OBJECTS = $(am_ikarus_OBJECTS) $(nodist_ikarus_OBJECTS)
ikarus_LDADD = $(LDADD) ikarus_LDADD = $(LDADD)
am_scheme_script_OBJECTS = scheme-script.$(OBJEXT) am_scheme_script_OBJECTS = $(am__objects_1) scheme-script.$(OBJEXT)
scheme_script_OBJECTS = $(am_scheme_script_OBJECTS) scheme_script_OBJECTS = $(am_scheme_script_OBJECTS)
scheme_script_LDADD = $(LDADD) scheme_script_LDADD = $(LDADD)
DEFAULT_INCLUDES = -I. -I$(top_builddir)@am__isrc@ DEFAULT_INCLUDES = -I. -I$(top_builddir)@am__isrc@
@ -177,15 +178,16 @@ target_os = @target_os@
target_vendor = @target_vendor@ target_vendor = @target_vendor@
top_builddir = @top_builddir@ top_builddir = @top_builddir@
top_srcdir = @top_srcdir@ top_srcdir = @top_srcdir@
ikarus_SOURCES = ikarus-collect.c ikarus-exec.c ikarus-fasl.c \ SRCS = ikarus-collect.c ikarus-exec.c ikarus-fasl.c \
ikarus-flonums.c ikarus-main.c ikarus-numerics.c ikarus-print.c \ ikarus-flonums.c ikarus-main.c ikarus-numerics.c ikarus-print.c \
ikarus-runtime.c ikarus-symbol-table.c ikarus-verify-integrity.c \ ikarus-runtime.c ikarus-symbol-table.c ikarus-verify-integrity.c \
ikarus-weak-pairs.c ikarus-winmmap.c ikarus-data.h \ ikarus-weak-pairs.c ikarus-winmmap.c ikarus-data.h \
ikarus-winmmap.h ikarus-enter.S cpu_has_sse2.S ikarus-io.c \ ikarus-winmmap.h ikarus-enter.S cpu_has_sse2.S ikarus-io.c \
ikarus-process.c ikarus-getaddrinfo.h ikarus-getaddrinfo.c \ ikarus-process.c ikarus-getaddrinfo.h ikarus-getaddrinfo.c \
ikarus-errno.c ikarus-errno.c ikarus-main.h
scheme_script_SOURCES = scheme-script.c ikarus_SOURCES = $(SRCS) ikarus.c
scheme_script_SOURCES = $(SRCS) scheme-script.c
nodist_ikarus_SOURCES = bootfileloc.h nodist_ikarus_SOURCES = bootfileloc.h
BUILT_SOURCES = bootfileloc.h BUILT_SOURCES = bootfileloc.h
CLEANFILES = bootfileloc.h CLEANFILES = bootfileloc.h
@ -277,6 +279,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-verify-integrity.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-verify-integrity.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-weak-pairs.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-weak-pairs.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-winmmap.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus-winmmap.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ikarus.Po@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scheme-script.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/scheme-script.Po@am__quote@
.S.o: .S.o:

View File

@ -34,91 +34,8 @@
void register_handlers(); void register_handlers();
void register_alt_stack(); void register_alt_stack();
void ikarus_usage_short(){
fprintf(stderr, "ikarus -h for more help\n");
}
void ikarus_usage(){
static char* helpstring =
"\n\
Options for running ikarus scheme:\n\
\n ikarus -h\n\
Prints this help message then exits.\n\
\n ikarus [-b <bootfile>] --r6rs-script <scriptfile> opts ...\n\
Starts ikarus in r6rs-script mode. The script file is treated\n\
as an R6RS-script. The options opts ... can be obtained using\n\
the \"command-line\" procedure in the (rnrs programs) library.\n\
\n ikarus [-b <bootfile>] <file> ... [-- opts ...]\n\
Starts ikarus in interactive mode. Each of the files is first\n\
loaded into the interaction environment before the interactive\n\
repl is started. The options opts can be obtained using the\n\
\"command-line\" procedure.\n\
\n\
If the option [-b <bootfile>] is provided, the bootfile is used\n\
as the system's initial boot file from which the environment is\n\
initialized. If the -b option is not supplied, the default boot\n\
file is used. The current default boot file location is\n\
\"%s\".\n\
Consult the Ikarus Scheme User's Guide for more details.\n\n";
fprintf(stderr, helpstring, BOOTFILE);
}
ikpcb* the_pcb; ikpcb* the_pcb;
/* get_option
takes pointers to argc and argv and looks for the first
option matching opt. If one exists, it removes it from the argv
list, updates argc, and returns a pointer to the option value.
returns null if option is not found.
*/
char*
get_option(char* opt, int argc, char** argv){
int i;
for(i=1; i<argc; i++){
if(strcmp(opt, argv[i]) == 0){
if((i+1) < argc){
char* rv = argv[i+1];
int j;
for(j=i+2; j<argc; j++, i++){
argv[i] = argv[j];
}
return rv;
}
else {
fprintf(stderr,
"ikarus error: option %s requires a value, none provided\n",
opt);
ikarus_usage_short();
exit(-1);
}
}
else if(strcmp("--", argv[i]) == 0){
return 0;
}
}
return 0;
}
int
get_option0(char* opt, int argc, char** argv){
int i;
for(i=1; i<argc; i++){
if(strcmp(opt, argv[i]) == 0){
int j;
for(j=i+1; j<argc; j++, i++){
argv[i] = argv[j];
}
return 1;
}
else if(strcmp("--", argv[i]) == 0){
return 0;
}
}
return 0;
}
int int
file_exists(char* filename){ file_exists(char* filename){
@ -129,7 +46,7 @@ file_exists(char* filename){
extern int cpu_has_sse2(); extern int cpu_has_sse2();
int main(int argc, char** argv){ int ikarus_main(int argc, char** argv, char* boot_file){
if(! cpu_has_sse2()){ if(! cpu_has_sse2()){
fprintf(stderr, "Ikarus Scheme cannot run on your computer because\n"); 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, "your CPU does not support the SSE2 instruction set.\n");
@ -137,16 +54,6 @@ int main(int argc, char** argv){
fprintf(stderr, "minimum hardware requirements.\n"); fprintf(stderr, "minimum hardware requirements.\n");
exit(-1); exit(-1);
} }
if(get_option0("-h", argc, argv)){
ikarus_usage();
exit(0);
}
char* boot_file = get_option("-b", argc, argv);
if(boot_file){
argc -= 2;
} else {
boot_file = BOOTFILE;
}
if(sizeof(mp_limb_t) != sizeof(long int)){ if(sizeof(mp_limb_t) != sizeof(long int)){
fprintf(stderr, "ERROR: limb size does not match\n"); fprintf(stderr, "ERROR: limb size does not match\n");
exit(-1); exit(-1);

23
src/ikarus-main.h Normal file
View File

@ -0,0 +1,23 @@
/*
* Ikarus Scheme -- A compiler for R6RS Scheme.
* Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
*
* 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/>.
*/
#ifndef IKARUS_MAIN
#define IKARUS_MAIN
int ikarus_main(int argc, char** argv, char* boot_file);
#endif

124
src/ikarus.c Normal file
View File

@ -0,0 +1,124 @@
/*
* Ikarus Scheme -- A compiler for R6RS Scheme.
* Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
*
* 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/>.
*/
#include "ikarus-main.h"
#include "bootfileloc.h"
#include <stdio.h>
#include <string.h>
#include <stdio.h>
#include <stdlib.h>
void ikarus_usage_short(){
fprintf(stderr, "ikarus -h for more help\n");
}
void ikarus_usage(){
static char* helpstring =
"\n\
Options for running ikarus scheme:\n\
\n ikarus -h\n\
Prints this help message then exits.\n\
\n ikarus [-b <bootfile>] --r6rs-script <scriptfile> opts ...\n\
Starts ikarus in r6rs-script mode. The script file is treated\n\
as an R6RS-script. The options opts ... can be obtained using\n\
the \"command-line\" procedure in the (rnrs programs) library.\n\
\n ikarus [-b <bootfile>] <file> ... [-- opts ...]\n\
Starts ikarus in interactive mode. Each of the files is first\n\
loaded into the interaction environment before the interactive\n\
repl is started. The options opts can be obtained using the\n\
\"command-line\" procedure.\n\
\n\
If the option [-b <bootfile>] is provided, the bootfile is used\n\
as the system's initial boot file from which the environment is\n\
initialized. If the -b option is not supplied, the default boot\n\
file is used. The current default boot file location is\n\
\"%s\".\n\
Consult the Ikarus Scheme User's Guide for more details.\n\n";
fprintf(stderr, helpstring, BOOTFILE);
}
/* get_option
takes pointers to argc and argv and looks for the first
option matching opt. If one exists, it removes it from the argv
list, updates argc, and returns a pointer to the option value.
returns null if option is not found.
*/
char*
get_option(char* opt, int argc, char** argv){
int i;
for(i=1; i<argc; i++){
if(strcmp(opt, argv[i]) == 0){
if((i+1) < argc){
char* rv = argv[i+1];
int j;
for(j=i+2; j<argc; j++, i++){
argv[i] = argv[j];
}
return rv;
}
else {
fprintf(stderr,
"ikarus error: option %s requires a value, none provided\n",
opt);
ikarus_usage_short();
exit(-1);
}
}
else if(strcmp("--", argv[i]) == 0){
return 0;
}
}
return 0;
}
int
get_option0(char* opt, int argc, char** argv){
int i;
for(i=1; i<argc; i++){
if(strcmp(opt, argv[i]) == 0){
int j;
for(j=i+1; j<argc; j++, i++){
argv[i] = argv[j];
}
return 1;
}
else if(strcmp("--", argv[i]) == 0){
return 0;
}
}
return 0;
}
int main(int argc, char** argv){
if(get_option0("-h", argc, argv)){
ikarus_usage();
exit(0);
}
char* boot_file = get_option("-b", argc, argv);
if(boot_file){
argc -= 2;
} else {
boot_file = BOOTFILE;
}
return ikarus_main(argc, argv, boot_file);
}

View File

@ -15,35 +15,46 @@
* along with this program. If not, see <http://www.gnu.org/licenses/>. * along with this program. If not, see <http://www.gnu.org/licenses/>.
*/ */
#include <unistd.h>
#include "ikarus-main.h"
#include "bootfileloc.h"
#include <stdio.h>
#include <string.h>
#include <stdio.h> #include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <errno.h>
#include <string.h>
#include "bootfileloc.h"
int main(int argc, char** argv){ void ikarus_usage_short(){
if(argc >= 2){ fprintf(stderr, "scheme-script <script-name> arguments ...\n");
char** a = calloc(argc+2, sizeof(char*));
if(! a) {
fprintf(stderr, "Error in scheme-script: cannot calloc\n");
exit(-1);
}
a[0] = EXEFILE;
a[1] = "--r6rs-script";
int i;
for(i=1; i<argc; i++){
a[i+1] = argv[i];
}
a[argc+1] = 0;
execv(EXEFILE, a);
fprintf(stderr, "Error executing ikarus from scheme-script: %s\n",
strerror(errno));
exit(-1);
} else {
fprintf(stderr,
"Error in scheme-script: you must provide a script name as an argument\n");
exit(-1);
}
} }
void ikarus_usage(){
static char* helpstring =
"Usage: \n\
scheme-script <script-name> arguments ...\n\
\n\
Runs the file <script-name> as a Scheme script, passing\n\
arguments ... as (command-line)\n\
\n\
Consult the Ikarus Scheme User's Guide for more details.\n\n";
fprintf(stderr, helpstring);
}
int main(int argc, char** argv){
if(argc < 2) {
ikarus_usage();
exit(-1);
}
char* boot_file = BOOTFILE;
char** args = calloc(sizeof(char*), argc+1);
args[0] = argv[0];
args[1] = "--r6rs-script";
args[2] = argv[1];
int i;
for(i=1; i<argc; i++){
args[i+1] = argv[i];
}
return ikarus_main(argc+1, args, boot_file);
}