Back to index

plt-scheme  4.2.1
main.c
Go to the documentation of this file.
00001 /*
00002   MzScheme
00003   Copyright (c) 2004-2009 PLT Scheme Inc.
00004   Copyright (c) 1995-2000 Matthew Flatt
00005 
00006     This library is free software; you can redistribute it and/or
00007     modify it under the terms of the GNU Library General Public
00008     License as published by the Free Software Foundation; either
00009     version 2 of the License, or (at your option) any later version.
00010 
00011     This library is distributed in the hope that it will be useful,
00012     but WITHOUT ANY WARRANTY; without even the implied warranty of
00013     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00014     Library General Public License for more details.
00015 
00016     You should have received a copy of the GNU Library General Public
00017     License along with this library; if not, write to the Free
00018     Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
00019     Boston, MA 02110-1301 USA.
00020 
00021   libscheme
00022   Copyright (c) 1994 Brent Benson
00023   All rights reserved.
00024 */
00025 
00026 /* This file defines MzScheme's main(), which is a jumble of
00027    platform-specific initialization. The included file "cmdline.inc"
00028    implements command-line parsing. (MrEd also uses "cmdline.inc".)
00029 
00030    The rest of the source code resides in the `src' subdirectory
00031    (except for the garbage collector, which is in `gc', `sgc', or
00032    `gc2', depending on which one you're using). */
00033 
00034 #include "scheme.h"
00035 
00036 /*========================================================================*/
00037 /*                       configuration and includes                       */
00038 /*========================================================================*/
00039 
00040 /* #define STANDALONE_WITH_EMBEDDED_EXTENSION */
00041 /*    STANDALONE_WITH_EMBEDDED_EXTENSION builds an executable with
00042       built-in extensions. The extension is initialized by calling
00043       scheme_initialize(env), where `env' is the initial environment.
00044       By default, command-line parsing, the REPL, and initilization
00045       file loading are turned off. */
00046 
00047 #ifdef STANDALONE_WITH_EMBEDDED_EXTENSION
00048 # define DONT_PARSE_COMMAND_LINE
00049 # define DONT_RUN_REP
00050 # define DONT_LOAD_INIT_FILE
00051 #endif
00052 
00053 #ifdef MZ_XFORM
00054 START_XFORM_SUSPEND;
00055 #endif
00056 
00057 #ifdef FILES_HAVE_FDS
00058 # include <sys/types.h>
00059 # include <sys/time.h>
00060 # ifdef SELECT_INCLUDE
00061 #  include <sys/select.h>
00062 # endif
00063 #endif
00064 #ifndef NO_USER_BREAK_HANDLER
00065 # include <signal.h>
00066 #endif
00067 #ifdef UNISTD_INCLUDE
00068 # include <unistd.h>
00069 #endif
00070 #ifdef MACINTOSH_EVENTS
00071 # ifndef OS_X
00072 #  include <Events.h>
00073 # endif
00074 #endif
00075 #ifdef MACINTOSH_EVENTS
00076 # ifndef OS_X
00077 #  include "simpledrop.h"
00078 # endif
00079 #endif
00080 
00081 #ifdef MZ_XFORM
00082 END_XFORM_SUSPEND;
00083 #endif
00084 
00085 #ifdef WIN32_THREADS
00086 /* Only set up for Boehm GC that thinks it's a DLL: */
00087 # include <windows.h>
00088 # define GC_THINKS_ITS_A_DLL_BUT_ISNT
00089 #endif
00090 #ifdef GC_THINKS_ITS_A_DLL_BUT_ISNT
00091 extern BOOL WINAPI DllMain(HINSTANCE inst, ULONG reason, LPVOID reserved);
00092 #endif
00093 
00094 /*========================================================================*/
00095 /*                configuration for command-line parsing                  */
00096 /*========================================================================*/
00097 
00098 #ifndef DONT_LOAD_INIT_FILE
00099 static char *get_init_filename(Scheme_Env *env)
00100 {
00101   Scheme_Object *f;
00102   Scheme_Thread * volatile p;
00103   mz_jmp_buf * volatile save, newbuf;
00104 
00105   p = scheme_get_current_thread();
00106   save = p->error_buf;
00107   p->error_buf = &newbuf;
00108 
00109   if (!scheme_setjmp(newbuf)) {
00110     f = scheme_builtin_value("find-system-path");
00111     if (f) {
00112       Scheme_Object *a[1];
00113 
00114       a[0] = scheme_intern_symbol("init-file");
00115 
00116       f = _scheme_apply(f, 1, a);
00117 
00118       if (SCHEME_PATHP(f)) {
00119        p->error_buf = save;
00120        return SCHEME_PATH_VAL(f);
00121       }
00122     }
00123   }
00124   p->error_buf = save;
00125 
00126   return NULL;
00127 }
00128 #endif
00129 
00130 #ifdef STANDALONE_WITH_EMBEDDED_EXTENSION
00131 extern Scheme_Object *scheme_initialize(Scheme_Env *env);
00132 #endif
00133 
00134 #ifdef EXPAND_FILENAME_TILDE
00135 # define INIT_FILENAME "~/.mzschemerc"
00136 #else
00137 # ifdef DOS_FILE_SYSTEM
00138 #  define INIT_FILENAME "%%HOMEDRIVE%%\\%%HOMEPATH%%\\mzschemerc.ss"
00139 # else
00140 #  define INIT_FILENAME "PREFERENCES:mzschemerc.ss"
00141 # endif
00142 #endif
00143 #define GET_INIT_FILENAME get_init_filename
00144 #define PRINTF printf
00145 #define PROGRAM "MzScheme"
00146 #define PROGRAM_LC "mzscheme"
00147 #define INITIAL_BIN_TYPE "zi"
00148 #define BANNER scheme_banner()
00149 #define MZSCHEME_CMD_LINE
00150 #define INITIAL_NAMESPACE_MODULE "scheme/init"
00151 
00152 /*========================================================================*/
00153 /*                        command-line parsing                            */
00154 /*========================================================================*/
00155 
00156 #include "cmdline.inc"
00157 
00158 /*========================================================================*/
00159 /*                             OSKit glue                                 */
00160 /*========================================================================*/
00161 
00162 #include "oskglue.inc"
00163 
00164 /*========================================================================*/
00165 /*                           ctl-C handler                                */
00166 /*========================================================================*/
00167 
00168 #ifndef NO_USER_BREAK_HANDLER
00169 
00170 static void user_break_hit(int ignore)
00171 {
00172   scheme_break_main_thread();
00173   scheme_signal_received();
00174 
00175 #  ifdef SIGSET_NEEDS_REINSTALL
00176   MZ_SIGSET(SIGINT, user_break_hit);
00177 #  endif
00178 #  ifdef MZ_PRECISE_GC
00179 #   ifndef GC_STACK_CALLEE_RESTORE
00180   /* Restore variable stack. */
00181   GC_variable_stack = (void **)__gc_var_stack__[0];
00182 #   endif
00183 #  endif
00184 }
00185 
00186 #endif
00187 
00188 /*========================================================================*/
00189 /*                                 main                                   */
00190 /*========================================================================*/
00191 
00192 #ifdef USE_SENORA_GC
00193 # include "sgc/sgc.h"
00194 #endif
00195 
00196 /* Forward declarations: */
00197 static void do_scheme_rep(Scheme_Env *);
00198 static int cont_run(FinishArgs *f);
00199 
00200 #if defined(WINDOWS_UNICODE_SUPPORT) && !defined(__CYGWIN32__)
00201 # define MAIN wmain
00202 # define MAIN_char wchar_t
00203 # define MAIN_argv wargv
00204 # define WINDOWS_UNICODE_MAIN
00205 #else
00206 # define MAIN main
00207 # define MAIN_char char
00208 # define MAIN_argv argv
00209 #endif
00210 
00211 /*****************************     main    ********************************/
00212 /*          Prepare for delayload, then call main_after_dlls              */
00213 
00214 static int main_after_dlls(int argc, MAIN_char **MAIN_argv);
00215 static int main_after_stack(void *data);
00216 
00217 # ifdef MZ_PRECISE_GC
00218 START_XFORM_SKIP;
00219 # endif
00220 
00221 int MAIN(int argc, MAIN_char **MAIN_argv)
00222 {
00223 #ifdef DOS_FILE_SYSTEM
00224   /* Order matters: load dependencies first */
00225 # ifndef MZ_PRECISE_GC
00226   load_delayed_dll(NULL, "libmzgcxxxxxxx.dll");
00227 # endif
00228   load_delayed_dll(NULL, "libmzsch" DLL_3M_SUFFIX "xxxxxxx.dll");
00229   record_dll_path();
00230 #endif
00231 
00232   return main_after_dlls(argc, MAIN_argv);
00233 }
00234 
00235 # ifdef MZ_PRECISE_GC
00236 END_XFORM_SKIP;
00237 # endif
00238 
00239 /************************     main_after_dlls    **************************/
00240 /*        Prep stack for GC, then call main_after_stack (indirectly)      */
00241 
00242 typedef struct {
00243   int argc;
00244   MAIN_char **argv;
00245 } Main_Args;
00246 
00247 static int main_after_dlls(int argc, MAIN_char **argv)
00248 {
00249   Main_Args ma;
00250   ma.argc = argc;
00251   ma.argv = argv;
00252   return scheme_main_stack_setup(1, main_after_stack, &ma);
00253 }
00254 
00255 /************************     main_after_stack    *************************/
00256 /*               Setup, parse command-line, and go to cont_run            */
00257 
00258 static int main_after_stack(void *data)
00259 {
00260   int rval;
00261   int argc;
00262   MAIN_char **MAIN_argv;
00263 #ifdef WINDOWS_UNICODE_MAIN
00264   char **argv;
00265 #endif
00266 
00267   argc = ((Main_Args *)data)->argc;
00268   MAIN_argv = ((Main_Args *)data)->argv;
00269 
00270 #if defined(OSKIT) && !defined(OSKIT_TEST) && !KNIT
00271   oskit_prepare(&argc, &argv);
00272 #endif
00273 
00274 #ifdef WINDOWS_UNICODE_MAIN
00275  {
00276    char *a;
00277    int i, j, l;
00278    argv = (char **)malloc(sizeof(char*)*argc);
00279    for (i = 0; i < argc; i++) {
00280      for (j = 0; wargv[i][j]; j++) {
00281      }
00282      l = scheme_utf8_encode((unsigned int*)wargv[i], 0, j, 
00283                          NULL, 0,
00284                          1 /* UTF-16 */);
00285      a = malloc(l + 1);
00286      scheme_utf8_encode((unsigned int *)wargv[i], 0, j, 
00287                      (unsigned char *)a, 0,
00288                      1 /* UTF-16 */);
00289         a[l] = 0;
00290      argv[i] = a;
00291    }
00292  }
00293 #endif
00294 
00295 #ifndef NO_USER_BREAK_HANDLER
00296   MZ_SIGSET(SIGINT, user_break_hit);
00297 #endif
00298 
00299   rval = run_from_cmd_line(argc, argv, scheme_basic_env, cont_run);
00300 
00301   scheme_immediate_exit(rval);
00302   
00303   /* shouldn't get here */
00304   return rval;
00305 }
00306 
00307 /*************************      cont_run     ******************************/
00308 /*                          Go to do_scheme_rep                           */
00309 
00310 static int cont_run(FinishArgs *f)
00311 {
00312   return finish_cmd_line_run(f, do_scheme_rep);
00313 }
00314 
00315 /*************************   do_scheme_rep   *****************************/
00316 /*                  Finally, do a read-eval-print-loop                   */
00317 
00318 static void do_scheme_rep(Scheme_Env *env)
00319 {
00320   /* enter read-eval-print loop */
00321   {
00322     Scheme_Object *rep, *a[2];
00323 
00324     a[0] = scheme_intern_symbol("scheme/base");
00325     a[1] = scheme_intern_symbol("read-eval-print-loop");
00326     rep = scheme_dynamic_require(2, a);
00327     
00328     if (rep) {
00329       scheme_apply(rep, 0, NULL);
00330       printf("\n");
00331     }
00332   }
00333 }
00334 
00335 /*========================================================================*/
00336 /*                         junk for testing                               */
00337 /*========================================================================*/
00338 
00339 #if 0
00340 /* For testing STANDALONE_WITH_EMBEDDED_EXTENSION */
00341 Scheme_Object *scheme_initialize(Scheme_Env *env)
00342 {
00343   return scheme_eval_string("(lambda (v) (and (eq? v #t) "
00344                          "  (lambda () "
00345                          "    (printf \"These were the args: ~a~n\" argv))))", 
00346                          env);
00347 }
00348 #endif